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:
Stephen Morgan
parent
4b2c943867
commit
dabb3ef82e
@ -218,7 +218,7 @@ checkAssertion accounts = checkAssertion'
|
||||
evaluate (Account account) =
|
||||
fromMaybe H.nullmixedamt $ lookup account accounts
|
||||
evaluate (AccountNested account) =
|
||||
sum [m | (a,m) <- accounts, account == a || (a <> pack ":") `isPrefixOf` account]
|
||||
maSum [m | (a,m) <- accounts, account == a || (a <> pack ":") `isPrefixOf` account]
|
||||
evaluate (Amount amount) = H.mixed [amount]
|
||||
|
||||
-- Add missing amounts (with 0 value), normalise, throw away style
|
||||
@ -279,7 +279,7 @@ closingBalances' postings =
|
||||
|
||||
-- | Add balances in matching accounts.
|
||||
addAccounts :: [(H.AccountName, H.MixedAmount)] -> [(H.AccountName, H.MixedAmount)] -> [(H.AccountName, H.MixedAmount)]
|
||||
addAccounts as1 as2 = [ (a, a1 + a2)
|
||||
addAccounts as1 as2 = [ (a, a1 `maPlus` a2)
|
||||
| a <- nub (map fst as1 ++ map fst as2)
|
||||
, let a1 = fromMaybe H.nullmixedamt $ lookup a as1
|
||||
, let a2 = fromMaybe H.nullmixedamt $ lookup a as2
|
||||
|
||||
@ -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]
|
||||
}
|
||||
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -94,6 +94,9 @@ module Hledger.Data.Amount (
|
||||
nullmixedamt,
|
||||
missingmixedamt,
|
||||
mixed,
|
||||
mixedAmount,
|
||||
maAddAmount,
|
||||
maAddAmounts,
|
||||
amounts,
|
||||
filterMixedAmount,
|
||||
filterMixedAmountByCommodity,
|
||||
@ -104,12 +107,18 @@ module Hledger.Data.Amount (
|
||||
mixedAmountStripPrices,
|
||||
-- ** arithmetic
|
||||
mixedAmountCost,
|
||||
maNegate,
|
||||
maPlus,
|
||||
maMinus,
|
||||
maSum,
|
||||
divideMixedAmount,
|
||||
multiplyMixedAmount,
|
||||
averageMixedAmounts,
|
||||
isNegativeAmount,
|
||||
isNegativeMixedAmount,
|
||||
mixedAmountIsZero,
|
||||
maIsZero,
|
||||
maIsNonZero,
|
||||
mixedAmountLooksZero,
|
||||
mixedAmountTotalPriceToUnitPrice,
|
||||
-- ** rendering
|
||||
@ -138,12 +147,12 @@ import Control.Monad (foldM)
|
||||
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
|
||||
import Data.Default (Default(..))
|
||||
import Data.Foldable (toList)
|
||||
import Data.List (intercalate, intersperse, mapAccumL, partition)
|
||||
import Data.List (foldl', intercalate, intersperse, mapAccumL, partition)
|
||||
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
@ -494,13 +503,26 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
|
||||
-------------------------------------------------------------------------------
|
||||
-- MixedAmount
|
||||
|
||||
instance Semigroup MixedAmount where
|
||||
(<>) = maPlus
|
||||
|
||||
instance Monoid MixedAmount where
|
||||
mempty = nullmixedamt
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
|
||||
instance Num MixedAmount where
|
||||
fromInteger i = Mixed [fromInteger i]
|
||||
negate (Mixed as) = Mixed $ map negate as
|
||||
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
|
||||
(*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
|
||||
abs = error' "error, mixed amounts do not support abs"
|
||||
signum = error' "error, mixed amounts do not support signum"
|
||||
fromInteger i = Mixed [fromInteger i]
|
||||
negate = maNegate
|
||||
(+) = maPlus
|
||||
(*) = error' "error, mixed amounts do not support multiplication" -- PARTIAL:
|
||||
abs = error' "error, mixed amounts do not support abs"
|
||||
signum = error' "error, mixed amounts do not support signum"
|
||||
|
||||
-- | Get a mixed amount's component amounts.
|
||||
amounts :: MixedAmount -> [Amount]
|
||||
amounts (Mixed as) = as
|
||||
|
||||
-- | The empty mixed amount.
|
||||
nullmixedamt :: MixedAmount
|
||||
@ -514,6 +536,85 @@ missingmixedamt = Mixed [missingamt]
|
||||
mixed :: [Amount] -> MixedAmount
|
||||
mixed = normaliseMixedAmount . Mixed
|
||||
|
||||
-- | Create a MixedAmount from a single Amount.
|
||||
mixedAmount :: Amount -> MixedAmount
|
||||
mixedAmount = Mixed . pure
|
||||
|
||||
-- | Add an Amount to a MixedAmount, normalising the result.
|
||||
maAddAmount :: MixedAmount -> Amount -> MixedAmount
|
||||
maAddAmount (Mixed as) a = normaliseMixedAmount . Mixed $ a : as
|
||||
|
||||
-- | Add a collection of Amounts to a MixedAmount, normalising the result.
|
||||
maAddAmounts :: MixedAmount -> [Amount] -> MixedAmount
|
||||
maAddAmounts (Mixed as) bs = bs `seq` normaliseMixedAmount . Mixed $ bs ++ as
|
||||
|
||||
-- | Negate mixed amount's quantities (and total prices, if any).
|
||||
maNegate :: MixedAmount -> MixedAmount
|
||||
maNegate = transformMixedAmount negate
|
||||
|
||||
-- | Sum two MixedAmount.
|
||||
maPlus :: MixedAmount -> MixedAmount -> MixedAmount
|
||||
maPlus (Mixed as) (Mixed bs) = normaliseMixedAmount . Mixed $ as ++ bs
|
||||
|
||||
-- | Subtract a MixedAmount from another.
|
||||
maMinus :: MixedAmount -> MixedAmount -> MixedAmount
|
||||
maMinus a = maPlus a . maNegate
|
||||
|
||||
-- | Sum a collection of MixedAmounts.
|
||||
maSum :: Foldable t => t MixedAmount -> MixedAmount
|
||||
maSum = foldl' maPlus nullmixedamt
|
||||
|
||||
-- | Divide a mixed amount's quantities (and total prices, if any) by a constant.
|
||||
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
|
||||
divideMixedAmount n = transformMixedAmount (/n)
|
||||
|
||||
-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.
|
||||
multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
|
||||
multiplyMixedAmount n = transformMixedAmount (*n)
|
||||
|
||||
-- | Apply a function to a mixed amount's quantities (and its total prices, if it has any).
|
||||
transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount
|
||||
transformMixedAmount f = mapMixedAmount (transformAmount f)
|
||||
|
||||
-- | Calculate the average of some mixed amounts.
|
||||
averageMixedAmounts :: [MixedAmount] -> MixedAmount
|
||||
averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` maSum as
|
||||
|
||||
-- | Is this mixed amount negative, if we can tell that unambiguously?
|
||||
-- Ie when normalised, are all individual commodity amounts negative ?
|
||||
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
|
||||
isNegativeMixedAmount m =
|
||||
case amounts $ normaliseMixedAmountSquashPricesForDisplay m of
|
||||
[] -> Just False
|
||||
[a] -> Just $ isNegativeAmount a
|
||||
as | all isNegativeAmount as -> Just True
|
||||
as | not (any isNegativeAmount as) -> Just False
|
||||
_ -> Nothing -- multiple amounts with different signs
|
||||
|
||||
-- | Does this mixed amount appear to be zero when rendered with its display precision?
|
||||
-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
|
||||
-- and zero quantity for each unit price?
|
||||
mixedAmountLooksZero :: MixedAmount -> Bool
|
||||
mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmount
|
||||
|
||||
-- | Is this mixed amount exactly zero, ignoring its display precision?
|
||||
-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
|
||||
-- and zero quantity for each unit price?
|
||||
mixedAmountIsZero :: MixedAmount -> Bool
|
||||
mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmount
|
||||
|
||||
-- | Is this mixed amount exactly zero, ignoring its display precision?
|
||||
--
|
||||
-- A convenient alias for mixedAmountIsZero.
|
||||
maIsZero :: MixedAmount -> Bool
|
||||
maIsZero = mixedAmountIsZero
|
||||
|
||||
-- | Is this mixed amount non-zero, ignoring its display precision?
|
||||
--
|
||||
-- A convenient alias for not . mixedAmountIsZero.
|
||||
maIsNonZero :: MixedAmount -> Bool
|
||||
maIsNonZero = not . mixedAmountIsZero
|
||||
|
||||
-- | Simplify a mixed amount's component amounts:
|
||||
--
|
||||
-- * amounts in the same commodity are combined unless they have different prices or total prices
|
||||
@ -581,10 +682,6 @@ sumSimilarAmountsUsingFirstPrice a b = (a + b){aprice=p}
|
||||
-- sumSimilarAmountsNotingPriceDifference [] = nullamt
|
||||
-- sumSimilarAmountsNotingPriceDifference as = undefined
|
||||
|
||||
-- | Get a mixed amount's component amounts.
|
||||
amounts :: MixedAmount -> [Amount]
|
||||
amounts (Mixed as) = as
|
||||
|
||||
-- | Filter a mixed amount's component amounts by a predicate.
|
||||
filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
|
||||
filterMixedAmount p (Mixed as) = Mixed $ filter p as
|
||||
@ -609,42 +706,6 @@ mapMixedAmount f (Mixed as) = Mixed $ map f as
|
||||
mixedAmountCost :: MixedAmount -> MixedAmount
|
||||
mixedAmountCost = mapMixedAmount amountCost
|
||||
|
||||
-- | Divide a mixed amount's quantities (and total prices, if any) by a constant.
|
||||
divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
|
||||
divideMixedAmount n = mapMixedAmount (divideAmount n)
|
||||
|
||||
-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.
|
||||
multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount
|
||||
multiplyMixedAmount n = mapMixedAmount (multiplyAmount n)
|
||||
|
||||
-- | Calculate the average of some mixed amounts.
|
||||
averageMixedAmounts :: [MixedAmount] -> MixedAmount
|
||||
averageMixedAmounts [] = 0
|
||||
averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as
|
||||
|
||||
-- | Is this mixed amount negative, if we can tell that unambiguously?
|
||||
-- Ie when normalised, are all individual commodity amounts negative ?
|
||||
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
|
||||
isNegativeMixedAmount m =
|
||||
case amounts $ normaliseMixedAmountSquashPricesForDisplay m of
|
||||
[] -> Just False
|
||||
[a] -> Just $ isNegativeAmount a
|
||||
as | all isNegativeAmount as -> Just True
|
||||
as | not (any isNegativeAmount as) -> Just False
|
||||
_ -> Nothing -- multiple amounts with different signs
|
||||
|
||||
-- | Does this mixed amount appear to be zero when rendered with its display precision?
|
||||
-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
|
||||
-- and zero quantity for each unit price?
|
||||
mixedAmountLooksZero :: MixedAmount -> Bool
|
||||
mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmountSquashPricesForDisplay
|
||||
|
||||
-- | Is this mixed amount exactly to be zero, ignoring its display precision?
|
||||
-- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),
|
||||
-- and zero quantity for each unit price?
|
||||
mixedAmountIsZero :: MixedAmount -> Bool
|
||||
mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPricesForDisplay
|
||||
|
||||
-- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we
|
||||
-- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there.
|
||||
-- -- For now, use this when cross-commodity zero equality is important.
|
||||
@ -888,18 +949,18 @@ tests_Amount = tests "Amount" [
|
||||
,tests "MixedAmount" [
|
||||
|
||||
test "adding mixed amounts to zero, the commodity and amount style are preserved" $
|
||||
sum (map (Mixed . (:[]))
|
||||
[usd 1.25
|
||||
,usd (-1) `withPrecision` Precision 3
|
||||
,usd (-0.25)
|
||||
])
|
||||
maSum (map mixedAmount
|
||||
[usd 1.25
|
||||
,usd (-1) `withPrecision` Precision 3
|
||||
,usd (-0.25)
|
||||
])
|
||||
@?= Mixed [usd 0 `withPrecision` Precision 3]
|
||||
|
||||
,test "adding mixed amounts with total prices" $ do
|
||||
sum (map (Mixed . (:[]))
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
maSum (map mixedAmount
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
@?= Mixed [usd (-1) @@ eur 2 ]
|
||||
|
||||
,test "showMixedAmount" $ do
|
||||
|
||||
@ -765,14 +765,14 @@ withRunningBalance f = ask >>= lift . lift . f
|
||||
-- | Get this account's current exclusive running balance.
|
||||
getRunningBalanceB :: AccountName -> Balancing s MixedAmount
|
||||
getRunningBalanceB acc = withRunningBalance $ \BalancingState{bsBalances} -> do
|
||||
fromMaybe 0 <$> H.lookup bsBalances acc
|
||||
fromMaybe nullmixedamt <$> H.lookup bsBalances acc
|
||||
|
||||
-- | Add this amount to this account's exclusive running balance.
|
||||
-- Returns the new running balance.
|
||||
addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
||||
addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
|
||||
old <- fromMaybe 0 <$> H.lookup bsBalances acc
|
||||
let new = old + amt
|
||||
old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
|
||||
let new = maPlus old amt
|
||||
H.insert bsBalances acc new
|
||||
return new
|
||||
|
||||
@ -780,9 +780,9 @@ addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances}
|
||||
-- Returns the change in exclusive running balance.
|
||||
setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
||||
setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
|
||||
old <- fromMaybe 0 <$> H.lookup bsBalances acc
|
||||
old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
|
||||
H.insert bsBalances acc amt
|
||||
return $ amt - old
|
||||
return $ maMinus amt old
|
||||
|
||||
-- | Set this account's exclusive running balance to whatever amount
|
||||
-- makes its *inclusive* running balance (the sum of exclusive running
|
||||
@ -790,13 +790,13 @@ setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} ->
|
||||
-- Returns the change in exclusive running balance.
|
||||
setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
|
||||
setInclusiveRunningBalanceB acc newibal = withRunningBalance $ \BalancingState{bsBalances} -> do
|
||||
oldebal <- fromMaybe 0 <$> H.lookup bsBalances acc
|
||||
oldebal <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc
|
||||
allebals <- H.toList bsBalances
|
||||
let subsibal = -- sum of any subaccounts' running balances
|
||||
sum $ map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals
|
||||
let newebal = newibal - subsibal
|
||||
maSum . map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals
|
||||
let newebal = maMinus newibal subsibal
|
||||
H.insert bsBalances acc newebal
|
||||
return $ newebal - oldebal
|
||||
return $ maMinus newebal oldebal
|
||||
|
||||
-- | Update (overwrite) this transaction in the balancing state.
|
||||
updateTransactionB :: Transaction -> Balancing s ()
|
||||
@ -909,7 +909,7 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
|
||||
False -> do
|
||||
oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
|
||||
let assignedbalthiscommodity = Mixed [baamount]
|
||||
newbal = oldbalothercommodities + assignedbalthiscommodity
|
||||
newbal = maPlus oldbalothercommodities assignedbalthiscommodity
|
||||
diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
|
||||
return (diff,newbal)
|
||||
let p' = p{pamount=diff, poriginal=Just $ originalPosting p}
|
||||
@ -961,9 +961,9 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
|
||||
-- sum the running balances of this account and any of its subaccounts seen so far
|
||||
withRunningBalance $ \BalancingState{bsBalances} ->
|
||||
H.foldM
|
||||
(\ibal (acc, amt) -> return $ ibal +
|
||||
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)
|
||||
0
|
||||
(\ibal (acc, amt) -> return $
|
||||
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then maPlus ibal amt else ibal)
|
||||
nullmixedamt
|
||||
bsBalances
|
||||
else return actualbal
|
||||
let
|
||||
|
||||
@ -75,15 +75,16 @@ import Control.Monad (foldM)
|
||||
import Data.Foldable (asum)
|
||||
import Data.List.Extra (nubSort)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.MemoUgly (memo)
|
||||
import Data.List (foldl')
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Monoid
|
||||
#endif
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
import Safe
|
||||
import Data.Time.Calendar (Day)
|
||||
import Safe (headDef)
|
||||
|
||||
import Hledger.Utils
|
||||
import Hledger.Data.Types
|
||||
@ -197,7 +198,7 @@ accountNamesFromPostings :: [Posting] -> [AccountName]
|
||||
accountNamesFromPostings = nubSort . map paccount
|
||||
|
||||
sumPostings :: [Posting] -> MixedAmount
|
||||
sumPostings = sumStrict . map pamount
|
||||
sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt
|
||||
|
||||
-- | Remove all prices of a posting
|
||||
removePrices :: Posting -> Posting
|
||||
|
||||
@ -471,9 +471,9 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
|
||||
in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts)
|
||||
where
|
||||
(amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)
|
||||
realsum = sumStrict $ map pamount amountfulrealps
|
||||
realsum = sumPostings amountfulrealps
|
||||
(amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)
|
||||
bvsum = sumStrict $ map pamount amountfulbvps
|
||||
bvsum = sumPostings amountfulbvps
|
||||
|
||||
inferamount :: Posting -> (Posting, Maybe MixedAmount)
|
||||
inferamount p =
|
||||
@ -490,7 +490,7 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
|
||||
-- Inferred amounts are converted to cost.
|
||||
-- Also ensure the new amount has the standard style for its commodity
|
||||
-- (since the main amount styling pass happened before this balancing pass);
|
||||
a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a)
|
||||
a' = styleMixedAmount styles . normaliseMixedAmount . mixedAmountCost $ maNegate a
|
||||
|
||||
-- | Infer prices for this transaction's posting amounts, if needed to make
|
||||
-- the postings balance, and if possible. This is done once for the real
|
||||
@ -542,10 +542,9 @@ priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
|
||||
priceInferrerFor t pt = inferprice
|
||||
where
|
||||
postings = filter ((==pt).ptype) $ tpostings t
|
||||
pmixedamounts = map pamount postings
|
||||
pamounts = concatMap amounts pmixedamounts
|
||||
pamounts = concatMap (amounts . pamount) postings
|
||||
pcommodities = map acommodity pamounts
|
||||
sumamounts = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price
|
||||
sumamounts = amounts $ sumPostings postings -- sum normalises to one amount per commodity & price
|
||||
sumcommodities = map acommodity sumamounts
|
||||
sumprices = filter (/=Nothing) $ map aprice sumamounts
|
||||
caninferprices = length sumcommodities == 2 && null sumprices
|
||||
|
||||
@ -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,"
|
||||
|
||||
@ -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 ?
|
||||
|
||||
@ -112,7 +112,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
tests "balanceReport" [
|
||||
|
||||
test "no args, null journal" $
|
||||
(defreportspec, nulljournal) `gives` ([], 0)
|
||||
(defreportspec, nulljournal) `gives` ([], nullmixedamt)
|
||||
|
||||
,test "no args, sample journal" $
|
||||
(defreportspec, samplejournal) `gives`
|
||||
@ -162,7 +162,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
|
||||
,test "with date:" $
|
||||
(defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([], 0)
|
||||
([], nullmixedamt)
|
||||
|
||||
,test "with date2:" $
|
||||
(defreportspec{rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
@ -202,7 +202,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
|
||||
,test "with period on an unpopulated period" $
|
||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
|
||||
([], 0)
|
||||
([], nullmixedamt)
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -174,7 +174,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
||||
(r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
|
||||
where
|
||||
subreportTotal (_, sr, increasestotal) =
|
||||
(if increasestotal then id else fmap negate) $ prTotals sr
|
||||
(if increasestotal then id else fmap maNegate) $ prTotals sr
|
||||
|
||||
cbr = CompoundPeriodicReport "" (M.keys colps) subreports overalltotals
|
||||
|
||||
@ -338,7 +338,7 @@ generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j priceoracle colps st
|
||||
displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix
|
||||
|
||||
-- All the rows of the report.
|
||||
rows = dbg5 "rows" . (if invert_ ropts then map (fmap negate) else id) -- Negate amounts if applicable
|
||||
rows = dbg5 "rows" . (if invert_ ropts then map (fmap maNegate) else id) -- Negate amounts if applicable
|
||||
$ buildReportRows ropts displaynames matrix
|
||||
|
||||
-- Calculate column totals
|
||||
@ -357,7 +357,7 @@ buildReportRows :: ReportOpts
|
||||
-> HashMap AccountName DisplayName
|
||||
-> HashMap AccountName (Map DateSpan Account)
|
||||
-> [MultiBalanceReportRow]
|
||||
buildReportRows ropts displaynames =
|
||||
buildReportRows ropts displaynames =
|
||||
toList . HM.mapMaybeWithKey mkRow -- toList of HashMap's Foldable instance - does not sort consistently
|
||||
where
|
||||
mkRow name accts = do
|
||||
@ -369,8 +369,8 @@ buildReportRows ropts displaynames =
|
||||
-- These are always simply the sum/average of the displayed row amounts.
|
||||
-- Total for a cumulative/historical report is always the last column.
|
||||
rowtot = case balancetype_ ropts of
|
||||
PeriodChange -> sum rowbals
|
||||
_ -> lastDef 0 rowbals
|
||||
PeriodChange -> maSum rowbals
|
||||
_ -> lastDef nullmixedamt rowbals
|
||||
rowavg = averageMixedAmounts rowbals
|
||||
balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance
|
||||
|
||||
@ -439,7 +439,7 @@ sortRows ropts j
|
||||
-- Set the inclusive balance of an account from the rows, or sum the
|
||||
-- subaccounts if it's not present
|
||||
accounttreewithbals = mapAccounts setibalance accounttree
|
||||
setibalance a = a{aibalance = maybe (sum . map aibalance $ asubs a) prrTotal $
|
||||
setibalance a = a{aibalance = maybe (maSum . map aibalance $ asubs a) prrTotal $
|
||||
HM.lookup (aname a) rowMap}
|
||||
sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
|
||||
sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
|
||||
@ -470,14 +470,14 @@ calculateTotalsRow ropts rows =
|
||||
|
||||
colamts = transpose . map prrAmounts $ filter isTopRow rows
|
||||
|
||||
coltotals :: [MixedAmount] = dbg5 "coltotals" $ map sum colamts
|
||||
coltotals :: [MixedAmount] = dbg5 "coltotals" $ map maSum colamts
|
||||
|
||||
-- Calculate the grand total and average. These are always the sum/average
|
||||
-- of the column totals.
|
||||
-- Total for a cumulative/historical report is always the last column.
|
||||
grandtotal = case balancetype_ ropts of
|
||||
PeriodChange -> sum coltotals
|
||||
_ -> lastDef 0 coltotals
|
||||
PeriodChange -> maSum coltotals
|
||||
_ -> lastDef nullmixedamt coltotals
|
||||
grandaverage = averageMixedAmounts coltotals
|
||||
|
||||
-- | Map the report rows to percentages if needed
|
||||
@ -535,12 +535,12 @@ perdivide a b = fromMaybe (error' errmsg) $ do -- PARTIAL:
|
||||
-- in scanl, so other properties (such as anumpostings) stay in the right place
|
||||
sumAcct :: Account -> Account -> Account
|
||||
sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
|
||||
a{aibalance = i1 + i2, aebalance = e1 + e2}
|
||||
a{aibalance = i1 `maPlus` i2, aebalance = e1 `maPlus` e2}
|
||||
|
||||
-- Subtract the values in one account from another. Should be left-biased.
|
||||
subtractAcct :: Account -> Account -> Account
|
||||
subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =
|
||||
a{aibalance = i1 - i2, aebalance = e1 - e2}
|
||||
a{aibalance = i1 `maMinus` i2, aebalance = e1 `maMinus` e2}
|
||||
|
||||
-- | Extract period changes from a cumulative list
|
||||
periodChanges :: Account -> Map k Account -> Map k Account
|
||||
@ -586,7 +586,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
in
|
||||
tests "multiBalanceReport" [
|
||||
test "null journal" $
|
||||
(defreportspec, nulljournal) `gives` ([], Mixed [nullamt])
|
||||
(defreportspec, nulljournal) `gives` ([], nullmixedamt)
|
||||
|
||||
,test "with -H on a populated period" $
|
||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ?
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
}
|
||||
],
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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{
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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 =
|
||||
|
||||
Loading…
Reference in New Issue
Block a user