lib,cli,ui,bin: Create a new API for MixedAmount arithmetic. This should

supplant the old interface, which relied on the Num typeclass.

MixedAmount did not have a very good Num instance. The only functions
which were defined were fromInteger, (+), and negate. Furthermore, it
was not law-abiding, as 0 + a /= a in general. Replacements for used
functions are:
0 -> nullmixedamt / mempty
(+) -> maPlus / (<>)
(-) -> maMinus
negate -> maNegate
sum -> maSum
sumStrict -> maSum

Also creates some new constructors for MixedAmount:
mixedAmount :: Amount -> MixedAmount
maAddAmount :: MixedAmount -> Amount -> MixedAmount
maAddAmounts :: MixedAmount -> [Amount] -> MixedAmount

Add Semigroup and Monoid instances for MixedAmount.
Ideally we would remove the Num instance entirely.

The only change needed have nullmixedamt/mempty substitute for
0 without problems was to not squash prices in
mixedAmount(Looks|Is)Zero. This is correct behaviour in any case.

bin/hledger-check-fancyassertions.hs

@@ -218,7 +218,7 @@ checkAssertion accounts = checkAssertion'
     evaluate (Account account) =
       fromMaybe H.nullmixedamt $ lookup account accounts
     evaluate (AccountNested account) =
-      sum [m | (a,m) <- accounts, account == a || (a <> pack ":") `isPrefixOf` account]
+      maSum [m | (a,m) <- accounts, account == a || (a <> pack ":") `isPrefixOf` account]
     evaluate (Amount amount) = H.mixed [amount]
 
     -- Add missing amounts (with 0 value), normalise, throw away style
@@ -279,7 +279,7 @@ closingBalances' postings =
 
 -- | Add balances in matching accounts.
 addAccounts :: [(H.AccountName, H.MixedAmount)] -> [(H.AccountName, H.MixedAmount)] -> [(H.AccountName, H.MixedAmount)]
-addAccounts as1 as2 = [ (a, a1 + a2)
+addAccounts as1 as2 = [ (a, a1 `maPlus` a2)
                       | a <- nub (map fst as1 ++ map fst as2)
                       , let a1 = fromMaybe H.nullmixedamt $ lookup a as1
                       , let a2 = fromMaybe H.nullmixedamt $ lookup a as2

bin/hledger-combine-balances.hs

@@ -34,7 +34,7 @@ appendReports r1 r2 =
     mergeRows (PeriodicReportRow name amt1 tot1 avg1) (PeriodicReportRow _ amt2 tot2 avg2) =
       PeriodicReportRow { prrName = name
         , prrAmounts = amt1++amt2
-        , prrTotal = tot1+tot2
+        , prrTotal = tot1 `maPlus` tot2
         , prrAverage = averageMixedAmounts [avg1,avg2]
         }
 

hledger-lib/Hledger/Data/Account.hs

@@ -65,7 +65,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, maSum 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}
@@ -122,7 +122,7 @@ sumAccounts a
   | otherwise      = a{aibalance=ibal, asubs=subs}
   where
     subs = map sumAccounts $ asubs a
-    ibal = sum $ aebalance a : map aibalance subs
+    ibal = maSum $ aebalance a : map aibalance subs
 
 -- | Remove all subaccounts below a certain depth.
 clipAccounts :: Int -> Account -> Account
@@ -139,7 +139,7 @@ clipAccountsAndAggregate Nothing  as = as
 clipAccountsAndAggregate (Just d) as = combined
     where
       clipped  = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as]
