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

web: clarify some confusing parameter handling

Browse Source
This commit is contained in:
Simon Michael 2015-02-15 08:17:47 +00:00
parent d2877a919a
commit 7138acaec4
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,20 +32,21 @@ handlePost = do
handleAdd :: Handler Html handleAdd :: Handler Html
handleAdd = do handleAdd = do
VD{..} <- getViewData VD{..} <- getViewData
-- gruesome adhoc form handling, port to yesod-form later -- XXX gruesome form handling, port to yesod-form later
mjournal <- lookupPostParam "journal" mjournalpath <- lookupPostParam "journal"
mdate <- lookupPostParam "date" mdate <- lookupPostParam "date"
mdesc <- lookupPostParam "description" mdesc <- lookupPostParam "description"
let edate = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . strip . unpack) mdate let edate = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . strip . unpack) mdate
edesc = Right $ maybe "" unpack mdesc edesc = Right $ maybe "" unpack mdesc
ejournal = maybe (Right $ journalFilePath j) ejournalpath = 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'
) )
mjournal mjournalpath
estrs = [edate, edesc, ejournal] estrs = [edate, edesc, ejournalpath]
(errs1, [date,desc,journalpath]) = (lefts estrs, rights estrs) (errs1, [date,desc,journalpath]) = (lefts estrs, rights estrs)
(params,_) <- runRequestBody (params,_) <- runRequestBody
-- mtrace params -- mtrace params
@ -136,15 +137,16 @@ handleEdit = do
-- 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"
mjournal <- 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
ejournal = maybe (Right $ journalFilePath j) ejournalpath = 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"::String)) else Left ("unrecognised journal file path"::String))
mjournal mjournalpath
estrs = [etext, ejournal] 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