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.
This commit is contained in:
parent
4b2c943867
commit
dabb3ef82e
@ -218,7 +218,7 @@ checkAssertion accounts = checkAssertion'
|
|||||||
evaluate (Account account) =
|
evaluate (Account account) =
|
||||||
fromMaybe H.nullmixedamt $ lookup account accounts
|
fromMaybe H.nullmixedamt $ lookup account accounts
|
||||||
evaluate (AccountNested account) =
|
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]
|
evaluate (Amount amount) = H.mixed [amount]
|
||||||
|
|
||||||
-- Add missing amounts (with 0 value), normalise, throw away style
|
-- Add missing amounts (with 0 value), normalise, throw away style
|
||||||
@ -279,7 +279,7 @@ closingBalances' postings =
|
|||||||
|
|
||||||
-- | Add balances in matching accounts.
|
-- | Add balances in matching accounts.
|
||||||
addAccounts :: [(H.AccountName, H.MixedAmount)] -> [(H.AccountName, H.MixedAmount)] -> [(H.AccountName, H.MixedAmount)]
|
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)
|
| a <- nub (map fst as1 ++ map fst as2)
|
||||||
, let a1 = fromMaybe H.nullmixedamt $ lookup a as1
|
, let a1 = fromMaybe H.nullmixedamt $ lookup a as1
|
||||||
, let a2 = fromMaybe H.nullmixedamt $ lookup a as2
|
, let a2 = fromMaybe H.nullmixedamt $ lookup a as2
|
||||||
|
|||||||
@ -34,7 +34,7 @@ appendReports r1 r2 =
|
|||||||
mergeRows (PeriodicReportRow name amt1 tot1 avg1) (PeriodicReportRow _ amt2 tot2 avg2) =
|
mergeRows (PeriodicReportRow name amt1 tot1 avg1) (PeriodicReportRow _ amt2 tot2 avg2) =
|
||||||
PeriodicReportRow { prrName = name
|
PeriodicReportRow { prrName = name
|
||||||
, prrAmounts = amt1++amt2
|
, prrAmounts = amt1++amt2
|
||||||
, prrTotal = tot1+tot2
|
, prrTotal = tot1 `maPlus` tot2
|
||||||
, prrAverage = averageMixedAmounts [avg1,avg2]
|
, prrAverage = averageMixedAmounts [avg1,avg2]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@ -65,7 +65,7 @@ accountsFromPostings ps =
|
|||||||
let
|
let
|
||||||
grouped = groupSort [(paccount p,pamount p) | p <- ps]
|
grouped = groupSort [(paccount p,pamount p) | p <- ps]
|
||||||
counted = [(aname, length amts) | (aname, amts) <- grouped]
|
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
|
acctstree = accountTree "root" $ map fst summed
|
||||||
acctswithnumps = mapAccounts setnumps acctstree where setnumps a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted}
|
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}
|
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}
|
| otherwise = a{aibalance=ibal, asubs=subs}
|
||||||
where
|
where
|
||||||
subs = map sumAccounts $ asubs a
|
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.
|
-- | Remove all subaccounts below a certain depth.
|
||||||
clipAccounts :: Int -> Account -> Account
|
clipAccounts :: Int -> Account -> Account
|
||||||
@ -139,7 +139,7 @@ clipAccountsAndAggregate Nothing as = as
|
|||||||
clipAccountsAndAggregate (Just d) as = combined
|
clipAccountsAndAggregate (Just d) as = combined
|
||||||
where
|
where
|
||||||
clipped = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as]
|
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]
|
| same@(a:_) <- groupOn aname clipped]
|
||||||
{-
|
{-
|
||||||
test cases, assuming d=1:
|
test cases, assuming d=1:
|
||||||
|
|||||||
@ -94,6 +94,9 @@ module Hledger.Data.Amount (
|
|||||||
nullmixedamt,
|
nullmixedamt,
|
||||||
missingmixedamt,
|
missingmixedamt,
|
||||||
mixed,
|
mixed,
|
||||||
|
mixedAmount,
|
||||||
|
maAddAmount,
|
||||||
|
maAddAmounts,
|
||||||
amounts,
|
amounts,
|
||||||
filterMixedAmount,
|
filterMixedAmount,
|
||||||
filterMixedAmountByCommodity,
|
filterMixedAmountByCommodity,
|
||||||
@ -104,12 +107,18 @@ module Hledger.Data.Amount (
|
|||||||
mixedAmountStripPrices,
|
mixedAmountStripPrices,
|
||||||
-- ** arithmetic
|
-- ** arithmetic
|
||||||
mixedAmountCost,
|
mixedAmountCost,
|
||||||
|
maNegate,
|
||||||
|
maPlus,
|
||||||
|
maMinus,
|
||||||
|
maSum,
|
||||||
divideMixedAmount,
|
divideMixedAmount,
|
||||||
multiplyMixedAmount,
|
multiplyMixedAmount,
|
||||||
averageMixedAmounts,
|
averageMixedAmounts,
|
||||||
isNegativeAmount,
|
isNegativeAmount,
|
||||||
isNegativeMixedAmount,
|
isNegativeMixedAmount,
|
||||||
mixedAmountIsZero,
|
mixedAmountIsZero,
|
||||||
|
maIsZero,
|
||||||
|
maIsNonZero,
|
||||||
mixedAmountLooksZero,
|
mixedAmountLooksZero,
|
||||||
mixedAmountTotalPriceToUnitPrice,
|
mixedAmountTotalPriceToUnitPrice,
|
||||||
-- ** rendering
|
-- ** rendering
|
||||||
@ -138,12 +147,12 @@ import Control.Monad (foldM)
|
|||||||
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
|
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
|
||||||
import Data.Default (Default(..))
|
import Data.Default (Default(..))
|
||||||
import Data.Foldable (toList)
|
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 Data.List.NonEmpty (NonEmpty(..), nonEmpty)
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
#if !(MIN_VERSION_base(4,11,0))
|
#if !(MIN_VERSION_base(4,11,0))
|
||||||
import Data.Semigroup ((<>))
|
import Data.Semigroup (Semigroup(..))
|
||||||
#endif
|
#endif
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Lazy.Builder as TB
|
import qualified Data.Text.Lazy.Builder as TB
|
||||||
@ -494,13 +503,26 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
|
|||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- MixedAmount
|
-- 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
|
instance Num MixedAmount where
|
||||||
fromInteger i = Mixed [fromInteger i]
|
fromInteger i = Mixed [fromInteger i]
|
||||||
negate (Mixed as) = Mixed $ map negate as
|
negate = maNegate
|
||||||
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
|
(+) = maPlus
|
||||||
(*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
|
(*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
|
||||||
abs = error' "error, mixed amounts do not support abs"
|
abs = error' "error, mixed amounts do not support abs"
|
||||||
signum = error' "error, mixed amounts do not support signum"
|
signum = error' "error, mixed amounts do not support signum"
|
||||||
|
|
||||||
|
-- | Get a mixed amount's component amounts.
|
||||||
|
amounts :: MixedAmount -> [Amount]
|
||||||
|
amounts (Mixed as) = as
|
||||||
|
|
||||||
-- | The empty mixed amount.
|
-- | The empty mixed amount.
|
||||||
nullmixedamt :: MixedAmount
|
nullmixedamt :: MixedAmount
|
||||||
@ -514,6 +536,85 @@ missingmixedamt = Mixed [missingamt]
|
|||||||
mixed :: [Amount] -> MixedAmount
|
mixed :: [Amount] -> MixedAmount
|
||||||
mixed = normaliseMixedAmount . Mixed
|
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:
|
-- | Simplify a mixed amount's component amounts:
|
||||||
--
|
--
|
||||||
-- * amounts in the same commodity are combined unless they have different prices or total prices
|
-- * 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 [] = nullamt
|
||||||
-- sumSimilarAmountsNotingPriceDifference as = undefined
|
-- 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.
|
-- | Filter a mixed amount's component amounts by a predicate.
|
||||||
filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
|
filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
|
||||||
filterMixedAmount p (Mixed as) = Mixed $ filter p as
|
filterMixedAmount p (Mixed as) = Mixed $ filter p as
|
||||||
@ -609,42 +706,6 @@ mapMixedAmount f (Mixed as) = Mixed $ map f as
|
|||||||
mixedAmountCost :: MixedAmount -> MixedAmount
|
mixedAmountCost :: MixedAmount -> MixedAmount
|
||||||
mixedAmountCost = mapMixedAmount amountCost
|
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
|
-- -- | 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.
|
-- -- 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.
|
-- -- For now, use this when cross-commodity zero equality is important.
|
||||||
@ -888,18 +949,18 @@ tests_Amount = tests "Amount" [
|
|||||||
,tests "MixedAmount" [
|
,tests "MixedAmount" [
|
||||||
|
|
||||||
test "adding mixed amounts to zero, the commodity and amount style are preserved" $
|
test "adding mixed amounts to zero, the commodity and amount style are preserved" $
|
||||||
sum (map (Mixed . (:[]))
|
maSum (map mixedAmount
|
||||||
[usd 1.25
|
[usd 1.25
|
||||||
,usd (-1) `withPrecision` Precision 3
|
,usd (-1) `withPrecision` Precision 3
|
||||||
,usd (-0.25)
|
,usd (-0.25)
|
||||||
])
|
])
|
||||||
@?= Mixed [usd 0 `withPrecision` Precision 3]
|
@?= Mixed [usd 0 `withPrecision` Precision 3]
|
||||||
|
|
||||||
,test "adding mixed amounts with total prices" $ do
|
,test "adding mixed amounts with total prices" $ do
|
||||||
sum (map (Mixed . (:[]))
|
maSum (map mixedAmount
|
||||||
[usd 1 @@ eur 1
|
[usd 1 @@ eur 1
|
||||||
,usd (-2) @@ eur 1
|
,usd (-2) @@ eur 1
|
||||||
])
|
])
|
||||||
@?= Mixed [usd (-1) @@ eur 2 ]
|
@?= Mixed [usd (-1) @@ eur 2 ]
|
||||||
|
|
||||||
,test "showMixedAmount" $ do
|
,test "showMixedAmount" $ do
|
||||||
|
|||||||
@ -765,14 +765,14 @@ withRunningBalance f = ask >>= lift . lift . f
|
|||||||
-- | Get this account's current exclusive running balance.
|
-- | Get this account's current exclusive running balance.
|
||||||
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
|
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
|
||||||
getRunningBalanceB acc = withRunningBalance $ \BalancingState{bsBalances} -> do
|
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.
|
-- | Add this amount to this account's exclusive running balance.
|
||||||
-- Returns the new running balance.
|
-- Returns the new running balance.
|
||||||
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
||||||
addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
|
addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
|
||||||
old <- fromMaybe 0 <$> H.lookup bsBalances acc
|
old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
|
||||||
let new = old + amt
|
let new = maPlus old amt
|
||||||
H.insert bsBalances acc new
|
H.insert bsBalances acc new
|
||||||
return new
|
return new
|
||||||
|
|
||||||
@ -780,9 +780,9 @@ addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances}
|
|||||||
-- Returns the change in exclusive running balance.
|
-- Returns the change in exclusive running balance.
|
||||||
setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
||||||
setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
|
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
|
H.insert bsBalances acc amt
|
||||||
return $ amt - old
|
return $ maMinus amt old
|
||||||
|
|
||||||
-- | Set this account's exclusive running balance to whatever amount
|
-- | Set this account's exclusive running balance to whatever amount
|
||||||
-- makes its *inclusive* running balance (the sum of exclusive running
|
-- 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.
|
-- Returns the change in exclusive running balance.
|
||||||
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
||||||
setInclusiveRunningBalanceB acc newibal = withRunningBalance $ \BalancingState{bsBalances} -> do
|
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
|
allebals <- H.toList bsBalances
|
||||||
let subsibal = -- sum of any subaccounts' running balances
|
let subsibal = -- sum of any subaccounts' running balances
|
||||||
sum $ map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals
|
maSum . map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals
|
||||||
let newebal = newibal - subsibal
|
let newebal = maMinus newibal subsibal
|
||||||
H.insert bsBalances acc newebal
|
H.insert bsBalances acc newebal
|
||||||
return $ newebal - oldebal
|
return $ maMinus newebal oldebal
|
||||||
|
|
||||||
-- | Update (overwrite) this transaction in the balancing state.
|
-- | Update (overwrite) this transaction in the balancing state.
|
||||||
updateTransactionB :: Transaction -> Balancing s ()
|
updateTransactionB :: Transaction -> Balancing s ()
|
||||||
@ -909,7 +909,7 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
|
|||||||
False -> do
|
False -> do
|
||||||
oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
|
oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
|
||||||
let assignedbalthiscommodity = Mixed [baamount]
|
let assignedbalthiscommodity = Mixed [baamount]
|
||||||
newbal = oldbalothercommodities + assignedbalthiscommodity
|
newbal = maPlus oldbalothercommodities assignedbalthiscommodity
|
||||||
diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
|
diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
|
||||||
return (diff,newbal)
|
return (diff,newbal)
|
||||||
let p' = p{pamount=diff, poriginal=Just $ originalPosting p}
|
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
|
-- sum the running balances of this account and any of its subaccounts seen so far
|
||||||
withRunningBalance $ \BalancingState{bsBalances} ->
|
withRunningBalance $ \BalancingState{bsBalances} ->
|
||||||
H.foldM
|
H.foldM
|
||||||
(\ibal (acc, amt) -> return $ ibal +
|
(\ibal (acc, amt) -> return $
|
||||||
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)
|
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then maPlus ibal amt else ibal)
|
||||||
0
|
nullmixedamt
|
||||||
bsBalances
|
bsBalances
|
||||||
else return actualbal
|
else return actualbal
|
||||||
let
|
let
|
||||||
|
|||||||
@ -75,15 +75,16 @@ import Control.Monad (foldM)
|
|||||||
import Data.Foldable (asum)
|
import Data.Foldable (asum)
|
||||||
import Data.List.Extra (nubSort)
|
import Data.List.Extra (nubSort)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe (fromMaybe, isJust)
|
||||||
import Data.MemoUgly (memo)
|
import Data.MemoUgly (memo)
|
||||||
|
import Data.List (foldl')
|
||||||
#if !(MIN_VERSION_base(4,11,0))
|
#if !(MIN_VERSION_base(4,11,0))
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
#endif
|
#endif
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar (Day)
|
||||||
import Safe
|
import Safe (headDef)
|
||||||
|
|
||||||
import Hledger.Utils
|
import Hledger.Utils
|
||||||
import Hledger.Data.Types
|
import Hledger.Data.Types
|
||||||
@ -197,7 +198,7 @@ accountNamesFromPostings :: [Posting] -> [AccountName]
|
|||||||
accountNamesFromPostings = nubSort . map paccount
|
accountNamesFromPostings = nubSort . map paccount
|
||||||
|
|
||||||
sumPostings :: [Posting] -> MixedAmount
|
sumPostings :: [Posting] -> MixedAmount
|
||||||
sumPostings = sumStrict . map pamount
|
sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt
|
||||||
|
|
||||||
-- | Remove all prices of a posting
|
-- | Remove all prices of a posting
|
||||||
removePrices :: Posting -> Posting
|
removePrices :: Posting -> Posting
|
||||||
|
|||||||
@ -471,9 +471,9 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
|
|||||||
in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts)
|
in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts)
|
||||||
where
|
where
|
||||||
(amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
|
(amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
|
||||||
realsum = sumStrict $ map pamount amountfulrealps
|
realsum = sumPostings amountfulrealps
|
||||||
(amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)
|
(amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)
|
||||||
bvsum = sumStrict $ map pamount amountfulbvps
|
bvsum = sumPostings amountfulbvps
|
||||||
|
|
||||||
inferamount :: Posting -> (Posting, Maybe MixedAmount)
|
inferamount :: Posting -> (Posting, Maybe MixedAmount)
|
||||||
inferamount p =
|
inferamount p =
|
||||||
@ -490,7 +490,7 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
|
|||||||
-- Inferred amounts are converted to cost.
|
-- Inferred amounts are converted to cost.
|
||||||
-- Also ensure the new amount has the standard style for its commodity
|
-- Also ensure the new amount has the standard style for its commodity
|
||||||
-- (since the main amount styling pass happened before this balancing pass);
|
-- (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
|
-- | 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
|
-- 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
|
priceInferrerFor t pt = inferprice
|
||||||
where
|
where
|
||||||
postings = filter ((==pt).ptype) $ tpostings t
|
postings = filter ((==pt).ptype) $ tpostings t
|
||||||
pmixedamounts = map pamount postings
|
pamounts = concatMap (amounts . pamount) postings
|
||||||
pamounts = concatMap amounts pmixedamounts
|
|
||||||
pcommodities = map acommodity pamounts
|
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
|
sumcommodities = map acommodity sumamounts
|
||||||
sumprices = filter (/=Nothing) $ map aprice sumamounts
|
sumprices = filter (/=Nothing) $ map aprice sumamounts
|
||||||
caninferprices = length sumcommodities == 2 && null sumprices
|
caninferprices = length sumcommodities == 2 && null sumprices
|
||||||
|
|||||||
@ -995,7 +995,7 @@ getAmount rules record currency p1IsVirtual n =
|
|||||||
, let a = parseAmount rules record currency v
|
, let a = parseAmount rules record currency v
|
||||||
-- With amount/amount-in/amount-out, in posting 2,
|
-- With amount/amount-in/amount-out, in posting 2,
|
||||||
-- flip the sign and convert to cost, as they did before 1.17
|
-- 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
|
-- 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)
|
in case -- dbg0 ("amounts for posting "++show n)
|
||||||
assignments'' of
|
assignments'' of
|
||||||
[] -> Nothing
|
[] -> 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
|
[(_,a)] -> Just a
|
||||||
fs -> error' . T.unpack . T.unlines $ [ -- PARTIAL:
|
fs -> error' . T.unpack . T.unlines $ [ -- PARTIAL:
|
||||||
"multiple non-zero amounts or multiple zero amounts assigned,"
|
"multiple non-zero amounts or multiple zero amounts assigned,"
|
||||||
|
|||||||
@ -1,4 +1,6 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
An account-centric transactions report.
|
An account-centric transactions report.
|
||||||
@ -15,12 +17,12 @@ module Hledger.Reports.AccountTransactionsReport (
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.List
|
import Data.List (mapAccumL, nub, partition, sortBy)
|
||||||
import Data.Ord
|
import Data.Ord (comparing)
|
||||||
import Data.Maybe
|
import Data.Maybe (catMaybes, fromMaybe)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar (Day)
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Query
|
import Hledger.Query
|
||||||
@ -145,7 +147,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
|
|||||||
filtertxns = txn_dates_ ropts
|
filtertxns = txn_dates_ ropts
|
||||||
|
|
||||||
items = reverse $
|
items = reverse $
|
||||||
accountTransactionsReportItems reportq' thisacctq startbal negate $
|
accountTransactionsReportItems reportq' thisacctq startbal maNegate $
|
||||||
(if filtertxns then filter (reportq' `matchesTransaction`) else id) $
|
(if filtertxns then filter (reportq' `matchesTransaction`) else id) $
|
||||||
ts5
|
ts5
|
||||||
|
|
||||||
@ -179,8 +181,8 @@ accountTransactionsReportItem reportq thisacctq signfn bal torig = balItem
|
|||||||
otheracctstr | thisacctq == None = summarisePostingAccounts reportps -- no current account ? summarise all matched postings
|
otheracctstr | thisacctq == None = summarisePostingAccounts reportps -- no current account ? summarise all matched postings
|
||||||
| numotheraccts == 0 = summarisePostingAccounts thisacctps -- only postings to current account ? summarise those
|
| numotheraccts == 0 = summarisePostingAccounts thisacctps -- only postings to current account ? summarise those
|
||||||
| otherwise = summarisePostingAccounts otheracctps -- summarise matched postings to other account(s)
|
| otherwise = summarisePostingAccounts otheracctps -- summarise matched postings to other account(s)
|
||||||
a = signfn $ negate $ sum $ map pamount thisacctps
|
a = signfn . maNegate $ sumPostings thisacctps
|
||||||
b = bal + a
|
b = bal `maPlus` a
|
||||||
|
|
||||||
-- | What is the transaction's date in the context of a particular account
|
-- | 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 ?
|
-- (specified with a query) and report query, as in an account register ?
|
||||||
|
|||||||
@ -112,7 +112,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
|||||||
tests "balanceReport" [
|
tests "balanceReport" [
|
||||||
|
|
||||||
test "no args, null journal" $
|
test "no args, null journal" $
|
||||||
(defreportspec, nulljournal) `gives` ([], 0)
|
(defreportspec, nulljournal) `gives` ([], nullmixedamt)
|
||||||
|
|
||||||
,test "no args, sample journal" $
|
,test "no args, sample journal" $
|
||||||
(defreportspec, samplejournal) `gives`
|
(defreportspec, samplejournal) `gives`
|
||||||
@ -162,7 +162,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
|||||||
|
|
||||||
,test "with date:" $
|
,test "with date:" $
|
||||||
(defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
(defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||||
([], 0)
|
([], nullmixedamt)
|
||||||
|
|
||||||
,test "with date2:" $
|
,test "with date2:" $
|
||||||
(defreportspec{rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
(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" $
|
,test "with period on an unpopulated period" $
|
||||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
|
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
|
||||||
([], 0)
|
([], nullmixedamt)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -206,7 +206,7 @@ combineBudgetAndActual ropts j
|
|||||||
sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows
|
sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows
|
||||||
where
|
where
|
||||||
(unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows
|
(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
|
rows = rows1 ++ rows2
|
||||||
|
|
||||||
-- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
|
-- 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)
|
displayCell (actual, budget) = (showamt actual', budgetAndPerc <$> budget)
|
||||||
where
|
where
|
||||||
actual' = fromMaybe 0 actual
|
actual' = fromMaybe nullmixedamt actual
|
||||||
budgetAndPerc b = (showamt b, showper <$> percentage actual' b)
|
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}
|
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)
|
showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)
|
||||||
|
|||||||
@ -174,7 +174,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
|||||||
(r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
|
(r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
|
||||||
where
|
where
|
||||||
subreportTotal (_, sr, increasestotal) =
|
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
|
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
|
displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix
|
||||||
|
|
||||||
-- All the rows of the report.
|
-- 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
|
$ buildReportRows ropts displaynames matrix
|
||||||
|
|
||||||
-- Calculate column totals
|
-- Calculate column totals
|
||||||
@ -357,7 +357,7 @@ buildReportRows :: ReportOpts
|
|||||||
-> HashMap AccountName DisplayName
|
-> HashMap AccountName DisplayName
|
||||||
-> HashMap AccountName (Map DateSpan Account)
|
-> HashMap AccountName (Map DateSpan Account)
|
||||||
-> [MultiBalanceReportRow]
|
-> [MultiBalanceReportRow]
|
||||||
buildReportRows ropts displaynames =
|
buildReportRows ropts displaynames =
|
||||||
toList . HM.mapMaybeWithKey mkRow -- toList of HashMap's Foldable instance - does not sort consistently
|
toList . HM.mapMaybeWithKey mkRow -- toList of HashMap's Foldable instance - does not sort consistently
|
||||||
where
|
where
|
||||||
mkRow name accts = do
|
mkRow name accts = do
|
||||||
@ -369,8 +369,8 @@ buildReportRows ropts displaynames =
|
|||||||
-- These are always simply the sum/average of the displayed row amounts.
|
-- These are always simply the sum/average of the displayed row amounts.
|
||||||
-- Total for a cumulative/historical report is always the last column.
|
-- Total for a cumulative/historical report is always the last column.
|
||||||
rowtot = case balancetype_ ropts of
|
rowtot = case balancetype_ ropts of
|
||||||
PeriodChange -> sum rowbals
|
PeriodChange -> maSum rowbals
|
||||||
_ -> lastDef 0 rowbals
|
_ -> lastDef nullmixedamt rowbals
|
||||||
rowavg = averageMixedAmounts rowbals
|
rowavg = averageMixedAmounts rowbals
|
||||||
balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance
|
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
|
-- Set the inclusive balance of an account from the rows, or sum the
|
||||||
-- subaccounts if it's not present
|
-- subaccounts if it's not present
|
||||||
accounttreewithbals = mapAccounts setibalance accounttree
|
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}
|
HM.lookup (aname a) rowMap}
|
||||||
sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
|
sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
|
||||||
sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
|
sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
|
||||||
@ -470,14 +470,14 @@ calculateTotalsRow ropts rows =
|
|||||||
|
|
||||||
colamts = transpose . map prrAmounts $ filter isTopRow 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
|
-- Calculate the grand total and average. These are always the sum/average
|
||||||
-- of the column totals.
|
-- of the column totals.
|
||||||
-- Total for a cumulative/historical report is always the last column.
|
-- Total for a cumulative/historical report is always the last column.
|
||||||
grandtotal = case balancetype_ ropts of
|
grandtotal = case balancetype_ ropts of
|
||||||
PeriodChange -> sum coltotals
|
PeriodChange -> maSum coltotals
|
||||||
_ -> lastDef 0 coltotals
|
_ -> lastDef nullmixedamt coltotals
|
||||||
grandaverage = averageMixedAmounts coltotals
|
grandaverage = averageMixedAmounts coltotals
|
||||||
|
|
||||||
-- | Map the report rows to percentages if needed
|
-- | 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
|
-- in scanl, so other properties (such as anumpostings) stay in the right place
|
||||||
sumAcct :: Account -> Account -> Account
|
sumAcct :: Account -> Account -> Account
|
||||||
sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
|
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.
|
-- Subtract the values in one account from another. Should be left-biased.
|
||||||
subtractAcct :: Account -> Account -> Account
|
subtractAcct :: Account -> Account -> Account
|
||||||
subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =
|
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
|
-- | Extract period changes from a cumulative list
|
||||||
periodChanges :: Account -> Map k Account -> Map k Account
|
periodChanges :: Account -> Map k Account -> Map k Account
|
||||||
@ -586,7 +586,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
|||||||
in
|
in
|
||||||
tests "multiBalanceReport" [
|
tests "multiBalanceReport" [
|
||||||
test "null journal" $
|
test "null journal" $
|
||||||
(defreportspec, nulljournal) `gives` ([], Mixed [nullamt])
|
(defreportspec, nulljournal) `gives` ([], nullmixedamt)
|
||||||
|
|
||||||
,test "with -H on a populated period" $
|
,test "with -H on a populated period" $
|
||||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`
|
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`
|
||||||
|
|||||||
@ -4,11 +4,11 @@ Postings report, used by the register command.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
module Hledger.Reports.PostingsReport (
|
module Hledger.Reports.PostingsReport (
|
||||||
PostingsReport,
|
PostingsReport,
|
||||||
@ -21,11 +21,11 @@ module Hledger.Reports.PostingsReport (
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.List
|
import Data.List (nub, sortOn)
|
||||||
import Data.List.Extra (nubSort)
|
import Data.List.Extra (nubSort)
|
||||||
import Data.Maybe
|
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar (Day, addDays)
|
||||||
import Safe (headMay, lastMay)
|
import Safe (headMay, lastMay)
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
@ -101,12 +101,11 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
|
|||||||
-- of --value on reports".
|
-- of --value on reports".
|
||||||
-- XXX balance report doesn't value starting balance.. should this ?
|
-- XXX balance report doesn't value starting balance.. should this ?
|
||||||
historical = balancetype_ == HistoricalBalance
|
historical = balancetype_ == HistoricalBalance
|
||||||
startbal | average_ = if historical then precedingavg else 0
|
startbal | average_ = if historical then precedingavg else nullmixedamt
|
||||||
| otherwise = if historical then precedingsum else 0
|
| otherwise = if historical then precedingsum else nullmixedamt
|
||||||
where
|
where
|
||||||
precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps
|
precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps
|
||||||
precedingavg | null precedingps = 0
|
precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
|
||||||
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
|
|
||||||
daybeforereportstart =
|
daybeforereportstart =
|
||||||
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
|
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
|
||||||
(addDays (-1))
|
(addDays (-1))
|
||||||
@ -121,8 +120,8 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
|
|||||||
-- and return the new average/total.
|
-- and return the new average/total.
|
||||||
registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
|
registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
|
||||||
registerRunningCalculationFn ropts
|
registerRunningCalculationFn ropts
|
||||||
| average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg)
|
| average_ ropts = \i avg amt -> avg `maPlus` divideMixedAmount (fromIntegral i) (amt `maMinus` avg)
|
||||||
| otherwise = \_ bal amt -> bal + amt
|
| otherwise = \_ bal amt -> bal `maPlus` amt
|
||||||
|
|
||||||
-- | Find postings matching a given query, within a given date span,
|
-- | Find postings matching a given query, within a given date span,
|
||||||
-- and also any similarly-matched postings before that 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
|
e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e
|
||||||
summaryp = nullposting{pdate=Just b'}
|
summaryp = nullposting{pdate=Just b'}
|
||||||
clippedanames = nub $ map (clipAccountName mdepth) anames
|
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]
|
| otherwise = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
|
||||||
summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
|
summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps
|
||||||
anames = nubSort $ map paccount ps
|
anames = nubSort $ map paccount ps
|
||||||
@ -230,7 +229,7 @@ summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps
|
|||||||
isclipped a = maybe True (accountNameLevel a >=) mdepth
|
isclipped a = maybe True (accountNameLevel a >=) mdepth
|
||||||
|
|
||||||
negatePostingAmount :: Posting -> Posting
|
negatePostingAmount :: Posting -> Posting
|
||||||
negatePostingAmount p = p { pamount = negate $ pamount p }
|
negatePostingAmount p = p { pamount = maNegate $ pamount p }
|
||||||
|
|
||||||
|
|
||||||
-- tests
|
-- tests
|
||||||
|
|||||||
@ -98,11 +98,11 @@ data PeriodicReportRow a b =
|
|||||||
, prrAverage :: b -- The average of this row's values.
|
, prrAverage :: b -- The average of this row's values.
|
||||||
} deriving (Show, Functor, Generic, ToJSON)
|
} 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 _ 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
|
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 as [] = as
|
||||||
sumPadded [] bs = bs
|
sumPadded [] bs = bs
|
||||||
|
|
||||||
|
|||||||
@ -1,4 +1,6 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
A transactions report. Like an EntriesReport, but with more
|
A transactions report. Like an EntriesReport, but with more
|
||||||
@ -21,10 +23,10 @@ module Hledger.Reports.TransactionsReport (
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.List
|
import Data.List (sortBy)
|
||||||
import Data.List.Extra (nubSort)
|
import Data.List.Extra (nubSort)
|
||||||
|
import Data.Ord (comparing)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Ord
|
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Query
|
import Hledger.Query
|
||||||
@ -99,7 +101,7 @@ filterTransactionsReportByCommodity c =
|
|||||||
startbal = filterMixedAmountByCommodity c $ triBalance i
|
startbal = filterMixedAmountByCommodity c $ triBalance i
|
||||||
go _ [] = []
|
go _ [] = []
|
||||||
go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is
|
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
|
-- tests
|
||||||
|
|
||||||
|
|||||||
@ -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.
|
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 Hledger.Utils (---- provide these frequently used modules - or not, for clearer api:
|
||||||
-- module Control.Monad,
|
-- module Control.Monad,
|
||||||
@ -35,25 +37,21 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
|
|||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad (liftM, when)
|
import Control.Monad (liftM, when)
|
||||||
-- import Data.Char
|
|
||||||
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
|
import Data.FileEmbed (makeRelativeToProject, embedStringFile)
|
||||||
import Data.List
|
import Data.List (foldl', foldl1')
|
||||||
-- import Data.Maybe
|
|
||||||
-- import Data.PPrint
|
|
||||||
-- import Data.String.Here (hereFile)
|
-- import Data.String.Here (hereFile)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock (getCurrentTime)
|
||||||
import Data.Time.LocalTime
|
import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone,
|
||||||
-- import Data.Text (Text)
|
utcToLocalTime, utcToZonedTime)
|
||||||
-- import qualified Data.Text as T
|
|
||||||
-- import Language.Haskell.TH.Quote (QuasiQuoter(..))
|
-- import Language.Haskell.TH.Quote (QuasiQuoter(..))
|
||||||
import Language.Haskell.TH.Syntax (Q, Exp)
|
import Language.Haskell.TH.Syntax (Q, Exp)
|
||||||
import System.Directory (getHomeDirectory)
|
import System.Directory (getHomeDirectory)
|
||||||
import System.FilePath((</>), isRelative)
|
import System.FilePath (isRelative, (</>))
|
||||||
import System.IO
|
import System.IO
|
||||||
-- import Text.Printf
|
(Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
|
||||||
-- import qualified Data.Map as Map
|
openFile, stdin, universalNewlineMode, utf8_bom)
|
||||||
|
|
||||||
import Hledger.Utils.Debug
|
import Hledger.Utils.Debug
|
||||||
import Hledger.Utils.Parse
|
import Hledger.Utils.Parse
|
||||||
@ -160,7 +158,7 @@ expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in
|
|||||||
expandPath _ "-" = return "-"
|
expandPath _ "-" = return "-"
|
||||||
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p
|
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p
|
||||||
-- PARTIAL:
|
-- PARTIAL:
|
||||||
|
|
||||||
-- | Expand user home path indicated by tilde prefix
|
-- | Expand user home path indicated by tilde prefix
|
||||||
expandHomePath :: FilePath -> IO FilePath
|
expandHomePath :: FilePath -> IO FilePath
|
||||||
expandHomePath = \case
|
expandHomePath = \case
|
||||||
|
|||||||
@ -360,8 +360,8 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
|
|||||||
c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
|
c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
|
||||||
-- eof
|
-- eof
|
||||||
return (a,c)
|
return (a,c)
|
||||||
balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
|
balancingamt = maNegate . sumPostings $ filter isReal esPostings
|
||||||
balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt
|
balancingamtfirstcommodity = Mixed . take 1 $ amounts balancingamt
|
||||||
showamt =
|
showamt =
|
||||||
showMixedAmount . mixedAmountSetPrecision
|
showMixedAmount . mixedAmountSetPrecision
|
||||||
-- what should this be ?
|
-- what should this be ?
|
||||||
|
|||||||
@ -33,7 +33,7 @@ balancesheetSpec = CompoundBalanceCommandSpec {
|
|||||||
cbcsubreporttitle="Liabilities"
|
cbcsubreporttitle="Liabilities"
|
||||||
,cbcsubreportquery=journalLiabilityAccountQuery
|
,cbcsubreportquery=journalLiabilityAccountQuery
|
||||||
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
,cbcsubreporttransform=fmap negate
|
,cbcsubreporttransform=fmap maNegate
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
@ -45,4 +45,3 @@ balancesheetmode = compoundBalanceCommandMode balancesheetSpec
|
|||||||
|
|
||||||
balancesheet :: CliOpts -> Journal -> IO ()
|
balancesheet :: CliOpts -> Journal -> IO ()
|
||||||
balancesheet = compoundBalanceCommand balancesheetSpec
|
balancesheet = compoundBalanceCommand balancesheetSpec
|
||||||
|
|
||||||
|
|||||||
@ -34,14 +34,14 @@ balancesheetequitySpec = CompoundBalanceCommandSpec {
|
|||||||
cbcsubreporttitle="Liabilities"
|
cbcsubreporttitle="Liabilities"
|
||||||
,cbcsubreportquery=journalLiabilityAccountQuery
|
,cbcsubreportquery=journalLiabilityAccountQuery
|
||||||
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
,cbcsubreporttransform=fmap negate
|
,cbcsubreporttransform=fmap maNegate
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
,CBCSubreportSpec{
|
,CBCSubreportSpec{
|
||||||
cbcsubreporttitle="Equity"
|
cbcsubreporttitle="Equity"
|
||||||
,cbcsubreportquery=journalEquityAccountQuery
|
,cbcsubreportquery=journalEquityAccountQuery
|
||||||
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
,cbcsubreporttransform=fmap negate
|
,cbcsubreporttransform=fmap maNegate
|
||||||
,cbcsubreportincreasestotal=False
|
,cbcsubreportincreasestotal=False
|
||||||
}
|
}
|
||||||
],
|
],
|
||||||
|
|||||||
@ -89,7 +89,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
|||||||
|
|
||||||
-- the balances to close
|
-- the balances to close
|
||||||
(acctbals,_) = balanceReport rspec_ j
|
(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
|
-- since balance assertion amounts are required to be exact, the
|
||||||
-- amounts in opening/closing transactions should be too (#941, #1137)
|
-- 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)]
|
, let commoditysum = (sum bs)]
|
||||||
, (b, mcommoditysum) <- 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
|
-- print them
|
||||||
when closing . T.putStr $ showTransaction closingtxn
|
when closing . T.putStr $ showTransaction closingtxn
|
||||||
|
|||||||
@ -24,7 +24,7 @@ incomestatementSpec = CompoundBalanceCommandSpec {
|
|||||||
cbcsubreporttitle="Revenues"
|
cbcsubreporttitle="Revenues"
|
||||||
,cbcsubreportquery=journalRevenueAccountQuery
|
,cbcsubreportquery=journalRevenueAccountQuery
|
||||||
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative})
|
||||||
,cbcsubreporttransform=fmap negate
|
,cbcsubreporttransform=fmap maNegate
|
||||||
,cbcsubreportincreasestotal=True
|
,cbcsubreportincreasestotal=True
|
||||||
}
|
}
|
||||||
,CBCSubreportSpec{
|
,CBCSubreportSpec{
|
||||||
|
|||||||
@ -34,7 +34,7 @@ registermatch opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j =
|
|||||||
,Nothing
|
,Nothing
|
||||||
,tdescription <$> ptransaction p
|
,tdescription <$> ptransaction p
|
||||||
,p
|
,p
|
||||||
,0)
|
,nullmixedamt)
|
||||||
_ -> putStrLn "please provide one description argument."
|
_ -> putStrLn "please provide one description argument."
|
||||||
|
|
||||||
-- Identify the closest recent match for this description in the given date-sorted postings.
|
-- Identify the closest recent match for this description in the given date-sorted postings.
|
||||||
|
|||||||
@ -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
|
-- Spans are [spanBegin,spanEnd), and spanEnd is 1 day after then actual end date we are interested in
|
||||||
let
|
let
|
||||||
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue spanEnd d amt))
|
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue spanEnd d amt))
|
||||||
|
|
||||||
valueBefore =
|
valueBefore =
|
||||||
mixedAmountValue spanEnd spanBegin $
|
mixedAmountValue spanEnd spanBegin $
|
||||||
total trans (And [ investmentsQuery
|
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
|
priceDates = dbg3 "priceDates" $ nub $ filter (spanContainsDate span) priceDirectiveDates
|
||||||
cashFlow =
|
cashFlow =
|
||||||
((map (\d -> (d,0)) priceDates)++) $
|
((map (\d -> (d,nullmixedamt)) priceDates)++) $
|
||||||
cashFlowApplyCostValue $
|
cashFlowApplyCostValue $
|
||||||
calculateCashFlow trans (And [ Not investmentsQuery
|
calculateCashFlow trans (And [ Not investmentsQuery
|
||||||
, Not pnlQuery
|
, Not pnlQuery
|
||||||
@ -133,14 +133,14 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
|
|||||||
|
|
||||||
irr <- internalRateOfReturn showCashFlow prettyTables thisSpan
|
irr <- internalRateOfReturn showCashFlow prettyTables thisSpan
|
||||||
twr <- timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue 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
|
let smallIsZero x = if abs x < 0.01 then 0.0 else x
|
||||||
return [ showDate spanBegin
|
return [ showDate spanBegin
|
||||||
, showDate (addDays (-1) spanEnd)
|
, showDate (addDays (-1) spanEnd)
|
||||||
, T.pack $ showMixedAmount valueBefore
|
, T.pack $ showMixedAmount valueBefore
|
||||||
, T.pack $ showMixedAmount cashFlowAmt
|
, T.pack $ showMixedAmount cashFlowAmt
|
||||||
, T.pack $ showMixedAmount valueAfter
|
, 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 irr
|
||||||
, T.pack $ printf "%0.2f%%" $ smallIsZero twr ]
|
, 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
|
-- first for processing cash flow. This is why pnl changes are Left
|
||||||
-- and cashflows are Right
|
-- and cashflows are Right
|
||||||
sort
|
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
|
-- 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)
|
$ groupBy ((==) `on` fst)
|
||||||
$ sortOn fst
|
$ sortOn fst
|
||||||
$ map (\(d,a) -> (d, negate a))
|
$ map (\(d,a) -> (d, maNegate a))
|
||||||
$ cashFlow
|
$ cashFlow
|
||||||
|
|
||||||
let units =
|
let units =
|
||||||
@ -203,17 +203,15 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
|
|||||||
when showCashFlow $ do
|
when showCashFlow $ do
|
||||||
printf "\nTWR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
|
printf "\nTWR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
|
||||||
let (dates', amounts) = unzip changes
|
let (dates', amounts) = unzip changes
|
||||||
cashflows' = map (either (\_ -> 0) id) amounts
|
cashflows' = map (either (const nullmixedamt) id) amounts
|
||||||
pnls' = map (either id (\_ -> 0)) amounts
|
pnls = map (either id (const nullmixedamt)) amounts
|
||||||
(valuesOnDate',unitsBoughtOrSold', unitPrices', unitBalances') = unzip4 units
|
(valuesOnDate,unitsBoughtOrSold', unitPrices', unitBalances') = unzip4 units
|
||||||
add x lst = if valueBefore/=0 then x:lst else lst
|
add x lst = if valueBefore/=0 then x:lst else lst
|
||||||
dates = add spanBegin dates'
|
dates = add spanBegin dates'
|
||||||
cashflows = add valueBeforeAmt cashflows'
|
cashflows = add valueBeforeAmt cashflows'
|
||||||
pnls = add 0 pnls'
|
|
||||||
unitsBoughtOrSold = add initialUnits unitsBoughtOrSold'
|
unitsBoughtOrSold = add initialUnits unitsBoughtOrSold'
|
||||||
unitPrices = add initialUnitPrice unitPrices'
|
unitPrices = add initialUnitPrice unitPrices'
|
||||||
unitBalances = add initialUnits unitBalances'
|
unitBalances = add initialUnits unitBalances'
|
||||||
valuesOnDate = add 0 valuesOnDate'
|
|
||||||
|
|
||||||
TL.putStr $ Ascii.render prettyTables id id T.pack
|
TL.putStr $ Ascii.render prettyTables id id T.pack
|
||||||
(Table
|
(Table
|
||||||
@ -236,11 +234,11 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
|
|||||||
return annualizedTWR
|
return annualizedTWR
|
||||||
|
|
||||||
internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow _pnl) = do
|
internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueBefore valueAfter cashFlow _pnl) = do
|
||||||
let prefix = (spanBegin, negate valueBefore)
|
let prefix = (spanBegin, maNegate valueBefore)
|
||||||
|
|
||||||
postfix = (spanEnd, valueAfter)
|
postfix = (spanEnd, valueAfter)
|
||||||
|
|
||||||
totalCF = filter ((/=0) . snd) $ prefix : (sortOn fst cashFlow) ++ [postfix]
|
totalCF = filter (maIsNonZero . snd) $ prefix : (sortOn fst cashFlow) ++ [postfix]
|
||||||
|
|
||||||
when showCashFlow $ do
|
when showCashFlow $ do
|
||||||
printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
|
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 :: Day -> CashFlow -> Double -> Double
|
||||||
interestSum referenceDay cf rate = sum $ map go cf
|
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 :: [Transaction] -> Query -> CashFlow
|
||||||
calculateCashFlow trans query = filter ((/=0).snd) $ map go trans
|
calculateCashFlow trans query = filter (maIsNonZero . snd) $ map go trans
|
||||||
where
|
where go t = (transactionDate2 t, total [t] query)
|
||||||
go t = (transactionDate2 t, total [t] query)
|
|
||||||
|
|
||||||
total :: [Transaction] -> Query -> MixedAmount
|
total :: [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 :: MixedAmount -> Quantity
|
||||||
unMix a =
|
unMix a =
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user