lib: Make BalanceAssertion a full datatype

Note: simplifies/moves whitespace parsing out of the balance assertion
parser.

hledger-api/hledger-api.hs

@@ -170,6 +170,7 @@ instance ToJSON AmountStyle where toJSON = genericToJSON defaultOptions
 instance ToJSON Side where toJSON = genericToJSON defaultOptions
 instance ToJSON DigitGroupStyle where toJSON = genericToJSON defaultOptions
 instance ToJSON MixedAmount where toJSON = genericToJSON defaultOptions
+instance ToJSON BalanceAssertion where toJSON = genericToJSON defaultOptions
 instance ToJSON Price where toJSON = genericToJSON defaultOptions
 instance ToJSON MarketPrice where toJSON = genericToJSON defaultOptions
 instance ToJSON PostingType where toJSON = genericToJSON defaultOptions
@@ -213,6 +214,7 @@ instance ToSchema AmountStyle
 instance ToSchema Side
 instance ToSchema DigitGroupStyle
 instance ToSchema MixedAmount
+instance ToSchema BalanceAssertion
 instance ToSchema Price
 #if MIN_VERSION_swagger2(2,1,5)
   where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions

hledger-lib/Hledger/Data/Journal.hs

@@ -568,12 +568,13 @@ journalCheckBalanceAssertions j =
 -- | Check a posting's balance assertion and return an error if it
 -- fails.
 checkBalanceAssertion :: Posting -> MixedAmount -> Either String ()
-checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt
+checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass } bal
   | isReallyZeroAmount diff = Right ()
   | True    = Left err
-    where assertedcomm = acommodity ass
+    where amt = baamount ass
-          actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts amt)
+          assertedcomm = acommodity amt
-          diff = ass - actualbal
+          actualbal = fromMaybe nullamt $ find ((== assertedcomm) . acommodity) (amounts bal)
+          diff = amt - actualbal
           diffplus | isNegativeAmount diff == False = "+"
                    | otherwise = ""
           err = printf (unlines
@@ -591,13 +592,13 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt
                Nothing -> ":" -- shouldn't happen
                Just t ->  printf " in %s:\nin transaction:\n%s"
                           (showGenericSourcePos pos) (chomp $ showTransaction t) :: String
-                            where pos = snd $ fromJust $ pbalanceassertion p)
+                            where pos = baposition $ fromJust $ pbalanceassertion p)
             (showPostingLine p)
             (showDate $ postingDate p)
             (T.unpack $ paccount p) -- XXX pack
             assertedcomm
             (showAmount actualbal)
-            (showAmount ass)
+            (showAmount amt)
             (diffplus ++ showAmount diff)
 checkBalanceAssertion _ _ = Right ()
 
@@ -717,7 +718,7 @@ checkInferAndRegisterAmounts (Right oldTx) = do
   where
     inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting
     inferFromAssignment p = maybe (return p)
-      (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . fst)
+      (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . baamount)
       $ pbalanceassertion p
 
 -- | Adds a posting's amount to the posting's account balance and

hledger-lib/Hledger/Data/Posting.hs

@@ -15,6 +15,9 @@ module Hledger.Data.Posting (
   nullposting,
   posting,
   post,
+  nullsourcepos,
+  nullassertion,
+  assertion,
   -- * operations
   originalPosting,
   postingStatus,
@@ -96,6 +99,16 @@ posting = nullposting
 post :: AccountName -> Amount -> Posting
 post acct amt = posting {paccount=acct, pamount=Mixed [amt]}
 
+nullsourcepos :: GenericSourcePos
+nullsourcepos = JournalSourcePos "" (1,1)
+
+nullassertion, assertion :: BalanceAssertion
+nullassertion = BalanceAssertion
+                  {baamount=nullamt
+                  ,baposition=nullsourcepos
+                  }
+assertion = nullassertion
+
 -- Get the original posting, if any.
 originalPosting :: Posting -> Posting
 originalPosting p = fromMaybe p $ porigin p

hledger-lib/Hledger/Data/Transaction.hs

@@ -12,7 +12,6 @@ tags.
 
 module Hledger.Data.Transaction (
   -- * Transaction
-  nullsourcepos,
   nulltransaction,
   txnTieKnot,
   txnUntieKnot,
@@ -77,9 +76,6 @@ showGenericSourcePos = \case
     GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")"
     JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")"
 
-nullsourcepos :: GenericSourcePos
-nullsourcepos = JournalSourcePos "" (1,1)
-
 nulltransaction :: Transaction
 nulltransaction = Transaction {
                     tindex=0,
@@ -220,7 +216,7 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [
     | postingblock <- postingblocks]
   where
     postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, "  ", amount, assertion, samelinecomment] | amount <- shownAmounts]
-    assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . fst) $ pbalanceassertion p
+    assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p
     statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p
         where
           -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned  
@@ -681,10 +677,8 @@ tests_Transaction = tests "Transaction" [
           ,"    assets:checking"
           ,""
           ]
-    ]
 
