Exact assertions & multi commodity balances

.gitignore

@@ -36,18 +36,21 @@ TAGS
 /[0-9]*
 #
 *.j
+*.sw[op]
 
 # haskell stuff
 *.dyn_hi
 *.dyn_o
 *.hi
 *.p_o
 *.hp
+.cabal-sandbox/
 cabal-dev*
 cabal.project.local
 cabal.sandbox.config
 dist/
 dist-newstyle/
+.ghc.environment.*
 /Shake
 /.shake.html
 .stack-work/

cabal.project

@@ -3,3 +3,4 @@ packages: hledger-lib
           hledger-ui
           hledger-web
           hledger-api
+constraints: brick >= 0.36

examples/multi-commodity.journal

@@ -0,0 +1,15 @@
+2015-01-01 transaction 1
+  1:2:3                                    ( 1 + 1)
+  1:2:3:4                                  (-1 - 1)
+
+2015-01-02 transaction 2
+  1                                                    = 1 A + -1 B
+  1:2
+
+2015-01-03 transaction 3
+  1:2:3:4:5                                  1 A
+  1                                         -1 A      == -1 B
+
+2015-01-04 transaction 4
+  1:2                                       -1 A + 1 B
+  1:2:3:4:5                                  1 A - 1 B = 2 A - 1 B

hledger-api/hledger-api.hs

@@ -170,6 +170,8 @@ 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 AssertionFlags 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 +215,8 @@ instance ToSchema AmountStyle
 instance ToSchema Side
 instance ToSchema DigitGroupStyle
 instance ToSchema MixedAmount
+instance ToSchema BalanceAssertion
+instance ToSchema AssertionFlags
 instance ToSchema Price
 #if MIN_VERSION_swagger2(2,1,5)
   where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions

hledger-lib/Hledger/Data/Account.hs

@@ -66,7 +66,7 @@ accountsFromPostings ps =
   let
     grouped = groupSort [(paccount p,pamount p) | p <- ps]
     counted = [(aname, length amts) | (aname, amts) <- grouped]
-    summed =  [(aname, sumStrict amts) | (aname, amts) <- grouped]  -- always non-empty
+    summed =  [(aname, reduceMixedAmounts amts) | (aname, amts) <- grouped]  -- always non-empty
     acctstree      = accountTree "root" $ map fst summed
     acctswithnumps = mapAccounts setnumps    acctstree      where setnumps    a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted}
     acctswithebals = mapAccounts setebalance acctswithnumps where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}

hledger-lib/Hledger/Data/Amount.hs

@@ -59,6 +59,7 @@ module Hledger.Data.Amount (
   costOfAmount,
   divideAmount,
   multiplyAmount,
+  multiplyAmounts,
   amountValue,
   -- ** rendering
   amountstyle,
@@ -90,6 +91,9 @@ module Hledger.Data.Amount (
   costOfMixedAmount,
   divideMixedAmount,
   multiplyMixedAmount,
+  multiplyMixedAmounts,
+  combineMixedAmounts,
+  reduceMixedAmounts,
   averageMixedAmounts,
   isNegativeAmount,
   isNegativeMixedAmount,
@@ -182,7 +186,7 @@ amt @@ priceamt = amt{aprice=TotalPrice priceamt}
 -- A zero result keeps the commodity of the second amount.
 -- The result's display style is that of the second amount, with
 -- precision set to the highest of either amount.
--- Prices are ignored and discarded.
+-- Prices and multiplier flags are ignored and discarded.
 -- Remember: the caller is responsible for ensuring both amounts have the same commodity.
 similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
 similarAmountsOp op Amount{acommodity=_,  aquantity=q1, astyle=AmountStyle{asprecision=p1}}
@@ -215,7 +219,18 @@ divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d}
 
 -- | Multiply an amount's quantity by a constant.
 multiplyAmount :: Amount -> Quantity -> Amount
-multiplyAmount a@Amount{aquantity=q} d = a{aquantity=q*d}
+multiplyAmount a@Amount{aquantity=q} m = a { aquantity = q * m }
+
+-- | Multiply an amount's quantity by another, retaining the metadata of the
+-- second but the multiplier state of the first.
+multiplyAmounts :: Amount -> Amount -> Amount
+multiplyAmounts a m = case acommodity m of
+    "" -> a'
+    c  -> a' { acommodity = c
+             , astyle = astyle m
+             , aprice = aprice m
+             }
+  where a' = multiplyAmount a $ aquantity m
 
 -- | Is this amount negative ? The price is ignored.
 isNegativeAmount :: Amount -> Bool
@@ -249,7 +264,12 @@ withPrecision = flip setAmountPrecision
 -- appropriate to the current debug level. 9 shows maximum detail.
 showAmountDebug :: Amount -> String
 showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
-showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)
+showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s, amultiplier=%s}"
+  (show acommodity)
+  (show aquantity)
+  (showPriceDebug aprice)
+  (show astyle)
+  (show amultiplier)
 
 -- | Get the string representation of an amount, without any \@ price.
 showAmountWithoutPrice :: Amount -> String
@@ -471,14 +491,18 @@ normaliseHelper squashprices (Mixed as)
                _:_ -> last zeros
                _   -> nullamt
     (zeros, nonzeros) = partition isReallyZeroAmount $
-                        map sumSimilarAmountsUsingFirstPrice $
+                        map squashfn $
                         groupBy groupfn $
                         sortBy sortfn
                         as
+    squashfn [] = nullamt
+    squashfn (a:as)
+        | amultiplier a = (foldl' (*) a as) { aprice = aprice a, amultiplier = True }
+        | otherwise     = (foldl' (+) a as) { aprice = aprice a }
     sortfn  | squashprices = compare `on` acommodity
             | otherwise    = compare `on` \a -> (acommodity a, aprice a)
-    groupfn | squashprices = (==) `on` acommodity
-            | otherwise    = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2
+    groupfn | squashprices = (==) `on` \a -> (acommodity a, amultiplier a)
+            | otherwise    = \a1 a2 -> ((==) `on` \a -> (acommodity a, amultiplier a)) a1 a2 && combinableprices a1 a2
 
     combinableprices Amount{aprice=NoPrice} Amount{aprice=NoPrice} = True
     combinableprices Amount{aprice=UnitPrice p1} Amount{aprice=UnitPrice p2} = p1 == p2
@@ -490,13 +514,6 @@ normaliseHelper squashprices (Mixed as)
 normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount
 normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True
 
--- | Sum same-commodity amounts in a lossy way, applying the first
--- price to the result and discarding any other prices. Only used as a
--- rendering helper.
-sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount
-sumSimilarAmountsUsingFirstPrice [] = nullamt
-sumSimilarAmountsUsingFirstPrice as = (sumStrict as){aprice=aprice $ head as}
-
 -- -- | Sum same-commodity amounts. If there were different prices, set
 -- -- the price to a special marker indicating "various". Only used as a
 -- -- rendering helper.
@@ -534,7 +551,30 @@ divideMixedAmount (Mixed as) d = Mixed $ map (`divideAmount` d) as
 
 -- | Multiply a mixed amount's quantities by a constant.
 multiplyMixedAmount :: MixedAmount -> Quantity -> MixedAmount
-multiplyMixedAmount (Mixed as) d = Mixed $ map (`multiplyAmount` d) as
+multiplyMixedAmount (Mixed as) m = Mixed $ map (`multiplyAmount` m) as
+
+-- | Multiply a mixed amount's quantities by an amount, potentially collapsing
+-- multiple commodities into one if the multiplier explicitly lists one, as
+-- was done previously by auto-postings.
+multiplyMixedAmounts :: MixedAmount -> Amount -> MixedAmount
+multiplyMixedAmounts (Mixed as) m = normaliseMixedAmount $ Mixed $ map (`multiplyAmounts` m) as
+
+-- | Join two mixed amounts by either multiplying or adding each component
+-- `Amount` in the second according to its `amultiplier` state. Any multipliers
+-- in the first will remain as such in the result.
+combineMixedAmounts :: MixedAmount -> MixedAmount -> MixedAmount
+combineMixedAmounts l r@(Mixed rs) = case partition amultiplier rs of
+    ([], _)  -> r
+    (ms, as) -> reduceMixedAmounts [multiplyMixedAmounts l m | m <- ms] + Mixed as
+
+-- | Collapse a list of mixed amounts into a single sum, applying any multipliers
+-- in the chain, and not leaking space.
+reduceMixedAmounts :: [MixedAmount] -> MixedAmount
+reduceMixedAmounts [] = nullmixedamt
+reduceMixedAmounts (a:as) = foldl' combineOrAddMixedAmounts a as
+  where combineOrAddMixedAmounts l r
+          | any amultiplier $ amounts r = combineMixedAmounts l r
+          | otherwise = l + r
 
 -- | Calculate the average of some mixed amounts.
 averageMixedAmounts :: [MixedAmount] -> MixedAmount

hledger-lib/Hledger/Data/Commodity.hs

@@ -12,7 +12,6 @@ are thousands separated by comma, significant decimal places and so on.
 
 module Hledger.Data.Commodity
 where
-import Data.Char (isDigit)
 import Data.List
 import Data.Maybe (fromMaybe)
 #if !(MIN_VERSION_base(4,11,0))
@@ -26,13 +25,10 @@ import Hledger.Utils
 
 
 -- characters that may not be used in a non-quoted commodity symbol
-nonsimplecommoditychars = "0123456789-+.@*;\n \"{}=" :: [Char]
+nonsimplecommoditychars = "0123456789-+.@*;\n \"(){}=" :: [Char]
 
 isNonsimpleCommodityChar :: Char -> Bool
-isNonsimpleCommodityChar c = isDigit c || c `textElem` otherChars
- where
-   otherChars = "-+.@*;\n \"{}=" :: T.Text
-   textElem = T.any . (==)
+isNonsimpleCommodityChar = flip elem nonsimplecommoditychars
 
 quoteCommoditySymbolIfNeeded s | T.any (isNonsimpleCommodityChar) s = "\"" <> s <> "\""
                                | otherwise = s

hledger-lib/Hledger/Data/Journal.hs

@@ -494,11 +494,12 @@ journalFinalise t path txt assrt j@Journal{jfiles=fs} =
    j {jfiles        = (path,txt) : reverse fs
      ,jlastreadtime = t
      ,jdeclaredaccounts = reverse $ jdeclaredaccounts j
-     ,jtxns         = reverse $ jtxns j         -- NOTE: see addTransaction
+     ,jtxns         = reverse $ map filterMultipliers $ jtxns j -- NOTE: see addTransaction
      ,jtxnmodifiers = reverse $ jtxnmodifiers j -- NOTE: see addTransactionModifier
      ,jperiodictxns = reverse $ jperiodictxns j -- NOTE: see addPeriodicTransaction
      ,jmarketprices = reverse $ jmarketprices j -- NOTE: see addMarketPrice
      })
+  where filterMultipliers t = t { tpostings = map removeMultipliers $ tpostings t }
 
 journalNumberAndTieTransactions = journalTieTransactions . journalNumberTransactions
 
@@ -530,7 +531,22 @@ 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 =
+  foldl' fold (Right ()) amts0
+    where fold (Right _) cass = checkBalanceAssertionCommodity p cass bal
+          fold err _ = err
+          amts = amounts $ baamount ass
+          amts0 = amts ++ case afexact (baflags ass) of
+            False -> []
+            True -> map zero $ amounts $ filterMixedAmount (\a -> not $ elem (acommodity a) commodities) bal
+          commodities = map acommodity amts
+          zero a = a { aquantity = 0 }
+checkBalanceAssertion _ _ = Right ()
+
+-- | Check a component of a posting's balance assertion and return an
+-- error if it fails.
+checkBalanceAssertionCommodity :: Posting -> Amount -> MixedAmount -> Either String ()
+checkBalanceAssertionCommodity p ass amt
   | isReallyZeroAmount diff = Right ()
   | True    = Left err
     where assertedcomm = acommodity ass
@@ -552,16 +568,15 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just (ass,_)} amt
             (case ptransaction p of
                Nothing -> ":" -- shouldn't happen
                Just t ->  printf " in %s:\nin transaction:\n%s"
-                          (showGenericSourcePos pos) (chomp $ show t) :: String
-                            where pos = snd $ fromJust $ pbalanceassertion p)
+                          (showGenericSourcePos pos) (chomp $ T.unpack $ tdescription t) :: String
+                            where pos = baposition $ fromJust $ pbalanceassertion p)
             (showPostingLine p)
             (showDate $ postingDate p)
             (T.unpack $ paccount p) -- XXX pack
             assertedcomm
             (showAmount actualbal)
             (showAmount ass)
             (diffplus ++ showAmount diff)
