From dabb3ef82e1bd95744cfe8b1830e5a1038598759 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 29 Jan 2021 23:34:18 +1100 Subject: [PATCH] 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 | 4 +- bin/hledger-combine-balances.hs | 2 +- hledger-lib/Hledger/Data/Account.hs | 6 +- hledger-lib/Hledger/Data/Amount.hs | 175 ++++++++++++------ hledger-lib/Hledger/Data/Journal.hs | 26 +-- hledger-lib/Hledger/Data/Posting.hs | 9 +- hledger-lib/Hledger/Data/Transaction.hs | 11 +- hledger-lib/Hledger/Read/CsvReader.hs | 4 +- .../Reports/AccountTransactionsReport.hs | 18 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 6 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 4 +- .../Hledger/Reports/MultiBalanceReport.hs | 24 +-- hledger-lib/Hledger/Reports/PostingsReport.hs | 29 ++- hledger-lib/Hledger/Reports/ReportTypes.hs | 6 +- .../Hledger/Reports/TransactionsReport.hs | 10 +- hledger-lib/Hledger/Utils.hs | 24 ++- hledger/Hledger/Cli/Commands/Add.hs | 4 +- hledger/Hledger/Cli/Commands/Balancesheet.hs | 3 +- .../Cli/Commands/Balancesheetequity.hs | 4 +- hledger/Hledger/Cli/Commands/Close.hs | 4 +- .../Hledger/Cli/Commands/Incomestatement.hs | 2 +- hledger/Hledger/Cli/Commands/Registermatch.hs | 2 +- hledger/Hledger/Cli/Commands/Roi.hs | 35 ++-- 23 files changed, 235 insertions(+), 177 deletions(-) diff --git a/bin/hledger-check-fancyassertions.hs b/bin/hledger-check-fancyassertions.hs index fc2d8cb0f..d0f111218 100755 --- a/bin/hledger-check-fancyassertions.hs +++ b/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 diff --git a/bin/hledger-combine-balances.hs b/bin/hledger-combine-balances.hs index 3e6db032e..8e73735ef 100755 --- a/bin/hledger-combine-balances.hs +++ b/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] } diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index 97dd7364c..539157837 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/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: diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index b62f2c6c5..a01330369 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/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] - negate (Mixed as) = Mixed $ map negate as - (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs - (*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL: - abs = error' "error, mixed amounts do not support abs" - signum = error' "error, mixed amounts do not support signum" + fromInteger i = Mixed [fromInteger i] + negate = maNegate + (+) = maPlus + (*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL: + abs = error' "error, mixed amounts do not support abs" + 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 . (:[])) - [usd 1.25 - ,usd (-1) `withPrecision` Precision 3 - ,usd (-0.25) - ]) + maSum (map mixedAmount + [usd 1.25 + ,usd (-1) `withPrecision` Precision 3 + ,usd (-0.25) + ]) @?= Mixed [usd 0 `withPrecision` Precision 3] ,test "adding mixed amounts with total prices" $ do - sum (map (Mixed . (:[])) - [usd 1 @@ eur 1 - ,usd (-2) @@ eur 1 - ]) + maSum (map mixedAmount + [usd 1 @@ eur 1 + ,usd (-2) @@ eur 1 + ]) @?= Mixed [usd (-1) @@ eur 2 ] ,test "showMixedAmount" $ do diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 537c4c53d..867140e42 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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 - let new = old + amt + old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc + 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 - let newebal = newibal - subsibal + maSum . map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals + 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 + - if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0) - 0 + (\ibal (acc, amt) -> return $ + if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then maPlus ibal amt else ibal) + nullmixedamt bsBalances else return actualbal let diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 7e2679ce8..866fb6698 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/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 Safe +import Data.Time.Calendar (Day) +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 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index e839954dc..290344741 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/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 pmixedamounts + pamounts = concatMap (amounts . pamount) postings 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 diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 6623e001a..2a9fdbb7c 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/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," diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 6b9c531ba..49b717f97 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/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.Ord -import Data.Maybe +import Data.List (mapAccumL, nub, partition, sortBy) +import Data.Ord (comparing) +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 - b = bal + a + a = signfn . maNegate $ sumPostings thisacctps + 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 ? diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 78f67881a..71ba82802 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/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) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 1081ab4ee..eab7b8ab7 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/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) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 3d5362a90..bcf72b866 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/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 @@ -357,7 +357,7 @@ buildReportRows :: ReportOpts -> HashMap AccountName DisplayName -> HashMap AccountName (Map DateSpan Account) -> [MultiBalanceReportRow] -buildReportRows ropts displaynames = +buildReportRows ropts displaynames = toList . HM.mapMaybeWithKey mkRow -- toList of HashMap's Foldable instance - does not sort consistently where mkRow name accts = do @@ -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 - _ -> lastDef 0 rowbals + PeriodChange -> maSum 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 - _ -> lastDef 0 coltotals + PeriodChange -> maSum 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` diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 297d1f621..4346dff32 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -4,11 +4,11 @@ Postings report, used by the register command. -} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# 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 - | otherwise = if historical then precedingsum else 0 + startbal | average_ = if historical then precedingavg else nullmixedamt + | otherwise = if historical then precedingsum else nullmixedamt where precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps - precedingavg | null precedingps = 0 - | otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum + precedingavg = 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) - | otherwise = \_ bal amt -> bal + amt + | average_ ropts = \i avg amt -> avg `maPlus` divideMixedAmount (fromIntegral i) (amt `maMinus` avg) + | 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 diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index e982e2edd..d985b32df 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/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 diff --git a/hledger-lib/Hledger/Reports/TransactionsReport.hs b/hledger-lib/Hledger/Reports/TransactionsReport.hs index a6cd1a37a..a469b52d6 100644 --- a/hledger-lib/Hledger/Reports/TransactionsReport.hs +++ b/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 diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index e8f319926..b4d41840b 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/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.Maybe --- import Data.PPrint +import Data.List (foldl', foldl1') -- import Data.String.Here (hereFile) import Data.Text (Text) import qualified Data.Text.IO as T -import Data.Time.Clock -import Data.Time.LocalTime --- import Data.Text (Text) --- import qualified Data.Text as T +import Data.Time.Clock (getCurrentTime) +import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone, + utcToLocalTime, utcToZonedTime) -- 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 --- import qualified Data.Map as Map + (Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode, + openFile, stdin, universalNewlineMode, utf8_bom) import Hledger.Utils.Debug import Hledger.Utils.Parse @@ -160,7 +158,7 @@ expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in expandPath _ "-" = return "-" expandPath curdir p = (if isRelative p then (curdir ) else id) `liftM` expandHomePath p -- PARTIAL: - + -- | Expand user home path indicated by tilde prefix expandHomePath :: FilePath -> IO FilePath expandHomePath = \case diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 2cd37dced..5b9802e56 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/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 - balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt + balancingamt = maNegate . sumPostings $ filter isReal esPostings + balancingamtfirstcommodity = Mixed . take 1 $ amounts balancingamt showamt = showMixedAmount . mixedAmountSetPrecision -- what should this be ? diff --git a/hledger/Hledger/Cli/Commands/Balancesheet.hs b/hledger/Hledger/Cli/Commands/Balancesheet.hs index 5bc817c97..da51b561f 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheet.hs +++ b/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 - diff --git a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs index fe3170b86..d7f62568c 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs +++ b/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 } ], diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index 911ab2fe9..3bab077c9 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/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 diff --git a/hledger/Hledger/Cli/Commands/Incomestatement.hs b/hledger/Hledger/Cli/Commands/Incomestatement.hs index c6e7a14cb..83ab577b7 100644 --- a/hledger/Hledger/Cli/Commands/Incomestatement.hs +++ b/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{ diff --git a/hledger/Hledger/Cli/Commands/Registermatch.hs b/hledger/Hledger/Cli/Commands/Registermatch.hs index aa0e83bd5..0465653ed 100755 --- a/hledger/Hledger/Cli/Commands/Registermatch.hs +++ b/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. diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 6d3812537..b32c3869b 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -102,7 +102,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..} -- Spans are [spanBegin,spanEnd), and spanEnd is 1 day after then actual end date we are interested in let cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue spanEnd d amt)) - + valueBefore = mixedAmountValue spanEnd spanBegin $ total trans (And [ investmentsQuery @@ -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 - pnls' = map (either id (\_ -> 0)) amounts - (valuesOnDate',unitsBoughtOrSold', unitPrices', unitBalances') = unzip4 units + cashflows' = map (either (const nullmixedamt) id) amounts + pnls = map (either id (const nullmixedamt)) amounts + (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 - where - go t = (transactionDate2 t, total [t] query) +calculateCashFlow trans query = filter (maIsNonZero . snd) $ map go trans + where 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 =