-  ,tests "showTransaction" [
+    ,test "show a balanced transaction, no eliding" $
-     test "show a balanced transaction, no eliding" $
        (let t = Transaction 0 nullsourcepos (parsedate "2007/01/28") Nothing Unmarked "" "coopportunity" "" []
                 [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t}
                 ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t}

hledger-lib/Hledger/Data/Types.hs

@@ -236,7 +236,12 @@ instance Show Status where -- custom show.. bad idea.. don't do it..
   show Pending   = "!"
   show Cleared   = "*"
 
-type BalanceAssertion = Maybe (Amount, GenericSourcePos)
+data BalanceAssertion = BalanceAssertion {
+      baamount   :: Amount,
+      baposition :: GenericSourcePos
+    } deriving (Eq,Typeable,Data,Generic,Show)
+
+instance NFData BalanceAssertion
 
 data Posting = Posting {
       pdate             :: Maybe Day,         -- ^ this posting's date, if different from the transaction's
@@ -247,7 +252,7 @@ data Posting = Posting {
       pcomment          :: Text,              -- ^ this posting's comment lines, as a single non-indented multi-line string
       ptype             :: PostingType,
       ptags             :: [Tag],                   -- ^ tag names and values, extracted from the comment
-      pbalanceassertion :: BalanceAssertion,  -- ^ optional: the expected balance in this commodity in the account after this posting
+      pbalanceassertion :: Maybe BalanceAssertion,  -- ^ optional: the expected balance in this commodity 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.
       porigin           :: Maybe Posting            -- ^ When this posting has been transformed in some way

hledger-lib/Hledger/Read/Common.hs

@@ -74,7 +74,7 @@ module Hledger.Read.Common (
   mamountp',
   commoditysymbolp,
   priceamountp,
-  partialbalanceassertionp,
+  balanceassertionp,
   fixedlotpricep,
   numberp,
   fromRawNumber,
@@ -717,26 +717,16 @@ priceamountp = option NoPrice $ do
 
   pure $ priceConstructor priceAmount
 
-partialbalanceassertionp :: JournalParser m BalanceAssertion
+balanceassertionp :: JournalParser m BalanceAssertion
-partialbalanceassertionp = optional $ do
+balanceassertionp = do
-  sourcepos <- try $ do
-    lift (skipMany spacenonewline)
   sourcepos <- genericSourcePos <$> lift getSourcePos
   char '='
-    pure sourcepos
   lift (skipMany spacenonewline)
   a <- amountp <?> "amount (for a balance assertion or assignment)" -- XXX should restrict to a simple amount
-  return (a, sourcepos)
+  return BalanceAssertion
-
+    { baamount = a
--- balanceassertion :: Monad m => TextParser m (Maybe MixedAmount)
+    , baposition = sourcepos
--- balanceassertion =
+    }
---     try (do
---           lift (skipMany spacenonewline)
---           string "=="
---           lift (skipMany spacenonewline)
---           a <- amountp -- XXX should restrict to a simple amount
---           return $ Just $ Mixed [a])
---          <|> return Nothing
 
 -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
 fixedlotpricep :: JournalParser m (Maybe Amount)

hledger-lib/Hledger/Read/CsvReader.hs

@@ -748,10 +748,14 @@ transactionFromCsvRecord sourcepos rules record = t
       tcomment                 = T.pack comment,
       tpreceding_comment_lines = T.pack precomment,
       tpostings                =
-        [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=balance}
+        [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance}
         ,posting {paccount=account2, pamount=amount2, ptransaction=Just t}
         ]
       }
+    toAssertion (a, b) = BalanceAssertion{
+      baamount   = a,
+      baposition = b
+      }
 
 getAmountStr :: CsvRules -> CsvRecord -> Maybe String
 getAmountStr rules record =

hledger-lib/Hledger/Read/JournalReader.hs

@@ -589,7 +589,8 @@ postingp mTransactionYear = do
   let (ptype, account') = (accountNamePostingType account, textUnbracket account)
   lift (skipMany spacenonewline)
   amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp
-  massertion <- partialbalanceassertionp
+  lift (skipMany spacenonewline)
+  massertion <- optional $ balanceassertionp
   _ <- fixedlotpricep
   lift (skipMany spacenonewline)
   (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear

hledger/Hledger/Cli/Commands/Close.hs

@@ -85,7 +85,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
       balancingamt = negate $ sum $ map (\(_,_,_,b) -> normaliseMixedAmountSquashPricesForDisplay b) acctbals
       ps = [posting{paccount=a
                    ,pamount=mixed [b]
-                   ,pbalanceassertion=Just (b,nullsourcepos)
+                   ,pbalanceassertion=Just assertion{ baamount=b }
                    }
            |(a,_,_,mb) <- acctbals
            ,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb
@@ -93,7 +93,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
            ++ [posting{paccount="equity:opening balances", pamount=balancingamt}]
       nps = [posting{paccount=a
                     ,pamount=mixed [negate b]
-                    ,pbalanceassertion=Just (b{aquantity=0}, nullsourcepos)
+                    ,pbalanceassertion=Just assertion{ baamount=b{aquantity=0} }
                     }
             |(a,_,_,mb) <- acctbals
             ,b <- amounts $ normaliseMixedAmountSquashPricesForDisplay mb

site/contributors.md

@@ -8,6 +8,7 @@ hledger is brought to you by:
 -   Roman Cheplyaka - "chart" command, "add" command improvements
 -   Michael Snoyman - some additions to the Yesod web interface
 -   Marko Kocić - hlint cleanup
+-   Samuel May - exact assertions
 
 Developers who have not yet signed the contributor agreement: