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

web: add form stricter parsing, better errors (fixes #194)

Browse Source
This commit is contained in:
Simon Michael 2014-07-05 13:07:57 -07:00
parent f30deee197
commit 8fe26fe345
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,11 +4,13 @@ module Handler.Post where
import Import import Import
import Control.Applicative
import Data.Either (lefts,rights) import Data.Either (lefts,rights)
import Data.List (intercalate) import Data.List (intercalate)
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 (null) import qualified Data.Text as T (null)
import Text.Parsec (eof)
import Text.Printf (printf) import Text.Printf (printf)
import Handler.Utils import Handler.Utils
@ -42,11 +44,15 @@ handleAdd = do
-- supply defaults and parse date and amounts, or get errors. -- supply defaults and parse date and amounts, or get errors.
let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . unpack) dateM let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . unpack) dateM
descE = Right $ maybe "" unpack descM descE = Right $ maybe "" unpack descM
maybeNonNull = maybe Nothing (\t -> if T.null t then Nothing else Just t) -- XXX simplify...
acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M maybeNothing = maybe Nothing (\t -> if T.null t then Nothing else Just t)
acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M acct1E = maybe (Left "To account required") (Right . strip . unpack) (maybeNothing acct1M)
amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt1M >>= \a -> either (Left . ("could not parse To account: "++) . show) Right (parsewith (accountnamep <* eof) a)
amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M acct2E = maybe (Left "From account required") (Right . strip . unpack) (maybeNothing acct2M)
>>= \a -> either (Left . ("could not parse From account: "++) . show) Right (parsewith (accountnamep <* eof) a)
amt1E = maybe (Left "Amount 1 required") (Right . strip . unpack) (maybeNothing amt1M)
>>= \a -> either (Left . ("could not parse To account: "++) . show) Right (parseWithCtx nullctx (amountp <* eof) a)
amt2E = maybe (Right missingamt) (either (Left . ("could not parse amount 2: "++) . show) Right . parseWithCtx nullctx amountp . strip . unpack) amt2M
journalE = 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