web: move old edit/import stuff out of AddForm
This commit is contained in:
		
							parent
							
								
									55967e9192
								
							
						
					
					
						commit
						16aaf35c4b
					
				| @ -90,96 +90,3 @@ postAddForm = do | ||||
|     setMessage [shamlet|<span>Transaction added.|] | ||||
| 
 | ||||
|   redirect (JournalR) -- , [("add","1")]) | ||||
| 
 | ||||
| -- -- | Handle a post from the journal edit form. | ||||
| -- handleEdit :: Handler Html | ||||
| -- handleEdit = do | ||||
| --   VD{..} <- getViewData | ||||
| --   -- get form input values, or validation errors. | ||||
| --   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace | ||||
| --   mtext <- lookupPostParam "text" | ||||
| --   mtrace "--------------------------" | ||||
| --   mtrace (journalFilePaths j) | ||||
| --   mjournalpath <- lookupPostParam "journal" | ||||
| --   let etext = maybe (Left "No value provided") (Right . unpack) mtext | ||||
| --       ejournalpath = maybe | ||||
| --                        (Right $ journalFilePath j) | ||||
| --                        (\f -> let f' = unpack f in | ||||
| --                               if f' `elem` dbg0 "paths2" (journalFilePaths j) | ||||
| --                               then Right f' | ||||
| --                               else Left ("unrecognised journal file path"::String)) | ||||
| --                        mjournalpath | ||||
| --       estrs = [etext, ejournalpath] | ||||
| --       errs = lefts estrs | ||||
| --       [text,journalpath] = rights estrs | ||||
| --   -- display errors or perform edit | ||||
| --   if not $ null errs | ||||
| --    then do | ||||
| --     setMessage $ toHtml (intercalate "; " errs :: String) | ||||
| --     redirect JournalR | ||||
| 
 | ||||
| -- -- | Handle a post from the journal edit form. | ||||
| -- handleEdit :: Handler Html | ||||
| -- handleEdit = do | ||||
| --   VD{..} <- getViewData | ||||
| --   -- get form input values, or validation errors. | ||||
| --   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace | ||||
| --   mtext <- lookupPostParam "text" | ||||
| --   mjournalpath <- lookupPostParam "journal" | ||||
| --   let etext = maybe (Left "No value provided") (Right . unpack) mtext | ||||
| --       ejournalpath = maybe | ||||
| --                        (Right $ journalFilePath j) | ||||
| --                        (\f -> let f' = unpack f in | ||||
| --                               if f' `elem` journalFilePaths j | ||||
| --                               then Right f' | ||||
| --                               else Left ("unrecognised journal file path"::String)) | ||||
| --                        mjournalpath | ||||
| --       estrs = [etext, ejournalpath] | ||||
| --       errs = lefts estrs | ||||
| --       [text,journalpath] = rights estrs | ||||
| --   -- display errors or perform edit | ||||
| --   if not $ null errs | ||||
| --    then do | ||||
| --     setMessage $ toHtml (intercalate "; " errs :: String) | ||||
| --     redirect JournalR | ||||
| 
 | ||||
| --    else do | ||||
| --     -- try to avoid unnecessary backups or saving invalid data | ||||
| --     filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath | ||||
| --     told <- liftIO $ readFileStrictly journalpath | ||||
| --     let tnew = filter (/= '\r') text | ||||
| --         changed = tnew /= told || filechanged' | ||||
| --     if not changed | ||||
| --      then do | ||||
| --        setMessage "No change" | ||||
| --        redirect JournalR | ||||
| --      else do | ||||
| --       jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew | ||||
| --       either | ||||
| --        (\e -> do | ||||
| --           setMessage $ toHtml e | ||||
| --           redirect JournalR) | ||||
| --        (const $ do | ||||
| --           liftIO $ writeFileWithBackup journalpath tnew | ||||
| --           setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String) | ||||
| --           redirect JournalR) | ||||
| --        jE | ||||
| 
 | ||||
| -- -- | Handle a post from the journal import form. | ||||
| -- handleImport :: Handler Html | ||||
| -- handleImport = do | ||||
| --   setMessage "can't handle file upload yet" | ||||
| --   redirect JournalR | ||||
| --   -- -- get form input values, or basic validation errors. E means an Either value. | ||||
| --   -- fileM <- runFormPost $ maybeFileInput "file" | ||||
| --   -- let fileE = maybe (Left "No file provided") Right fileM | ||||
| --   -- -- display errors or import transactions | ||||
| --   -- case fileE of | ||||
| --   --  Left errs -> do | ||||
| --   --   setMessage errs | ||||
| --   --   redirect JournalR | ||||
| 
 | ||||
| --   --  Right s -> do | ||||
| --   --    setMessage s | ||||
| --   --    redirect JournalR | ||||
| 
 | ||||