-checkBalanceAssertion _ _ = Right ()
 
 -- | Fill in any missing amounts and check that all journal transactions
 -- balance, or return an error message. This is done after parsing all
@@ -678,9 +693,24 @@ checkInferAndRegisterAmounts (Right oldTx) = do
     (fmap void . addToBalance) styles oldTx { tpostings = newPostings }
   where
     inferFromAssignment :: Posting -> CurrentBalancesModifier s Posting
-    inferFromAssignment p = maybe (return p)
-      (fmap (\a -> p { pamount = a, porigin = Just $ originalPosting p }) . setBalance (paccount p) . fst)
-      $ pbalanceassertion p
+    inferFromAssignment p = do
+      let acc = paccount p
+      case pbalanceassertion p of
+        Just ba | afexact (baflags ba) -> do
+          diff <- setMixedBalance acc $ baamount ba
+          fullPosting diff p
+        Just ba | otherwise -> do
+          old <- liftModifier $ \Env{ eBalances = bals } -> HT.lookup bals acc
+          let amt = baamount ba
+              commodities = map acommodity $ amounts amt
+          diff <- setMixedBalance acc $
+            amt + filterMixedAmount (\a -> not $ acommodity a `elem` commodities) (fromMaybe nullmixedamt old)
+          fullPosting diff p
+        Nothing -> return p
+    fullPosting amt p = return p
+      { pamount = amt
+      , porigin = Just $ originalPosting p
+      }
 
 -- | Adds a posting's amount to the posting's account balance and
 -- checks a possible balance assertion. Or if there is no amount,
