diff --git a/bin/_hledger-chart.hs b/bin/_hledger-chart.hs index c8ced0c8d..f0601c32d 100755 --- a/bin/_hledger-chart.hs +++ b/bin/_hledger-chart.hs @@ -162,7 +162,7 @@ sameSignNonZero is | otherwise = (map pos $ filter (test.fourth4) nzs, sign) where nzs = filter ((/=0).fourth4) is - pos (acct,_,_,Mixed as) = (acct, abs $ read $ show $ maybe 0 aquantity $ headMay as) + pos (acct,_,_,as) = (acct, abs $ read $ show $ maybe 0 aquantity $ headMay $ amounts as) sign = if fourth4 (head nzs) >= 0 then 1 else (-1) test = if sign > 0 then (>0) else (<0) diff --git a/bin/hledger-check-fancyassertions.hs b/bin/hledger-check-fancyassertions.hs index fc2d8cb0f..2f8ea1baa 100755 --- a/bin/hledger-check-fancyassertions.hs +++ b/bin/hledger-check-fancyassertions.hs @@ -218,15 +218,15 @@ 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 -- information, and sort by commodity name. - fixup (H.Mixed m1) (H.Mixed m2) = H.Mixed $ - let m = H.Mixed (m1 ++ [m_ { H.aquantity = 0 } | m_ <- m2]) - (H.Mixed as) = H.normaliseMixedAmount m - in sortOn H.acommodity . map (\a -> a { H.astyle = H.amountstyle }) $ as + fixup m1 m2 = + let m = H.mixed $ amounts m1 ++ [m_ { H.aquantity = 0 } | m_ <- amounts m2] + as = amounts $ H.normaliseMixedAmount m + in H.mixed $ sortOn H.acommodity . map (\a -> a { H.astyle = H.amountstyle }) $ as -- | Check if an account name is mentioned in an assertion. inAssertion :: H.AccountName -> Predicate -> Bool @@ -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..2633522b8 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 @@ -508,12 +530,91 @@ nullmixedamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. missingmixedamt :: MixedAmount -missingmixedamt = Mixed [missingamt] +missingmixedamt = mixedAmount missingamt -- | Convert amounts in various commodities into a normalised MixedAmount. 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,52 +949,52 @@ 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 - showMixedAmount (Mixed [usd 1]) @?= "$1.00" - showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00" - showMixedAmount (Mixed [usd 0]) @?= "0" - showMixedAmount (Mixed []) @?= "0" + showMixedAmount (mixedAmount (usd 1)) @?= "$1.00" + showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00" + showMixedAmount (mixedAmount (usd 0)) @?= "0" + showMixedAmount nullmixedamt @?= "0" showMixedAmount missingmixedamt @?= "" ,test "showMixedAmountWithoutPrice" $ do let a = usd 1 `at` eur 2 - showMixedAmountWithoutPrice False (Mixed [a]) @?= "$1.00" - showMixedAmountWithoutPrice False (Mixed [a, -a]) @?= "0" + showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00" + showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0" ,tests "normaliseMixedAmount" [ test "a missing amount overrides any other amounts" $ - normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt + amounts (normaliseMixedAmount $ mixed [usd 1, missingamt]) @?= [missingamt] ,test "unpriced same-commodity amounts are combined" $ - normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2] + amounts (normaliseMixedAmount $ mixed [usd 0, usd 2]) @?= [usd 2] ,test "amounts with same unit price are combined" $ - normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1] + amounts (normaliseMixedAmount $ mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1] ,test "amounts with different unit prices are not combined" $ - normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2] + amounts (normaliseMixedAmount $ mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2] ,test "amounts with total prices are combined" $ - normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 2 @@ eur 2] + amounts (normaliseMixedAmount $ mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2] ] ,test "normaliseMixedAmountSquashPricesForDisplay" $ do - normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt] + amounts (normaliseMixedAmountSquashPricesForDisplay nullmixedamt) @?= [nullamt] assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay - (Mixed [usd 10 + (mixed [usd 10 ,usd 10 @@ eur 7 ,usd (-10) - ,usd (-10) @@ eur 7 + ,usd (-10) @@ eur (-7) ]) ] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 537c4c53d..78f23103a 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -524,7 +524,7 @@ filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=map (filter -- | Filter out all parts of this posting's amount which do not match the query. filterPostingAmount :: Query -> Posting -> Posting -filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as} +filterPostingAmount q p@Posting{pamount=as} = p{pamount=filterMixedAmount (q `matchesAmount`) as} filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} @@ -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 () @@ -897,21 +897,15 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc return p -- no explicit posting amount, but there is a balance assignment - -- TODO this doesn't yet handle inclusive assignments right, #1207 | Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do - (diff,newbal) <- case batotal of - -- a total balance assignment (==, all commodities) - True -> do - let newbal = Mixed [baamount] - diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal - return (diff,newbal) - -- a partial balance assignment (=, one commodity) - False -> do - oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc - let assignedbalthiscommodity = Mixed [baamount] - newbal = oldbalothercommodities + assignedbalthiscommodity - diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal - return (diff,newbal) + newbal <- if batotal + -- a total balance assignment (==, all commodities) + then return $ mixedAmount baamount + -- a partial balance assignment (=, one commodity) + else do + oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc + return $ maAddAmount oldbalothercommodities baamount + diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal let p' = p{pamount=diff, poriginal=Just $ originalPosting p} whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal return p' @@ -961,9 +955,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 @@ -1153,7 +1147,7 @@ canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=m -- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} -- where -- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} --- fixmixedamount (Mixed as) = Mixed $ map fixamount as +-- fixmixedamount = mapMixedAmount fixamount -- fixamount = fixprice -- fixprice a@Amount{price=Just _} = a -- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c} @@ -1182,8 +1176,8 @@ journalInferMarketPricesFromTransactions j = postingInferredmarketPrice :: Posting -> Maybe MarketPrice postingInferredmarketPrice p@Posting{pamount} = -- convert any total prices to unit prices - case mixedAmountTotalPriceToUnitPrice pamount of - Mixed ( Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})} : _) -> + case amounts $ mixedAmountTotalPriceToUnitPrice pamount of + Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ -> Just MarketPrice { mpdate = postingDate p ,mpfrom = fromcomm @@ -1561,7 +1555,7 @@ tests_Journal = tests "Journal" [ ]} assertRight ej let Right j = ej - (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1] + (jtxns j & head & tpostings & head & pamount) @?= mixedAmount (num 1) ,test "same-day-1" $ do assertRight $ journalBalanceTransactions True $ diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 7e2679ce8..c06bbbf16 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,12 +198,11 @@ 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 -removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } - where remove a = a { aprice = Nothing } +removePrices = postingTransformAmount (mapMixedAmount $ \a -> a{aprice=Nothing}) -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 2d5f1fea2..8e121d6f7 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -121,7 +121,7 @@ entryFromTimeclockInOut i o showtime = take 5 . show hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc acctname = tlaccount i - amount = Mixed [hrs hours] + amount = mixedAmount $ hrs hours ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index e839954dc..45c0c8f7a 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,17 +542,16 @@ 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 inferprice p@Posting{pamount=Mixed [a]} | caninferprices && ptype p == pt && acommodity a == fromcommodity - = p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p} + = p{pamount=mixedAmount $ a{aprice=Just conversionprice}, poriginal=Just $ originalPosting p} where fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe totalpricesign = if aquantity a < 0 then negate else id diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 3a09b03a3..2a493a4a1 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -120,14 +120,14 @@ tmPostingRuleToFunction querytxt pr = -- Approach 1: convert to a unit price and increase the display precision slightly -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Approach 2: multiply the total price (keeping it positive) as well as the quantity - Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount + as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount in case acommodity pramount of - "" -> Mixed as + "" -> as -- TODO multipliers with commodity symbols are not yet a documented feature. -- For now: in addition to multiplying the quantity, it also replaces the -- matched amount's commodity, display style, and price with those of the posting rule. - c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] + c -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as postingRuleMultiplier :: TMPostingRule -> Maybe Quantity postingRuleMultiplier p = diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 3d6731493..fee9e7824 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -729,7 +729,7 @@ spaceandamountormissingp :: JournalParser m MixedAmount spaceandamountormissingp = option missingmixedamt $ try $ do lift $ skipNonNewlineSpaces1 - Mixed . (:[]) <$> amountp + mixedAmount <$> amountp -- | Parse a single-commodity amount, with optional symbol on the left -- or right, followed by, in any order: an optional transaction price, @@ -855,7 +855,7 @@ amountp' s = -- | Parse a mixed amount from a string, or get an error. mamountp' :: String -> MixedAmount -mamountp' = Mixed . (:[]) . amountp' +mamountp' = mixedAmount . amountp' -- | Parse a minus or plus sign followed by zero or more spaces, -- or nothing, returning a function that negates or does nothing. @@ -1560,7 +1560,7 @@ tests_Common = tests "Common" [ assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" "" ,tests "spaceandamountormissingp" [ - test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) + test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ usd 47.18) ,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt -- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 6623e001a..d5f224bc9 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," @@ -1048,7 +1048,7 @@ getBalance rules record currency n = do -- The whole CSV record is provided for the error message. parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount rules record currency s = - either mkerror (Mixed . (:[])) $ -- PARTIAL: + either mkerror mixedAmount $ -- PARTIAL: runParser (evalStateT (amountp <* eof) journalparsestate) "" $ currency <> simplifySign s where diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 027df37d7..1b5810ccb 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -711,7 +711,7 @@ postingp mTransactionYear = do return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift skipNonNewlineSpaces - amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp + amount <- option missingmixedamt $ mixedAmount <$> amountp lift skipNonNewlineSpaces massertion <- optional balanceassertionp lift skipNonNewlineSpaces 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..6cf73520b 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` @@ -125,7 +125,7 @@ tests_BalanceReport = tests "BalanceReport" [ ,("income:gifts","income:gifts",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with --tree" $ (defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives` @@ -142,7 +142,7 @@ tests_BalanceReport = tests "BalanceReport" [ ,("income:gifts","gifts",1, mamountp' "$-1.00") ,("income:salary","salary",1, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with --depth=N" $ (defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives` @@ -150,7 +150,7 @@ tests_BalanceReport = tests "BalanceReport" [ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with depth:N" $ (defreportspec{rsQuery=Depth 1}, samplejournal) `gives` @@ -158,11 +158,11 @@ tests_BalanceReport = tests "BalanceReport" [ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,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` @@ -170,7 +170,7 @@ tests_BalanceReport = tests "BalanceReport" [ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with desc:" $ (defreportspec{rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives` @@ -178,7 +178,7 @@ tests_BalanceReport = tests "BalanceReport" [ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with not:desc:" $ (defreportspec{rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives` @@ -189,7 +189,7 @@ tests_BalanceReport = tests "BalanceReport" [ ,("expenses:supplies","expenses:supplies",0, mamountp' "$1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with period on a populated period" $ (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}}, samplejournal) `gives` @@ -198,11 +198,11 @@ tests_BalanceReport = tests "BalanceReport" [ ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,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..26aa97e82 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) @@ -280,15 +280,15 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ -- - the goal is zero percentage :: Change -> BudgetGoal -> Maybe Percentage percentage actual budget = - case (maybecost $ normaliseMixedAmount actual, maybecost $ normaliseMixedAmount budget) of - (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b) + case (costedAmounts actual, costedAmounts budget) of + ([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b) -> Just $ 100 * aquantity a / aquantity b _ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage Nothing where - maybecost = case cost_ of - Cost -> mixedAmountCost - NoCost -> id + costedAmounts = case cost_ of + Cost -> amounts . mixedAmountCost . normaliseMixedAmount + NoCost -> amounts . normaliseMixedAmount maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 3d5362a90..5c7ed4a51 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,13 +586,13 @@ 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` ( - [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (Mixed [amt0 {aquantity=1}]) - , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (Mixed [amt0 {aquantity=(-1)}]) + [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (mixedAmount amt0{aquantity=1}) + , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (mixedAmount amt0{aquantity=(-1)}) ], mamountp' "$0.00") @@ -600,23 +600,23 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ -- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` -- ( -- [ - -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) - -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) + -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1}) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)}) -- ], - -- Mixed [usd0]) + -- mixedAmount usd0) -- ,test "a valid history on an empty period (more complex)" $ -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` -- ( -- [ - -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) - -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) - -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amt0 {aquantity=(-2)}]) - -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) - -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) - -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) - -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) + -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1}) + -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1}) + -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",mixedAmount amt0 {aquantity=(-2)}) + -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)}) + -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)}) + -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)}) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)}) -- ], - -- Mixed [usd0]) + -- mixedAmount usd0) ] ] diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 297d1f621..a51db0f7b 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 @@ -407,10 +406,10 @@ tests_PostingsReport = tests "PostingsReport" [ -- (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`) -- let ps = -- [ - -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 2]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [usd 4]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 8]} + -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 2)} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=mixedAmount (usd 4)} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 8)} -- ] -- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` -- [] @@ -420,21 +419,21 @@ tests_PostingsReport = tests "PostingsReport" [ -- ] -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -- [ - -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]} - -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]} - -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} + -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=mixedAmount (usd 4)} + -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 10)} + -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)} -- ] -- ("2008/01/01","2009/01/01",0,2,False,ts) `gives` -- [ - -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]} + -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=mixedAmount (usd 15)} -- ] -- ("2008/01/01","2009/01/01",0,1,False,ts) `gives` -- [ - -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]} + -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=mixedAmount (usd 15)} -- ] -- ("2008/01/01","2009/01/01",0,0,False,ts) `gives` -- [ - -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]} + -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=mixedAmount (usd 15)} -- ] ] 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-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index d1b958eea..122673d48 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -103,8 +103,7 @@ asInit d reset ui@UIState{ ,asItemRenderedAmounts = map showAmountWithoutPrice amts } where - Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal - stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} + amts = amounts . normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices bal displayitems = map displayitem items -- blanks added for scrolling control, cf RegisterScreen. -- XXX Ugly. Changing to 0 helps when debugging. diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 2cd37dced..20a9c5f17 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -329,7 +329,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do (mhistoricalp,followedhistoricalsofar) = case esSimilarTransaction of Nothing -> (Nothing,False) - Just Transaction{tpostings=ps} -> + Just Transaction{tpostings=ps} -> ( if length ps >= pnum then Just (ps !! (pnum-1)) else Nothing , all sameamount $ zip esPostings ps ) @@ -343,7 +343,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $ parser parseAmountAndComment $ withCompletion (amountCompleter def) $ - defaultTo' def $ + defaultTo' def $ nonEmpty $ linePrewritten (green $ printf "Amount %d%s: " pnum (showDefault def)) (fromMaybe "" $ prevAmountAndCmnt `atMay` length esPostings) "" where @@ -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/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 58248b293..78c8319e2 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -181,9 +181,8 @@ postingToCSV p = let credit = if q < 0 then showamt $ negate a_ else "" in let debit = if q >= 0 then showamt a_ else "" in [account, amount, c, credit, debit, status, comment]) - amounts + . amounts $ pamount p where - Mixed amounts = pamount p status = T.pack . show $ pstatus p account = showAccountName Nothing (ptype p) (paccount p) comment = T.strip $ pcomment p 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 =