web: comment unused handlers
This commit is contained in:
		
							parent
							
								
									ebe0ee184c
								
							
						
					
					
						commit
						a1aff10225
					
				| @ -6,12 +6,11 @@ import Import | |||||||
| 
 | 
 | ||||||
| import Control.Applicative | import Control.Applicative | ||||||
| import Data.Either (lefts,rights) | import Data.Either (lefts,rights) | ||||||
| import Data.List (intercalate, sort) | import Data.List (sort) | ||||||
| import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free | import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free | ||||||
| import Data.Text (unpack) | import Data.Text (unpack) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Text.Parsec (digit, eof, many1, string, runParser) | import Text.Parsec (digit, eof, many1, string, runParser) | ||||||
| import Text.Printf (printf) |  | ||||||
| 
 | 
 | ||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| import Hledger.Data hiding (num) | import Hledger.Data hiding (num) | ||||||
| @ -24,8 +23,8 @@ handlePost :: Handler Html | |||||||
| handlePost = do | handlePost = do | ||||||
|   action <- lookupPostParam  "action" |   action <- lookupPostParam  "action" | ||||||
|   case action of Just "add"    -> handleAdd |   case action of Just "add"    -> handleAdd | ||||||
|                  Just "edit"   -> handleEdit |                  -- Just "edit"   -> handleEdit | ||||||
|                  Just "import" -> handleImport |                  -- Just "import" -> handleImport | ||||||
|                  _             -> invalidArgs ["invalid action"] |                  _             -> invalidArgs ["invalid action"] | ||||||
| 
 | 
 | ||||||
| -- | Handle a post from the transaction add form. | -- | Handle a post from the transaction add form. | ||||||
| @ -130,68 +129,68 @@ handleAdd = do | |||||||
| --                 ^{widget} | --                 ^{widget} | ||||||
| --         |] | --         |] | ||||||
| 
 | 
 | ||||||
| -- | Handle a post from the journal edit form. | -- -- | Handle a post from the journal edit form. | ||||||
| handleEdit :: Handler Html | -- handleEdit :: Handler Html | ||||||
| handleEdit = do | -- handleEdit = do | ||||||
|   VD{..} <- getViewData | --   VD{..} <- getViewData | ||||||
|   -- get form input values, or validation errors. | --   -- get form input values, or validation errors. | ||||||
|   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace | --   -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace | ||||||
|   mtext <- lookupPostParam "text" | --   mtext <- lookupPostParam "text" | ||||||
|   mjournalpath <- lookupPostParam "journal" | --   mjournalpath <- lookupPostParam "journal" | ||||||
|   let etext = maybe (Left "No value provided") (Right . unpack) mtext | --   let etext = maybe (Left "No value provided") (Right . unpack) mtext | ||||||
|       ejournalpath = maybe | --       ejournalpath = maybe | ||||||
|                        (Right $ journalFilePath j) | --                        (Right $ journalFilePath j) | ||||||
|                        (\f -> let f' = unpack f in | --                        (\f -> let f' = unpack f in | ||||||
|                               if f' `elem` journalFilePaths j | --                               if f' `elem` journalFilePaths j | ||||||
|                               then Right f' | --                               then Right f' | ||||||
|                               else Left ("unrecognised journal file path"::String)) | --                               else Left ("unrecognised journal file path"::String)) | ||||||
|                        mjournalpath | --                        mjournalpath | ||||||
|       estrs = [etext, ejournalpath] | --       estrs = [etext, ejournalpath] | ||||||
|       errs = lefts estrs | --       errs = lefts estrs | ||||||
|       [text,journalpath] = rights estrs | --       [text,journalpath] = rights estrs | ||||||
|   -- display errors or perform edit | --   -- display errors or perform edit | ||||||
|   if not $ null errs | --   if not $ null errs | ||||||
|    then do | --    then do | ||||||
|     setMessage $ toHtml (intercalate "; " errs :: String) | --     setMessage $ toHtml (intercalate "; " errs :: String) | ||||||
|     redirect JournalR | --     redirect JournalR | ||||||
| 
 | 
 | ||||||
|    else do | --    else do | ||||||
|     -- try to avoid unnecessary backups or saving invalid data | --     -- try to avoid unnecessary backups or saving invalid data | ||||||
|     filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath | --     filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath | ||||||
|     told <- liftIO $ readFileStrictly journalpath | --     told <- liftIO $ readFileStrictly journalpath | ||||||
|     let tnew = filter (/= '\r') text | --     let tnew = filter (/= '\r') text | ||||||
|         changed = tnew /= told || filechanged' | --         changed = tnew /= told || filechanged' | ||||||
|     if not changed | --     if not changed | ||||||
|      then do | --      then do | ||||||
|        setMessage "No change" | --        setMessage "No change" | ||||||
|        redirect JournalR | --        redirect JournalR | ||||||
|      else do | --      else do | ||||||
|       jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew | --       jE <- liftIO $ readJournal Nothing Nothing True (Just journalpath) tnew | ||||||
|       either | --       either | ||||||
|        (\e -> do | --        (\e -> do | ||||||
|           setMessage $ toHtml e | --           setMessage $ toHtml e | ||||||
|           redirect JournalR) | --           redirect JournalR) | ||||||
|        (const $ do | --        (const $ do | ||||||
|           liftIO $ writeFileWithBackup journalpath tnew | --           liftIO $ writeFileWithBackup journalpath tnew | ||||||
|           setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String) | --           setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String) | ||||||
|           redirect JournalR) | --           redirect JournalR) | ||||||
|        jE | --        jE | ||||||
| 
 | 
 | ||||||
| -- | Handle a post from the journal import form. | -- -- | Handle a post from the journal import form. | ||||||
| handleImport :: Handler Html | -- handleImport :: Handler Html | ||||||
| handleImport = do | -- handleImport = do | ||||||
|   setMessage "can't handle file upload yet" | --   setMessage "can't handle file upload yet" | ||||||
|   redirect JournalR | --   redirect JournalR | ||||||
|   -- -- get form input values, or basic validation errors. E means an Either value. | --   -- -- get form input values, or basic validation errors. E means an Either value. | ||||||
|   -- fileM <- runFormPost $ maybeFileInput "file" | --   -- fileM <- runFormPost $ maybeFileInput "file" | ||||||
|   -- let fileE = maybe (Left "No file provided") Right fileM | --   -- let fileE = maybe (Left "No file provided") Right fileM | ||||||
|   -- -- display errors or import transactions | --   -- -- display errors or import transactions | ||||||
|   -- case fileE of | --   -- case fileE of | ||||||
|   --  Left errs -> do | --   --  Left errs -> do | ||||||
|   --   setMessage errs | --   --   setMessage errs | ||||||
|   --   redirect JournalR | --   --   redirect JournalR | ||||||
| 
 | 
 | ||||||
|   --  Right s -> do | --   --  Right s -> do | ||||||
|   --    setMessage s | --   --    setMessage s | ||||||
|   --    redirect JournalR | --   --    redirect JournalR | ||||||
| 
 | 
 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user