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

fix: web: add form: allow empty description

Browse Source
This commit is contained in:
Simon Michael 2022-08-26 12:00:23 +01:00
parent 316fbaa755
commit 3b2999ee29
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -14,7 +14,7 @@ import Control.Monad.State.Strict (evalStateT)
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.List (dropWhileEnd, unfoldr) import Data.List (dropWhileEnd, unfoldr)
import Data.Maybe (isJust) import Data.Maybe (isJust, fromMaybe)
import qualified Data.Set as S import qualified Data.Set as S
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding.Base64 (encodeBase64) import Data.Text.Encoding.Base64 (encodeBase64)
@ -50,7 +50,7 @@ addForm j today = identifyForm "add" $ \extra -> do
descriptions = foldMap S.fromList [journalPayeesDeclaredOrUsed j, journalDescriptions j] descriptions = foldMap S.fromList [journalPayeesDeclaredOrUsed j, journalDescriptions j]
files = fst <$> jfiles j files = fst <$> jfiles j
(dateRes, dateView) <- mreq dateField dateSettings Nothing (dateRes, dateView) <- mreq dateField dateSettings Nothing
(descRes, descView) <- mreq 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) <- mreq fileField' fileSettings Nothing
@ -86,7 +86,7 @@ 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 Text -> FormResult [Posting] -> FormResult FilePath FormResult Day -> FormResult (Maybe Text) -> FormResult [Posting] -> FormResult FilePath
-> FormResult (Transaction, FilePath) -> FormResult (Transaction, FilePath)
validateTransaction dateRes descRes postingsRes fileRes = validateTransaction dateRes descRes postingsRes fileRes =
case makeTransaction <$> dateRes <*> descRes <*> postingsRes <*> fileRes of case makeTransaction <$> dateRes <*> descRes <*> postingsRes <*> fileRes of
@ -95,10 +95,10 @@ validateTransaction dateRes descRes postingsRes fileRes =
Right txn' -> FormSuccess (txn',f) Right txn' -> FormSuccess (txn',f)
x -> x x -> x
where where
makeTransaction date desc postings f = makeTransaction date mdesc postings f =
(nulltransaction { (nulltransaction {
tdate = date tdate = date
,tdescription = desc ,tdescription = fromMaybe "" mdesc
,tpostings = postings ,tpostings = postings
,tsourcepos = (initialPos f, initialPos f) ,tsourcepos = (initialPos f, initialPos f)
}, f) }, f)