simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

web: add form ignores trailing blank fields

Browse Source 
Empty final account/amount fields are now ignored. Empty fields
followed by non-empty fields are not allowed.
This commit is contained in:
Simon Michael 2014-08-14 00:58:03 -07:00
parent 8d1ceb00f5
commit 2992ce069d
1 changed files with 16 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,16 +8,15 @@ import Control.Applicative
import Data.Either (lefts,rights) import Data.Either (lefts,rights)
import Data.List (intercalate, sort) import Data.List (intercalate, sort)
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.Maybe
import Data.Text (unpack) import Data.Text (unpack)
import qualified Data.Text as T import qualified Data.Text as T
import Text.Parsec (digit, eof, many1, string) import Text.Parsec (digit, eof, many1, string)
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Utils import Hledger.Utils
import Hledger.Data import Hledger.Data hiding (num)
import Hledger.Read import Hledger.Read
import Hledger.Cli import Hledger.Cli hiding (num)
-- | Handle a post from any of the edit forms. -- | Handle a post from any of the edit forms.
@ -48,37 +47,30 @@ handleAdd = do
mjournal mjournal
estrs = [edate, edesc, ejournal] 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
-- mtrace params -- mtrace params
let paramnamep s = do {string s; n <- many1 digit; eof; return (read n :: Int)} let paramnamep s = do {string s; n <- many1 digit; eof; return (read n :: Int)}
acctparams = sort numberedParams s =
[ (n,v) | (k,v) <- params reverse $ dropWhile (T.null . snd) $ reverse $ sort
, let en = parsewith (paramnamep "account") $ T.unpack k [ (n,v) | (k,v) <- params
, isRight en , let en = parsewith (paramnamep s) $ T.unpack k
, let Right n = en , isRight en
] , let Right n = en
amtparams = sort ]
[ (n,v) | (k,v) <- params acctparams = numberedParams "account"
, let en = parsewith (paramnamep "amount") $ T.unpack k amtparams = numberedParams "amount"
, isRight 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 | map fst acctparams == [1..num] &&
| otherwise = catMaybes map fst amtparams `elem` [[1..num], [1..num-1]] = []
[if map fst acctparams == [1..num] then Nothing else Just "misnumbered account parameters" | otherwise = ["malformed account/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.
errs = errs1 ++ if null paramErrs then (acctErrs ++ amtErrs) else paramErrs errs = errs1 ++ if not (null paramErrs) then paramErrs else (acctErrs ++ amtErrs)
et | not $ null errs = Left errs et | not $ null errs = Left errs
| otherwise = either (\e -> Left ["unbalanced postings: " ++ (L.head $ lines e)]) Right | otherwise = either (\e -> Left ["unbalanced postings: " ++ (L.head $ lines e)]) Right
(balanceTransaction Nothing $ nulltransaction { (balanceTransaction Nothing $ nulltransaction {
@ -86,7 +78,6 @@ handleAdd = do
,tdescription=desc ,tdescription=desc
,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts] ,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts]
}) })
-- display errors or add transaction -- display errors or add transaction
case et of case et of
Left errs' -> do Left errs' -> do