slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: add handler cleanup, rename vars

Browse Source
This commit is contained in:
Simon Michael 2014-08-14 00:26:22 -07:00
parent 6bf599ae9e
commit 834fef7389
1 changed files with 22 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
hledger-web/Handler/Post.hs
View File

@ -33,21 +33,20 @@ handlePost = do
handleAdd :: Handler Html handleAdd :: Handler Html
handleAdd = do handleAdd = do
VD{..} <- getViewData VD{..} <- getViewData
-- XXX port to yesod-form later -- gruesome adhoc form handling, port to yesod-form later
-- get form input values. M means a Maybe value. mjournal <- lookupPostParam "journal"
journalM <- lookupPostParam "journal" mdate <- lookupPostParam "date"
dateM <- lookupPostParam "date" mdesc <- lookupPostParam "description"
descM <- lookupPostParam "description" let edate = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . strip . unpack) mdate
let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . strip . unpack) dateM edesc = Right $ maybe "" unpack mdesc
descE = Right $ maybe "" unpack descM ejournal = maybe (Right $ journalFilePath j)
journalE = maybe (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: " ++ f' else Left $ "unrecognised journal file path: " ++ f'
) )
journalM mjournal
estrs = [dateE, descE, journalE] estrs = [edate, edesc, ejournal]
(errs1, [date,desc,journalpath]) = (lefts estrs, rights estrs) -- XXX irrefutable (errs1, [date,desc,journalpath]) = (lefts estrs, rights estrs) -- XXX irrefutable
(params,_) <- runRequestBody (params,_) <- runRequestBody
@ -65,17 +64,17 @@ handleAdd = do
, isRight en , isRight en
, let Right n = en , let Right n = en
] ]
num' = length acctparams num = length acctparams
paramErrs | not $ length amtparams `elem` [num', num'-1] = ["different number of account and amount parameters"] paramErrs | not $ length amtparams `elem` [num, num-1] = ["different number of account and amount parameters"]
| otherwise = catMaybes | otherwise = catMaybes
[if map fst acctparams == [1..num'] then Nothing else Just "misnumbered account parameters" [if map fst acctparams == [1..num] then Nothing else Just "misnumbered account parameters"
,if map fst amtparams == [1..num'] || map fst amtparams == [1..(num'-1)] then Nothing else Just "misnumbered amount parameters" ,if map fst amtparams == [1..num] || map fst amtparams == [1..(num-1)] then Nothing else Just "misnumbered amount parameters"
] ]
eaccts = map (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams eaccts = map (parsewith (accountnamep <* eof) . strip . T.unpack . snd) acctparams
eamts = map (parseWithCtx nullctx (amountp <* eof) . strip . T.unpack . snd) amtparams eamts = map (parseWithCtx nullctx (amountp <* eof) . strip . T.unpack . snd) amtparams
(accts, acctErrs) = (rights eaccts, map show $ lefts eaccts) (accts, acctErrs) = (rights eaccts, map show $ lefts eaccts)
(amts', amtErrs) = (rights eamts, map show $ lefts eamts) (amts', amtErrs) = (rights eamts, map show $ lefts eamts)
amts | length amts' == num' = amts' amts | length amts' == num = amts'
| otherwise = amts' ++ [missingamt] | otherwise = amts' ++ [missingamt]
-- if no errors so far, generate a transaction and balance it or get the error. -- if no errors so far, generate a transaction and balance it or get the error.
@ -145,18 +144,18 @@ 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
textM <- lookupPostParam "text" mtext <- lookupPostParam "text"
journalM <- lookupPostParam "journal" mjournal <- lookupPostParam "journal"
let textE = maybe (Left "No value provided") (Right . unpack) textM let etext = maybe (Left "No value provided") (Right . unpack) mtext
journalE = maybe (Right $ journalFilePath j) ejournal = maybe (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") else Left "unrecognised journal file path")
journalM mjournal
strEs = [textE, journalE] estrs = [etext, ejournal]
errs = lefts strEs errs = lefts estrs
[text,journalpath] = rights strEs [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