From 0be986fcb94458c3264e23cafa6c07d404a4dcfb Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Tue, 28 May 2013 16:18:15 -0700
Subject: [PATCH] parsing: actually parse balance assertions

Parser unit test is commented out until HTF tests are fixed.
---
 hledger-lib/Hledger/Data/Posting.hs       |  1 +
 hledger-lib/Hledger/Data/Types.hs         |  7 ++++---
 hledger-lib/Hledger/Read/JournalReader.hs | 16 +++++++++-------
 3 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs
index 711f71d6e..c89ba88d6 100644
--- a/hledger-lib/Hledger/Data/Posting.hs
+++ b/hledger-lib/Hledger/Data/Posting.hs
@@ -71,6 +71,7 @@ nullposting = Posting
                 ,pcomment=""
                 ,ptype=RegularPosting
                 ,ptags=[]
+                ,pbalanceassertion=Nothing
                 ,ptransaction=Nothing
                 }
 posting = nullposting
diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs
index 436a8f164..8e5d87806 100644
--- a/hledger-lib/Hledger/Data/Types.hs
+++ b/hledger-lib/Hledger/Data/Types.hs
@@ -84,14 +84,15 @@ data Posting = Posting {
       pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string
       ptype :: PostingType,
       ptags :: [Tag],
-      ptransaction :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).
-                                         -- Tying this knot gets tedious, Maybe makes it easier/optional.
+      pbalanceassertion :: Maybe MixedAmount,  -- ^ optional: the expected balance in the account after this posting
+      ptransaction :: Maybe Transaction    -- ^ this posting's parent transaction (co-recursive types).
+                                           -- Tying this knot gets tedious, Maybe makes it easier/optional.
     }
 
 -- The equality test for postings ignores the parent transaction's
 -- identity, to avoid infinite loops.
 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 {
       tdate :: Day,
diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index e21018f8d..3e8327338 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -508,7 +508,7 @@ postingp = do
   account <- modifiedaccountname
   let (ptype, account') = (accountNamePostingType account, unbracket account)
   amount <- spaceandamountormissing
-  _ <- balanceassertion
+  mBalanceAssertion <- balanceassertion
   _ <- fixedlotprice
   many spacenonewline
   ctx <- getState
@@ -517,7 +517,7 @@ postingp = do
   -- oh boy
   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)
-  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
 test_postingp = do
@@ -559,9 +559,11 @@ test_postingp = do
   -- ,"postingp parses balance assertions and fixed lot prices" ~: do
     assertBool (isRight $ parseWithCtx nullctx postingp "  a  1 \"DE123\" =$1 { =2.2 EUR} \n")
 
-    let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n"
-    assertRight parse
-    assertEqual "next-line comment\n" (let Right p = parse in pcomment p)
+    -- let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n"
+    -- assertRight parse
+    -- let Right p = parse
+    -- assertEqual "next-line comment\n" (pcomment p)
+    -- assertEqual (Just nullmixedamt) (pbalanceassertion p)
 #endif       
 
 -- | 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 NoPrice
 
-balanceassertion :: GenParser Char JournalContext (Maybe Amount)
+balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount)
 balanceassertion =
     try (do
           many spacenonewline
           char '='
           many spacenonewline
           a <- amountp -- XXX should restrict to a simple amount
-          return $ Just a)
+          return $ Just $ Mixed [a])
          <|> return Nothing
 
 -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices