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

web: allow arbitrary commodities and an implicit second amount in add form

Browse Source
This commit is contained in:
Simon Michael 2009-11-19 19:18:29 +00:00
parent 34019d5973
commit 70e33a5fdf
1 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Commands/Web.hs
View File

@ -26,6 +26,7 @@ import Options hiding (value)
import System.Directory (getModificationTime) import System.Directory (getModificationTime)
import System.IO.Storage (withStore, putValue, getValue) import System.IO.Storage (withStore, putValue, getValue)
import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff)) import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))
import Text.ParserCombinators.Parsec (parse)
-- import Text.XHtml hiding (dir, text, param, label) -- import Text.XHtml hiding (dir, text, param, label)
-- import Text.XHtml.Strict ((<<),(+++),(!)) -- import Text.XHtml.Strict ((<<),(+++),(!))
import qualified HSP (Request(..)) import qualified HSP (Request(..))
@ -296,8 +297,9 @@ handleAddform l = do
validateAmt1 _ = [] validateAmt1 _ = []
validateAcct2 "" = ["missing account 2"] validateAcct2 "" = ["missing account 2"]
validateAcct2 _ = [] validateAcct2 _ = []
validateAmt2 "" = ["missing amount 2"]
validateAmt2 _ = [] validateAmt2 _ = []
amt1' = either (const missingamt) id $ parse someamount "" amt1
amt2' = either (const missingamt) id $ parse someamount "" amt2
t = LedgerTransaction { t = LedgerTransaction {
ltdate = parsedate $ fixSmartDateStr today date ltdate = parsedate $ fixSmartDateStr today date
,lteffectivedate=Nothing ,lteffectivedate=Nothing
@ -306,11 +308,14 @@ handleAddform l = do
,ltdescription=desc ,ltdescription=desc
,ltcomment="" ,ltcomment=""
,ltpostings=[ ,ltpostings=[
Posting False acct1 (Mixed [dollars $ read amt1]) "" RegularPosting Posting False acct1 amt1' "" RegularPosting
,Posting False acct2 (Mixed [dollars $ read amt2]) "" RegularPosting ,Posting False acct2 amt2' "" RegularPosting
] ]
,ltpreceding_comment_lines="" ,ltpreceding_comment_lines=""
} }
(t', berr) = case balanceLedgerTransaction t of
Right t'' -> (t'', [])
Left e -> (t, [e])
errs = concat [ errs = concat [
validateDate date validateDate date
,validateDesc desc ,validateDesc desc
@ -318,13 +323,11 @@ handleAddform l = do
,validateAmt1 amt1 ,validateAmt1 amt1
,validateAcct2 acct2 ,validateAcct2 acct2
,validateAmt2 amt2 ,validateAmt2 amt2
] ] ++ berr
errs' | null errs = either (:[]) (const []) (balanceLedgerTransaction t)
| otherwise = errs
in in
case null errs' of case null errs of
False -> Failure errs' False -> Failure errs
True -> Success t True -> Success t'
handle :: Failing LedgerTransaction -> AppUnit handle :: Failing LedgerTransaction -> AppUnit
handle (Failure errs) = hsp errs addform handle (Failure errs) = hsp errs addform