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

parsing: actually parse balance assertions

Browse Source 
Parser unit test is commented out until HTF tests are fixed.
This commit is contained in:
Simon Michael 2013-05-28 16:18:15 -07:00
parent cdc7495459
commit 0be986fcb9
3 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
hledger-lib/Hledger/Data/Posting.hs
View File

@ -71,6 +71,7 @@ nullposting = Posting
,pcomment="" ,pcomment=""
,ptype=RegularPosting ,ptype=RegularPosting
,ptags=[] ,ptags=[]
,pbalanceassertion=Nothing
,ptransaction=Nothing ,ptransaction=Nothing
} }
posting = nullposting posting = nullposting

3
hledger-lib/Hledger/Data/Types.hs
View File

@ -84,6 +84,7 @@ data Posting = Posting {
pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string
ptype :: PostingType, ptype :: PostingType,
ptags :: [Tag], ptags :: [Tag],
pbalanceassertion :: Maybe MixedAmount, -- ^ optional: the expected balance in the account after this posting
ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types). ptransaction :: Maybe Transaction -- ^ this posting's parent transaction (co-recursive types).
-- Tying this knot gets tedious, Maybe makes it easier/optional. -- Tying this knot gets tedious, Maybe makes it easier/optional.
} }
@ -91,7 +92,7 @@ data Posting = Posting {
-- The equality test for postings ignores the parent transaction's -- The equality test for postings ignores the parent transaction's
-- identity, to avoid infinite loops. -- identity, to avoid infinite loops.
instance Eq Posting where instance Eq Posting where
(==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2
data Transaction = Transaction { data Transaction = Transaction {
tdate :: Day, tdate :: Day,

16
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -508,7 +508,7 @@ postingp = do
account <- modifiedaccountname account <- modifiedaccountname
let (ptype, account') = (accountNamePostingType account, unbracket account) let (ptype, account') = (accountNamePostingType account, unbracket account)
amount <- spaceandamountormissing amount <- spaceandamountormissing
_ <- balanceassertion mBalanceAssertion <- balanceassertion
_ <- fixedlotprice _ <- fixedlotprice
many spacenonewline many spacenonewline
ctx <- getState ctx <- getState
@ -517,7 +517,7 @@ postingp = do
-- oh boy -- oh boy
d <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags) d <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)
d2 <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` date2ValueFromTags tags) d2 <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` date2ValueFromTags tags)
return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags} return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags, pbalanceassertion=mBalanceAssertion}
#ifdef TESTS #ifdef TESTS
test_postingp = do test_postingp = do
@ -559,9 +559,11 @@ test_postingp = do
-- ,"postingp parses balance assertions and fixed lot prices" ~: do -- ,"postingp parses balance assertions and fixed lot prices" ~: do
assertBool (isRight $ parseWithCtx nullctx postingp " a 1 \"DE123\" =$1 { =2.2 EUR} \n") assertBool (isRight $ parseWithCtx nullctx postingp " a 1 \"DE123\" =$1 { =2.2 EUR} \n")
let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n" -- let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n"
assertRight parse -- assertRight parse
assertEqual "next-line comment\n" (let Right p = parse in pcomment p) -- let Right p = parse
-- assertEqual "next-line comment\n" (pcomment p)
-- assertEqual (Just nullmixedamt) (pbalanceassertion p)
#endif #endif
-- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.
@ -706,14 +708,14 @@ priceamount =
return $ UnitPrice a)) return $ UnitPrice a))
<|> return NoPrice <|> return NoPrice
balanceassertion :: GenParser Char JournalContext (Maybe Amount) balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)
balanceassertion = balanceassertion =
try (do try (do
many spacenonewline many spacenonewline
char '=' char '='
many spacenonewline many spacenonewline
a <- amountp -- XXX should restrict to a simple amount a <- amountp -- XXX should restrict to a simple amount
return $ Just a) return $ Just $ Mixed [a])
<|> return Nothing <|> return Nothing
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices