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.|] |     setMessage [shamlet|<span>Transaction added.|] | ||||||
| 
 | 
 | ||||||
|   redirect (JournalR) -- , [("add","1")]) |   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