@@ -690,21 +720,19 @@ addAmountAndCheckBalance ::
   -> Posting
   -> CurrentBalancesModifier s Posting
 addAmountAndCheckBalance _ p | hasAmount p = do
-  newAmt <- addToBalance (paccount p) $ pamount p
+  newAmt <- addToBalance (paccount p) $ pamount $ removeMultipliers p
   assrt <- R.reader eAssrt
   lift $ when assrt $ ExceptT $ return $ checkBalanceAssertion p newAmt
   return p
 addAmountAndCheckBalance fallback p = fallback p
 
--- | Sets an account's balance to a given amount and returns the
--- difference of new and old amount.
-setBalance :: AccountName -> Amount -> CurrentBalancesModifier s MixedAmount
-setBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do
+-- | Sets all commodities comprising an account's balance to the given
+-- amounts and returns the difference from the previous balance.
+setMixedBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount
+setMixedBalance acc amt = liftModifier $ \Env{ eBalances = bals } -> do
   old <- HT.lookup bals acc
-  let new = Mixed $ (amt :) $ maybe []
-              (filter ((/= acommodity amt) . acommodity) . amounts) old
-  HT.insert bals acc new
-  return $ maybe new (new -) old
+  HT.insert bals acc amt
+  return $ maybe amt (amt -) old
 
 -- | Adds an amount to an account's balance and returns the resulting balance.
 addToBalance :: AccountName -> MixedAmount -> CurrentBalancesModifier s MixedAmount