|  | ||||
							
								
								
									
										75
									
								
								hledger-web/Handler/EditForm.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										75
									
								
								hledger-web/Handler/EditForm.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,75 @@ | ||||
| -- -- | Handle a post from the journal edit form. | ||||
| -- handleEdit :: Handler Html | ||||
| -- handleEdit = do | ||||
| --   VD{..} <- getViewData | ||||
| --   -- get form input values, or validation errors. | ||||
| --   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace | ||||
| --   mtext <- lookupPostParam "text" | ||||
| --   mtrace "--------------------------" | ||||
| --   mtrace (journalFilePaths j) | ||||
| --   mjournalpath <- lookupPostParam "journal" | ||||
| --   let etext = maybe (Left "No value provided") (Right . unpack) mtext | ||||
| --       ejournalpath = maybe | ||||
| --                        (Right $ journalFilePath j) | ||||
| --                        (\f -> let f' = unpack f in | ||||
| --                               if f' `elem` dbg0 "paths2" (journalFilePaths j) | ||||
| --                               then Right f' | ||||
| --                               else Left ("unrecognised journal file path"::String)) | ||||
| --                        mjournalpath | ||||
| --       estrs = [etext, ejournalpath] | ||||
| --       errs = lefts estrs | ||||
| --       [text,journalpath] = rights estrs | ||||
| --   -- display errors or perform edit | ||||
| --   if not $ null errs | ||||
| --    then do | ||||
| --     setMessage $ toHtml (intercalate "; " errs :: String) | ||||
| --     redirect JournalR | ||||
| 
 | ||||
| -- -- | Handle a post from the journal edit form. | ||||
| -- handleEdit :: Handler Html | ||||
| -- handleEdit = do | ||||
| --   VD{..} <- getViewData | ||||
| --   -- get form input values, or validation errors. | ||||
| --   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace | ||||
| --   mtext <- lookupPostParam "text" | ||||
| --   mjournalpath <- lookupPostParam "journal" | ||||
| --   let etext = maybe (Left "No value provided") (Right . unpack) mtext | ||||
| --       ejournalpath = maybe | ||||
| --                        (Right $ journalFilePath j) | ||||
| --                        (\f -> let f' = unpack f in | ||||
| --                               if f' `elem` journalFilePaths j | ||||
| --                               then Right f' | ||||
| --                               else Left ("unrecognised journal file path"::String)) | ||||
| --                        mjournalpath | ||||
| --       estrs = [etext, ejournalpath] | ||||
| --       errs = lefts estrs | ||||
| --       [text,journalpath] = rights estrs | ||||
| --   -- display errors or perform edit | ||||
| --   if not $ null errs | ||||
| --    then do | ||||
| --     setMessage $ toHtml (intercalate "; " errs :: String) | ||||
| --     redirect JournalR | ||||
| 
 | ||||
| --    else do | ||||
| --     -- try to avoid unnecessary backups or saving invalid data | ||||
| --     filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath | ||||
| --     told <- liftIO $ readFileStrictly journalpath | ||||
| --     let tnew = filter (/= '\r') text | ||||
| --         changed = tnew /= told || filechanged' | ||||
| --     if not changed | ||||
| --      then do | ||||
| --        setMessage "No change" | ||||
| --        redirect JournalR | ||||
| --      else do | ||||
| --       jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew | ||||
| --       either | ||||
| --        (\e -> do | ||||
| --           setMessage $ toHtml e | ||||
| --           redirect JournalR) | ||||
| --        (const $ do | ||||
| --           liftIO $ writeFileWithBackup journalpath tnew | ||||
| --           setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String) | ||||
| --           redirect JournalR) | ||||
| --        jE | ||||
| 
 | ||||
| 
 | ||||
							
								
								
									
										18
									
								
								hledger-web/Handler/ImportForm.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										18
									
								
								hledger-web/Handler/ImportForm.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,18 @@ | ||||
| -- -- | Handle a post from the journal import form. | ||||
| -- handleImport :: Handler Html | ||||
| -- handleImport = do | ||||
| --   setMessage "can't handle file upload yet" | ||||
| --   redirect JournalR | ||||
| --   -- -- get form input values, or basic validation errors. E means an Either value. | ||||
| --   -- fileM <- runFormPost $ maybeFileInput "file" | ||||
| --   -- let fileE = maybe (Left "No file provided") Right fileM | ||||
| --   -- -- display errors or import transactions | ||||
| --   -- case fileE of | ||||
| --   --  Left errs -> do | ||||
| --   --   setMessage errs | ||||
| --   --   redirect JournalR | ||||
| 
 | ||||
| --   --  Right s -> do | ||||
| --   --    setMessage s | ||||
| --   --    redirect JournalR | ||||
| 
 | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user