-      combined = [a{aebalance=sum $ map aebalance same}
+      combined = [a{aebalance=maSum $ map aebalance same}
                  | same@(a:_) <- groupOn aname clipped]
 {-
 test cases, assuming d=1:

hledger-lib/Hledger/Data/Amount.hs

@@ -94,6 +94,9 @@ module Hledger.Data.Amount (
   nullmixedamt,
   missingmixedamt,
   mixed,
+  mixedAmount,
+  maAddAmount,
+  maAddAmounts,
   amounts,
   filterMixedAmount,
   filterMixedAmountByCommodity,
@@ -104,12 +107,18 @@ module Hledger.Data.Amount (
   mixedAmountStripPrices,
   -- ** arithmetic
   mixedAmountCost,
+  maNegate,
+  maPlus,
+  maMinus,
+  maSum,
   divideMixedAmount,
   multiplyMixedAmount,
   averageMixedAmounts,
   isNegativeAmount,
   isNegativeMixedAmount,
   mixedAmountIsZero,
+  maIsZero,
+  maIsNonZero,
   mixedAmountLooksZero,
   mixedAmountTotalPriceToUnitPrice,
   -- ** rendering
@@ -138,12 +147,12 @@ import Control.Monad (foldM)
 import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
 import Data.Default (Default(..))
 import Data.Foldable (toList)
-import Data.List (intercalate, intersperse, mapAccumL, partition)
+import Data.List (foldl', intercalate, intersperse, mapAccumL, partition)
 import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe)
 #if !(MIN_VERSION_base(4,11,0))
-import Data.Semigroup ((<>))
+import Data.Semigroup (Semigroup(..))
 #endif
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.Builder as TB
@@ -494,13 +503,26 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
 -------------------------------------------------------------------------------
 -- MixedAmount
 
+instance Semigroup MixedAmount where
+  (<>) = maPlus
+
+instance Monoid MixedAmount where
+  mempty = nullmixedamt
+#if !(MIN_VERSION_base(4,11,0))
+  mappend = (<>)
+#endif
+
 instance Num MixedAmount where
-    fromInteger i = Mixed [fromInteger i]
+  fromInteger i = Mixed [fromInteger i]
-    negate (Mixed as) = Mixed $ map negate as
+  negate = maNegate
-    (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
+  (+)    = maPlus
-    (*)    = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
+  (*)    = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
-    abs    = error' "error, mixed amounts do not support abs"
+  abs    = error' "error, mixed amounts do not support abs"
-    signum = error' "error, mixed amounts do not support signum"
+  signum = error' "error, mixed amounts do not support signum"
+
+-- | Get a mixed amount's component amounts.
+amounts :: MixedAmount -> [Amount]
+amounts (Mixed as) = as
 
 -- | The empty mixed amount.
 nullmixedamt :: MixedAmount
@@ -514,6 +536,85 @@ missingmixedamt = Mixed [missingamt]
 mixed :: [Amount] -> MixedAmount
 mixed = normaliseMixedAmount . Mixed
 
+-- | Create a MixedAmount from a single Amount.
+mixedAmount :: Amount -> MixedAmount
+mixedAmount = Mixed . pure
+
+-- | Add an Amount to a MixedAmount, normalising the result.
+maAddAmount :: MixedAmount -> Amount -> MixedAmount
+maAddAmount (Mixed as) a = normaliseMixedAmount . Mixed $ a : as
+
+-- | Add a collection of Amounts to a MixedAmount, normalising the result.
+maAddAmounts :: MixedAmount -> [Amount] -> MixedAmount
+maAddAmounts (Mixed as) bs = bs `seq` normaliseMixedAmount . Mixed $ bs ++ as
+
+-- | Negate mixed amount's quantities (and total prices, if any).
+maNegate :: MixedAmount -> MixedAmount
+maNegate = transformMixedAmount negate
+
+-- | Sum two MixedAmount.
+maPlus :: MixedAmount -> MixedAmount -> MixedAmount
+maPlus (Mixed as) (Mixed bs) = normaliseMixedAmount . Mixed $ as ++ bs
+
+-- | Subtract a MixedAmount from another.
+maMinus :: MixedAmount -> MixedAmount -> MixedAmount
+maMinus a = maPlus a . maNegate
+
+-- | Sum a collection of MixedAmounts.
+maSum :: Foldable t => t MixedAmount -> MixedAmount
+maSum = foldl' maPlus nullmixedamt
+
+-- | Divide a mixed amount's quantities (and total prices, if any) by a constant.
+divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
+divideMixedAmount n = transformMixedAmount (/n)
+
+-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.
+multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
+multiplyMixedAmount n = transformMixedAmount (*n)
+
+-- | Apply a function to a mixed amount's quantities (and its total prices, if it has any).
+transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount
+transformMixedAmount f = mapMixedAmount (transformAmount f)
+
+-- | Calculate the average of some mixed amounts.
+averageMixedAmounts :: [MixedAmount] -> MixedAmount
+averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` maSum as
+
+-- | Is this mixed amount negative, if we can tell that unambiguously?
+-- Ie when normalised, are all individual commodity amounts negative ?
+isNegativeMixedAmount :: MixedAmount -> Maybe Bool
+isNegativeMixedAmount m =
+  case amounts $ normaliseMixedAmountSquashPricesForDisplay m of
+    []  -> Just False
+    [a] -> Just $ isNegativeAmount a
+    as | all isNegativeAmount as -> Just True
+    as | not (any isNegativeAmount as) -> Just False
+    _ -> Nothing  -- multiple amounts with different signs
+
+-- | Does this mixed amount appear to be zero when rendered with its display precision?
+-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
+-- and zero quantity for each unit price?
+mixedAmountLooksZero :: MixedAmount -> Bool
+mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmount
+
+-- | Is this mixed amount exactly zero, ignoring its display precision?
+-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
+-- and zero quantity for each unit price?
+mixedAmountIsZero :: MixedAmount -> Bool
+mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmount
+
+-- | Is this mixed amount exactly zero, ignoring its display precision?
+--
+-- A convenient alias for mixedAmountIsZero.
+maIsZero :: MixedAmount -> Bool
+maIsZero = mixedAmountIsZero
+
+-- | Is this mixed amount non-zero, ignoring its display precision?
+--
+-- A convenient alias for not . mixedAmountIsZero.
+maIsNonZero :: MixedAmount -> Bool
+maIsNonZero = not . mixedAmountIsZero
+
 -- | Simplify a mixed amount's component amounts:
 --
 -- * amounts in the same commodity are combined unless they have different prices or total prices
@@ -581,10 +682,6 @@ sumSimilarAmountsUsingFirstPrice a b = (a + b){aprice=p}
 -- sumSimilarAmountsNotingPriceDifference [] = nullamt
 -- sumSimilarAmountsNotingPriceDifference as = undefined
 
--- | Get a mixed amount's component amounts.
-amounts :: MixedAmount -> [Amount]
-amounts (Mixed as) = as
-
 -- | Filter a mixed amount's component amounts by a predicate.
 filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
 filterMixedAmount p (Mixed as) = Mixed $ filter p as
@@ -609,42 +706,6 @@ mapMixedAmount f (Mixed as) = Mixed $ map f as
 mixedAmountCost :: MixedAmount -> MixedAmount
 mixedAmountCost = mapMixedAmount amountCost
 
--- | Divide a mixed amount's quantities (and total prices, if any) by a constant.
-divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
-divideMixedAmount n = mapMixedAmount (divideAmount n)
-
--- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.
-multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
-multiplyMixedAmount n = mapMixedAmount (multiplyAmount n)
-
--- | Calculate the average of some mixed amounts.
-averageMixedAmounts :: [MixedAmount] -> MixedAmount
-averageMixedAmounts [] = 0
-averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as
-
--- | Is this mixed amount negative, if we can tell that unambiguously?
--- Ie when normalised, are all individual commodity amounts negative ?
-isNegativeMixedAmount :: MixedAmount -> Maybe Bool
-isNegativeMixedAmount m =
-  case amounts $ normaliseMixedAmountSquashPricesForDisplay m of
-    []  -> Just False
-    [a] -> Just $ isNegativeAmount a
-    as | all isNegativeAmount as -> Just True
-    as | not (any isNegativeAmount as) -> Just False
-    _ -> Nothing  -- multiple amounts with different signs
-
--- | Does this mixed amount appear to be zero when rendered with its display precision?
--- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
--- and zero quantity for each unit price?
-mixedAmountLooksZero :: MixedAmount -> Bool
-mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmountSquashPricesForDisplay
-
--- | Is this mixed amount exactly to be zero, ignoring its display precision?
--- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
--- and zero quantity for each unit price?
-mixedAmountIsZero :: MixedAmount -> Bool
-mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPricesForDisplay
-
 -- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we
 -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there.
 -- -- For now, use this when cross-commodity zero equality is important.
@@ -888,18 +949,18 @@ tests_Amount = tests "Amount" [
   ,tests "MixedAmount" [
 
      test "adding mixed amounts to zero, the commodity and amount style are preserved" $
-      sum (map (Mixed . (:[]))
+      maSum (map mixedAmount
-               [usd 1.25
+        [usd 1.25
-               ,usd (-1) `withPrecision` Precision 3
+        ,usd (-1) `withPrecision` Precision 3
-               ,usd (-0.25)
+        ,usd (-0.25)
-               ])
+        ])
         @?= Mixed [usd 0 `withPrecision` Precision 3]
 
     ,test "adding mixed amounts with total prices" $ do
-      sum (map (Mixed . (:[]))
+      maSum (map mixedAmount
-       [usd 1 @@ eur 1
+        [usd 1 @@ eur 1
-       ,usd (-2) @@ eur 1
+        ,usd (-2) @@ eur 1
-       ])
+        ])
         @?= Mixed [usd (-1) @@ eur 2 ]
 
     ,test "showMixedAmount" $ do

hledger-lib/Hledger/Data/Journal.hs

@@ -765,14 +765,14 @@ withRunningBalance f = ask >>= lift . lift . f
 -- | Get this account's current exclusive running balance.
 getRunningBalanceB :: AccountName -> Balancing s MixedAmount
 getRunningBalanceB acc = withRunningBalance $ \BalancingState{bsBalances} -> do
-  fromMaybe 0 <$> H.lookup bsBalances acc
+  fromMaybe nullmixedamt <$> H.lookup bsBalances acc
 
 -- | Add this amount to this account's exclusive running balance.
 -- Returns the new running balance.
 addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
 addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
-  old <- fromMaybe 0 <$> H.lookup bsBalances acc
+  old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
-  let new = old + amt
+  let new = maPlus old amt
   H.insert bsBalances acc new
   return new
 
@@ -780,9 +780,9 @@ addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances}
 -- Returns the change in exclusive running balance.
 setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
 setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
-  old <- fromMaybe 0 <$> H.lookup bsBalances acc
+  old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
   H.insert bsBalances acc amt
-  return $ amt - old
+  return $ maMinus amt old
 
 -- | Set this account's exclusive running balance to whatever amount
 -- makes its *inclusive* running balance (the sum of exclusive running
@@ -790,13 +790,13 @@ setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} ->
 -- Returns the change in exclusive running balance.
 setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
 setInclusiveRunningBalanceB acc newibal = withRunningBalance $ \BalancingState{bsBalances} -> do
-  oldebal  <- fromMaybe 0 <$> H.lookup bsBalances acc
+  oldebal  <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
   allebals <- H.toList bsBalances
   let subsibal =  -- sum of any subaccounts' running balances
-        sum $ map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals
+        maSum . map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals
-  let newebal = newibal - subsibal
+  let newebal = maMinus newibal subsibal
   H.insert bsBalances acc newebal
-  return $ newebal - oldebal
+  return $ maMinus newebal oldebal
 
 -- | Update (overwrite) this transaction in the balancing state.
 updateTransactionB :: Transaction -> Balancing s ()
@@ -909,7 +909,7 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
         False -> do
           oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
           let assignedbalthiscommodity = Mixed [baamount]
-              newbal = oldbalothercommodities + assignedbalthiscommodity
+              newbal = maPlus oldbalothercommodities assignedbalthiscommodity
           diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
           return (diff,newbal)
       let p' = p{pamount=diff, poriginal=Just $ originalPosting p}
@@ -961,9 +961,9 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
       -- sum the running balances of this account and any of its subaccounts seen so far
       withRunningBalance $ \BalancingState{bsBalances} ->
         H.foldM
-          (\ibal (acc, amt) -> return $ ibal +
+          (\ibal (acc, amt) -> return $
-            if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)
+            if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then maPlus ibal amt else ibal)
-          0
+          nullmixedamt
           bsBalances
     else return actualbal
   let

hledger-lib/Hledger/Data/Posting.hs

@@ -75,15 +75,16 @@ import Control.Monad (foldM)
 import Data.Foldable (asum)
 import Data.List.Extra (nubSort)
 import qualified Data.Map as M
-import Data.Maybe
+import Data.Maybe (fromMaybe, isJust)
 import Data.MemoUgly (memo)
+import Data.List (foldl')
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid
 #endif
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time.Calendar
+import Data.Time.Calendar (Day)
-import Safe
+import Safe (headDef)
 
 import Hledger.Utils
 import Hledger.Data.Types
@@ -197,7 +198,7 @@ accountNamesFromPostings :: [Posting] -> [AccountName]
 accountNamesFromPostings = nubSort . map paccount
 
 sumPostings :: [Posting] -> MixedAmount
-sumPostings = sumStrict . map pamount
+sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt
 
 -- | Remove all prices of a posting
 removePrices :: Posting -> Posting

hledger-lib/Hledger/Data/Transaction.hs

@@ -471,9 +471,9 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
         in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts)
   where
     (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
-    realsum = sumStrict $ map pamount amountfulrealps
+    realsum = sumPostings amountfulrealps
     (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)
-    bvsum = sumStrict $ map pamount amountfulbvps
+    bvsum = sumPostings amountfulbvps
 
     inferamount :: Posting -> (Posting, Maybe MixedAmount)
     inferamount p =
@@ -490,7 +490,7 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
               -- Inferred amounts are converted to cost.
               -- Also ensure the new amount has the standard style for its commodity
               -- (since the main amount styling pass happened before this balancing pass);
-              a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a)
+              a' = styleMixedAmount styles . normaliseMixedAmount . mixedAmountCost $ maNegate a
 
 -- | Infer prices for this transaction's posting amounts, if needed to make
 -- the postings balance, and if possible. This is done once for the real
@@ -542,10 +542,9 @@ priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
 priceInferrerFor t pt = inferprice
   where
     postings       = filter ((==pt).ptype) $ tpostings t
-    pmixedamounts  = map pamount postings
+    pamounts       = concatMap (amounts . pamount) postings
-    pamounts       = concatMap amounts pmixedamounts
     pcommodities   = map acommodity pamounts
-    sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price
+    sumamounts     = amounts $ sumPostings postings  -- sum normalises to one amount per commodity & price
     sumcommodities = map acommodity sumamounts
     sumprices      = filter (/=Nothing) $ map aprice sumamounts
     caninferprices = length sumcommodities == 2 && null sumprices

hledger-lib/Hledger/Read/CsvReader.hs

@@ -995,7 +995,7 @@ getAmount rules record currency p1IsVirtual n =
                           , let a = parseAmount rules record currency v
                           -- With amount/amount-in/amount-out, in posting 2,
                           -- flip the sign and convert to cost, as they did before 1.17
-                          , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (-a) else a
+                          , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (maNegate a) else a
                           ]
 
     -- if any of the numbered field names are present, discard all the unnumbered ones
@@ -1013,7 +1013,7 @@ getAmount rules record currency p1IsVirtual n =
   in case -- dbg0 ("amounts for posting "++show n)
           assignments'' of
       [] -> Nothing
-      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a)  -- for -out fields, flip the sign
+      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (maNegate a)  -- for -out fields, flip the sign
       [(_,a)] -> Just a
       fs      -> error' . T.unpack . T.unlines $ [  -- PARTIAL:
          "multiple non-zero amounts or multiple zero amounts assigned,"

hledger-lib/Hledger/Reports/AccountTransactionsReport.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-|
 
 An account-centric transactions report.
@@ -15,12 +17,12 @@ module Hledger.Reports.AccountTransactionsReport (
 )
 where
 
-import Data.List
+import Data.List (mapAccumL, nub, partition, sortBy)
-import Data.Ord
+import Data.Ord (comparing)
-import Data.Maybe
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time.Calendar
+import Data.Time.Calendar (Day)
 
 import Hledger.Data
 import Hledger.Query
@@ -145,7 +147,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
     filtertxns = txn_dates_ ropts
 
     items = reverse $
-            accountTransactionsReportItems reportq' thisacctq startbal negate $
+            accountTransactionsReportItems reportq' thisacctq startbal maNegate $
             (if filtertxns then filter (reportq' `matchesTransaction`) else id) $
             ts5
 
@@ -179,8 +181,8 @@ accountTransactionsReportItem reportq thisacctq signfn bal torig = balItem
                   otheracctstr | thisacctq == None  = summarisePostingAccounts reportps     -- no current account ? summarise all matched postings
                                | numotheraccts == 0 = summarisePostingAccounts thisacctps   -- only postings to current account ? summarise those
                                | otherwise          = summarisePostingAccounts otheracctps  -- summarise matched postings to other account(s)
-                  a = signfn $ negate $ sum $ map pamount thisacctps
+                  a = signfn . maNegate $ sumPostings thisacctps
-                  b = bal + a
+                  b = bal `maPlus` a
 
 -- | What is the transaction's date in the context of a particular account
 -- (specified with a query) and report query, as in an account register ?

hledger-lib/Hledger/Reports/BalanceReport.hs

@@ -112,7 +112,7 @@ tests_BalanceReport = tests "BalanceReport" [
     tests "balanceReport" [
 
      test "no args, null journal" $
-     (defreportspec, nulljournal) `gives` ([], 0)
+     (defreportspec, nulljournal) `gives` ([], nullmixedamt)
 
     ,test "no args, sample journal" $
      (defreportspec, samplejournal) `gives`
@@ -162,7 +162,7 @@ tests_BalanceReport = tests "BalanceReport" [
 
     ,test "with date:" $
      (defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
-      ([], 0)
+      ([], nullmixedamt)
 
     ,test "with date2:" $
      (defreportspec{rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
@@ -202,7 +202,7 @@ tests_BalanceReport = tests "BalanceReport" [
 
      ,test "with period on an unpopulated period" $
       (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
-       ([], 0)
+       ([], nullmixedamt)
 
 
 

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -206,7 +206,7 @@ combineBudgetAndActual ropts j
     sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows
       where
         (unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows
-        mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe 0 . fst)
+        mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe nullmixedamt . fst)
         rows = rows1 ++ rows2
 
     -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
@@ -244,7 +244,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
 
     displayCell (actual, budget) = (showamt actual', budgetAndPerc <$> budget)
       where
-        actual' = fromMaybe 0 actual
+        actual' = fromMaybe nullmixedamt actual
         budgetAndPerc b = (showamt b, showper <$> percentage actual' b)
         showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32}
         showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -174,7 +174,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
         (r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
       where
         subreportTotal (_, sr, increasestotal) =
-            (if increasestotal then id else fmap negate) $ prTotals sr
+            (if increasestotal then id else fmap maNegate) $ prTotals sr
 
     cbr = CompoundPeriodicReport "" (M.keys colps) subreports overalltotals
 
@@ -338,7 +338,7 @@ generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j priceoracle colps st
     displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix
 
     -- All the rows of the report.
-    rows = dbg5 "rows" . (if invert_ ropts then map (fmap negate) else id)  -- Negate amounts if applicable
+    rows = dbg5 "rows" . (if invert_ ropts then map (fmap maNegate) else id)  -- Negate amounts if applicable
              $ buildReportRows ropts displaynames matrix
 
     -- Calculate column totals
@@ -369,8 +369,8 @@ buildReportRows ropts displaynames =
         -- These are always simply the sum/average of the displayed row amounts.
         -- Total for a cumulative/historical report is always the last column.
         rowtot = case balancetype_ ropts of
-            PeriodChange -> sum rowbals
+            PeriodChange -> maSum rowbals
-            _            -> lastDef 0 rowbals
+            _            -> lastDef nullmixedamt rowbals
         rowavg = averageMixedAmounts rowbals
     balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance
 
@@ -439,7 +439,7 @@ sortRows ropts j
         -- Set the inclusive balance of an account from the rows, or sum the
         -- subaccounts if it's not present
         accounttreewithbals = mapAccounts setibalance accounttree
-        setibalance a = a{aibalance = maybe (sum . map aibalance $ asubs a) prrTotal $
+        setibalance a = a{aibalance = maybe (maSum . map aibalance $ asubs a) prrTotal $
                                           HM.lookup (aname a) rowMap}
         sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
         sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
@@ -470,14 +470,14 @@ calculateTotalsRow ropts rows =
 
     colamts = transpose . map prrAmounts $ filter isTopRow rows
 
-    coltotals :: [MixedAmount] = dbg5 "coltotals" $ map sum colamts
+    coltotals :: [MixedAmount] = dbg5 "coltotals" $ map maSum colamts
 
     -- Calculate the grand total and average. These are always the sum/average
     -- of the column totals.
     -- Total for a cumulative/historical report is always the last column.
     grandtotal = case balancetype_ ropts of
-        PeriodChange -> sum coltotals
+        PeriodChange -> maSum coltotals
-        _            -> lastDef 0 coltotals
+        _            -> lastDef nullmixedamt coltotals
     grandaverage = averageMixedAmounts coltotals
 
 -- | Map the report rows to percentages if needed
@@ -535,12 +535,12 @@ perdivide a b = fromMaybe (error' errmsg) $ do  -- PARTIAL:
 -- in scanl, so other properties (such as anumpostings) stay in the right place
 sumAcct :: Account -> Account -> Account
 sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
-    a{aibalance = i1 + i2, aebalance = e1 + e2}
+    a{aibalance = i1 `maPlus` i2, aebalance = e1 `maPlus` e2}
 
 -- Subtract the values in one account from another. Should be left-biased.
 subtractAcct :: Account -> Account -> Account
 subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =
-    a{aibalance = i1 - i2, aebalance = e1 - e2}
+    a{aibalance = i1 `maMinus` i2, aebalance = e1 `maMinus` e2}
 
 -- | Extract period changes from a cumulative list
 periodChanges :: Account -> Map k Account -> Map k Account
@@ -586,7 +586,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
   in
    tests "multiBalanceReport" [
       test "null journal"  $
-      (defreportspec, nulljournal) `gives` ([], Mixed [nullamt])
+      (defreportspec, nulljournal) `gives` ([], nullmixedamt)
 
      ,test "with -H on a populated period"  $
       (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -4,11 +4,11 @@ Postings report, used by the register command.
 
 -}
 
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections       #-}
 
 module Hledger.Reports.PostingsReport (
   PostingsReport,
@@ -21,11 +21,11 @@ module Hledger.Reports.PostingsReport (
 )
 where
 
-import Data.List
+import Data.List (nub, sortOn)
 import Data.List.Extra (nubSort)
-import Data.Maybe
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Text (Text)
-import Data.Time.Calendar
+import Data.Time.Calendar (Day, addDays)
 import Safe (headMay, lastMay)
 
 import Hledger.Data
@@ -101,12 +101,11 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
           -- of --value on reports".
           -- XXX balance report doesn't value starting balance.. should this ?
           historical = balancetype_ == HistoricalBalance
-          startbal | average_  = if historical then precedingavg else 0
+          startbal | average_  = if historical then precedingavg else nullmixedamt
-                   | otherwise = if historical then precedingsum else 0
+                   | otherwise = if historical then precedingsum else nullmixedamt
             where
               precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps
-              precedingavg | null precedingps = 0
+              precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
-                           | otherwise        = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
               daybeforereportstart =
                 maybe (error' "postingsReport: expected a non-empty journal")  -- PARTIAL: shouldn't happen
                 (addDays (-1))
@@ -121,8 +120,8 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
 -- and return the new average/total.
 registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
 registerRunningCalculationFn ropts
-  | average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg)
+  | average_ ropts = \i avg amt -> avg `maPlus` divideMixedAmount (fromIntegral i) (amt `maMinus` avg)
-  | otherwise      = \_ bal amt -> bal + amt
+  | otherwise      = \_ bal amt -> bal `maPlus` amt
 
 -- | Find postings matching a given query, within a given date span,
 -- and also any similarly-matched postings before that date span.
@@ -218,7 +217,7 @@ summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps
     e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e
     summaryp = nullposting{pdate=Just b'}
     clippedanames = nub $ map (clipAccountName mdepth) anames
-    summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sum $ map pamount ps}]
+    summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}]
               | otherwise        = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
     summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
     anames = nubSort $ map paccount ps
@@ -230,7 +229,7 @@ summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps
         isclipped a = maybe True (accountNameLevel a >=) mdepth
 
 negatePostingAmount :: Posting -> Posting
-negatePostingAmount p = p { pamount = negate $ pamount p }
+negatePostingAmount p = p { pamount = maNegate $ pamount p }
 
 
 -- tests

hledger-lib/Hledger/Reports/ReportTypes.hs

@@ -98,11 +98,11 @@ data PeriodicReportRow a b =
   , prrAverage :: b    -- The average of this row's values.
   } deriving (Show, Functor, Generic, ToJSON)
 
-instance Num b => Semigroup (PeriodicReportRow a b) where
+instance Semigroup b => Semigroup (PeriodicReportRow a b) where
   (PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) =
-      PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 + t2) (a1 + a2)
+      PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2)
     where
-      sumPadded (a:as) (b:bs) = (a + b) : sumPadded as bs
+      sumPadded (a:as) (b:bs) = (a <> b) : sumPadded as bs
       sumPadded as     []     = as
       sumPadded []     bs     = bs
 

hledger-lib/Hledger/Reports/TransactionsReport.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 {-|
 
 A transactions report. Like an EntriesReport, but with more
@@ -21,10 +23,10 @@ module Hledger.Reports.TransactionsReport (
 )
 where
 
-import Data.List
+import Data.List (sortBy)
 import Data.List.Extra (nubSort)
+import Data.Ord (comparing)
 import Data.Text (Text)
-import Data.Ord
 
 import Hledger.Data
 import Hledger.Query
@@ -99,7 +101,7 @@ filterTransactionsReportByCommodity c =
         startbal = filterMixedAmountByCommodity c $ triBalance i
         go _ [] = []
         go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is
-          where bal' = bal + amt
+          where bal' = bal `maPlus` amt
 
 -- tests
 

hledger-lib/Hledger/Utils.hs

@@ -4,7 +4,9 @@ Standard imports and utilities which are useful everywhere, or needed low
 in the module hierarchy. This is the bottom of hledger's module graph.
 
 -}
-{-# LANGUAGE OverloadedStrings, LambdaCase #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Hledger.Utils (---- provide these frequently used modules - or not, for clearer api:
                           -- module Control.Monad,
@@ -35,25 +37,21 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
 where
 
 import Control.Monad (liftM, when)
--- import Data.Char
 import Data.FileEmbed (makeRelativeToProject, embedStringFile)
-import Data.List
+import Data.List (foldl', foldl1')
--- import Data.Maybe
--- import Data.PPrint
 -- import Data.String.Here (hereFile)
 import Data.Text (Text)
 import qualified Data.Text.IO as T
-import Data.Time.Clock
+import Data.Time.Clock (getCurrentTime)
-import Data.Time.LocalTime
+import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone,
--- import Data.Text (Text)
+                            utcToLocalTime, utcToZonedTime)
--- import qualified Data.Text as T
 -- import Language.Haskell.TH.Quote (QuasiQuoter(..))
 import Language.Haskell.TH.Syntax (Q, Exp)
 import System.Directory (getHomeDirectory)
-import System.FilePath((</>), isRelative)
+import System.FilePath (isRelative, (</>))
 import System.IO
--- import Text.Printf
+  (Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
--- import qualified Data.Map as Map
+   openFile, stdin, universalNewlineMode, utf8_bom)
 
 import Hledger.Utils.Debug
 import Hledger.Utils.Parse

hledger/Hledger/Cli/Commands/Add.hs

@@ -360,8 +360,8 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
         c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
         -- eof
         return (a,c)
-      balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
+      balancingamt = maNegate . sumPostings $ filter isReal esPostings
-      balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt
+      balancingamtfirstcommodity = Mixed . take 1 $ amounts balancingamt
       showamt =
         showMixedAmount . mixedAmountSetPrecision
                   -- what should this be ?

hledger/Hledger/Cli/Commands/Balancesheet.hs

@@ -33,7 +33,7 @@ balancesheetSpec = CompoundBalanceCommandSpec {
       cbcsubreporttitle="Liabilities"
      ,cbcsubreportquery=journalLiabilityAccountQuery
      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
-     ,cbcsubreporttransform=fmap negate
+     ,cbcsubreporttransform=fmap maNegate
      ,cbcsubreportincreasestotal=False
      }
     ],
@@ -45,4 +45,3 @@ balancesheetmode = compoundBalanceCommandMode balancesheetSpec
 
 balancesheet :: CliOpts -> Journal -> IO ()
 balancesheet = compoundBalanceCommand balancesheetSpec
-

hledger/Hledger/Cli/Commands/Balancesheetequity.hs

@@ -34,14 +34,14 @@ balancesheetequitySpec = CompoundBalanceCommandSpec {
       cbcsubreporttitle="Liabilities"
      ,cbcsubreportquery=journalLiabilityAccountQuery
      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
-     ,cbcsubreporttransform=fmap negate
+     ,cbcsubreporttransform=fmap maNegate
      ,cbcsubreportincreasestotal=False
      }
     ,CBCSubreportSpec{
       cbcsubreporttitle="Equity"
      ,cbcsubreportquery=journalEquityAccountQuery
      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
-     ,cbcsubreporttransform=fmap negate
+     ,cbcsubreporttransform=fmap maNegate
      ,cbcsubreportincreasestotal=False
      }
     ],

hledger/Hledger/Cli/Commands/Close.hs

@@ -89,7 +89,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
 
     -- the balances to close
     (acctbals,_) = balanceReport rspec_ j
-    totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals
+    totalamt = maSum $ map (\(_,_,_,b) -> normalise b) acctbals
 
     -- since balance assertion amounts are required to be exact, the
     -- amounts in opening/closing transactions should be too (#941, #1137)
@@ -150,7 +150,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
                            , let commoditysum = (sum bs)]
         , (b, mcommoditysum) <- bs'
         ]
-      ++ [posting{paccount=openingacct, pamount=if explicit then mapMixedAmount precise (negate totalamt) else missingmixedamt} | not interleaved]
+      ++ [posting{paccount=openingacct, pamount=if explicit then mapMixedAmount precise (maNegate totalamt) else missingmixedamt} | not interleaved]
 
   -- print them
   when closing . T.putStr $ showTransaction closingtxn

hledger/Hledger/Cli/Commands/Incomestatement.hs

@@ -24,7 +24,7 @@ incomestatementSpec = CompoundBalanceCommandSpec {
       cbcsubreporttitle="Revenues"
      ,cbcsubreportquery=journalRevenueAccountQuery
      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
-     ,cbcsubreporttransform=fmap negate
+     ,cbcsubreporttransform=fmap maNegate
      ,cbcsubreportincreasestotal=True
      }
     ,CBCSubreportSpec{

hledger/Hledger/Cli/Commands/Registermatch.hs

@@ -34,7 +34,7 @@ registermatch opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j =
                                  ,Nothing
                                  ,tdescription <$> ptransaction p
                                  ,p
-                                 ,0)
+                                 ,nullmixedamt)
     _ -> putStrLn "please provide one description argument."
 
 -- Identify the closest recent match for this description in the given date-sorted postings.

hledger/Hledger/Cli/Commands/Roi.hs

@@ -115,7 +115,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
 
       priceDates = dbg3 "priceDates" $ nub $ filter (spanContainsDate span) priceDirectiveDates
       cashFlow =
-        ((map (\d -> (d,0)) priceDates)++) $
+        ((map (\d -> (d,nullmixedamt)) priceDates)++) $
         cashFlowApplyCostValue $
         calculateCashFlow trans (And [ Not investmentsQuery
                                      , Not pnlQuery
@@ -133,14 +133,14 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
 
     irr <- internalRateOfReturn showCashFlow prettyTables thisSpan
     twr <- timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue thisSpan
-    let cashFlowAmt = negate $ sum $ map snd cashFlow
+    let cashFlowAmt = maNegate . maSum $ map snd cashFlow
     let smallIsZero x = if abs x < 0.01 then 0.0 else x
     return [ showDate spanBegin
            , showDate (addDays (-1) spanEnd)
            , T.pack $ showMixedAmount valueBefore
            , T.pack $ showMixedAmount cashFlowAmt
            , T.pack $ showMixedAmount valueAfter
-           , T.pack $ showMixedAmount (valueAfter - (valueBefore + cashFlowAmt))
+           , T.pack $ showMixedAmount (valueAfter `maMinus` (valueBefore `maPlus` cashFlowAmt))
            , T.pack $ printf "%0.2f%%" $ smallIsZero irr
            , T.pack $ printf "%0.2f%%" $ smallIsZero twr ]
 
@@ -165,12 +165,12 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
         -- first for processing cash flow. This is why pnl changes are Left
         -- and cashflows are Right
         sort
-        $ (++) (map (\(date,amt) -> (date,Left (-amt))) pnl )
+        $ (++) (map (\(date,amt) -> (date,Left $ maNegate amt)) pnl )
         -- Aggregate all entries for a single day, assuming that intraday interest is negligible
-        $ map (\date_cash -> let (dates, cash) = unzip date_cash in (head dates, Right (sum cash)))
+        $ map (\date_cash -> let (dates, cash) = unzip date_cash in (head dates, Right (maSum cash)))
         $ groupBy ((==) `on` fst)
         $ sortOn fst
-        $ map (\(d,a) -> (d, negate a))
+        $ map (\(d,a) -> (d, maNegate a))
         $ cashFlow
 
   let units =
@@ -203,17 +203,15 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
   when showCashFlow $ do
     printf "\nTWR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
     let (dates', amounts) = unzip changes
-        cashflows' = map (either (\_ -> 0) id) amounts
+        cashflows' = map (either (const nullmixedamt) id) amounts
-        pnls' = map (either id (\_ -> 0)) amounts
+        pnls = map (either id (const nullmixedamt)) amounts
-        (valuesOnDate',unitsBoughtOrSold', unitPrices', unitBalances') = unzip4 units
+        (valuesOnDate,unitsBoughtOrSold', unitPrices', unitBalances') = unzip4 units
         add x lst = if valueBefore/=0 then x:lst else lst
         dates = add spanBegin dates'
         cashflows = add valueBeforeAmt cashflows'
-        pnls = add 0 pnls'
         unitsBoughtOrSold = add initialUnits unitsBoughtOrSold'
         unitPrices = add initialUnitPrice unitPrices'
         unitBalances = add initialUnits unitBalances'
-        valuesOnDate = add 0 valuesOnDate'
 
     TL.putStr $ Ascii.render prettyTables id id T.pack
       (Table
@@ -236,11 +234,11 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
   return annualizedTWR
 
 internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow _pnl) = do
-  let prefix = (spanBegin, negate valueBefore)
+  let prefix = (spanBegin, maNegate valueBefore)
 
       postfix = (spanEnd, valueAfter)
 
-      totalCF = filter ((/=0) . snd) $ prefix : (sortOn fst cashFlow) ++ [postfix]
+      totalCF = filter (maIsNonZero . snd) $ prefix : (sortOn fst cashFlow) ++ [postfix]
 
   when showCashFlow $ do
     printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
@@ -267,16 +265,15 @@ type CashFlow = [(Day, MixedAmount)]
 
 interestSum :: Day -> CashFlow -> Double -> Double
 interestSum referenceDay cf rate = sum $ map go cf
-    where go (t,m) = fromRational (toRational (unMix m)) * (rate ** (fromIntegral (referenceDay `diffDays` t) / 365))
+  where go (t,m) = realToFrac (unMix m) * rate ** (fromIntegral (referenceDay `diffDays` t) / 365)
 
 
 calculateCashFlow :: [Transaction] -> Query -> CashFlow
-calculateCashFlow trans query = filter ((/=0).snd) $ map go trans
+calculateCashFlow trans query = filter (maIsNonZero . snd) $ map go trans
-    where
+  where go t = (transactionDate2 t, total [t] query)
-    go t = (transactionDate2 t, total [t] query)
 
 total :: [Transaction] -> Query -> MixedAmount
-total trans query = sumPostings $  filter (matchesPosting query) $ concatMap realPostings trans
+total trans query = sumPostings . filter (matchesPosting query) $ concatMap realPostings trans
 
 unMix :: MixedAmount -> Quantity
 unMix a =