web: comment unused handlers

This commit is contained in:
Simon Michael 2015-02-16 15:34:46 +00:00
parent ebe0ee184c
commit a1aff10225

View File

@ -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