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

fix: web: add: don't fail when there's no file field (#1932)

Browse Source
This commit is contained in:
Simon Michael 2022-09-14 08:16:49 -10:00
parent 3411949313
commit 599264b212
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
hledger-web/Hledger/Web/Widget/AddForm.hs
View File

@ -49,14 +49,15 @@ addForm j today = identifyForm "add" $ \extra -> do
let -- bindings used in add-form.hamlet let -- bindings used in add-form.hamlet
descriptions = foldMap S.fromList [journalPayeesDeclaredOrUsed j, journalDescriptions j] descriptions = foldMap S.fromList [journalPayeesDeclaredOrUsed j, journalDescriptions j]
files = fst <$> jfiles j files = fst <$> jfiles j
deffile = journalFilePath j
(dateRes, dateView) <- mreq dateField dateSettings Nothing (dateRes, dateView) <- mreq dateField dateSettings Nothing
(descRes, descView) <- mopt textField descSettings Nothing (descRes, descView) <- mopt textField descSettings Nothing
(acctsRes, _) <- mreq listField acctSettings Nothing (acctsRes, _) <- mreq listField acctSettings Nothing
(amtsRes, _) <- mreq listField amtSettings Nothing (amtsRes, _) <- mreq listField amtSettings Nothing
(fileRes, fileView) <- mreq fileField' fileSettings Nothing (fileRes, fileView) <- mopt fileField' fileSettings Nothing
let let
(postingsRes, displayRows) = validatePostings acctsRes amtsRes (postingsRes, displayRows) = validatePostings acctsRes amtsRes
formRes = validateTransaction dateRes descRes postingsRes fileRes formRes = validateTransaction deffile dateRes descRes postingsRes fileRes
return (formRes, $(widgetFile "add-form")) return (formRes, $(widgetFile "add-form"))
where where
-- custom fields -- custom fields
@ -86,22 +87,23 @@ addForm j today = identifyForm "add" $ \extra -> do
fileSettings = FieldSettings "file" Nothing Nothing (Just "file") [("class", "form-control input-lg")] fileSettings = FieldSettings "file" Nothing Nothing (Just "file") [("class", "form-control input-lg")]
validateTransaction :: validateTransaction ::
FormResult Day -> FormResult (Maybe Text) -> FormResult [Posting] -> FormResult FilePath FilePath -> FormResult Day -> FormResult (Maybe Text) -> FormResult [Posting] -> FormResult (Maybe FilePath)
-> FormResult (Transaction, FilePath) -> FormResult (Transaction, FilePath)
validateTransaction dateRes descRes postingsRes fileRes = validateTransaction deffile dateRes descRes postingsRes fileRes =
case makeTransaction <$> dateRes <*> descRes <*> postingsRes <*> fileRes of case makeTransaction <$> dateRes <*> descRes <*> postingsRes <*> fileRes of
FormSuccess (txn,f) -> case balanceTransaction defbalancingopts txn of FormSuccess (txn,f) -> case balanceTransaction defbalancingopts txn of
Left e -> FormFailure [T.pack e] Left e -> FormFailure [T.pack e]
Right txn' -> FormSuccess (txn',f) Right txn' -> FormSuccess (txn',f)
x -> x x -> x
where where
makeTransaction date mdesc postings f = makeTransaction date mdesc postings mfile =
(nulltransaction { (nulltransaction {
tdate = date tdate = date
,tdescription = fromMaybe "" mdesc ,tdescription = fromMaybe "" mdesc
,tpostings = postings ,tpostings = postings
,tsourcepos = (initialPos f, initialPos f) ,tsourcepos = (initialPos f, initialPos f)
}, f) }, f)
where f = fromMaybe deffile mfile
-- | Parse a list of postings out of a list of accounts and a corresponding list -- | Parse a list of postings out of a list of accounts and a corresponding list
-- of amounts -- of amounts