mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-07 21:15:19 +03:00
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to keep API clean (if you really need it, you can import it directly from Hledger.Data.Types). We also ensure the JSON representation of MixedAmount doesn't change: it is stored as a normalised list of Amounts. This commit improves performance. Here are some indicative results. hledger reg -f examples/10000x1000x10.journal - Maximum residency decreases from 65MB to 60MB (8% decrease) - Total memory in use decreases from 178MiB to 157MiB (12% decrease) hledger reg -f examples/10000x10000x10.journal - Maximum residency decreases from 69MB to 60MB (13% decrease) - Total memory in use decreases from 198MiB to 153MiB (23% decrease) hledger bal -f examples/10000x1000x10.journal - Total heap usage decreases from 6.4GB to 6.0GB (6% decrease) - Total memory in use decreases from 178MiB to 153MiB (14% decrease) hledger bal -f examples/10000x10000x10.journal - Total heap usage decreases from 7.3GB to 6.9GB (5% decrease) - Total memory in use decreases from 196MiB to 185MiB (5% decrease) hledger bal -M -f examples/10000x1000x10.journal - Total heap usage decreases from 16.8GB to 10.6GB (47% decrease) - Total time decreases from 14.3s to 12.0s (16% decrease) hledger bal -M -f examples/10000x10000x10.journal - Total heap usage decreases from 108GB to 48GB (56% decrease) - Total time decreases from 62s to 41s (33% decrease) If you never directly use the constructor Mixed or pattern match against it then you don't need to make any changes. If you do, then do the following: - If you really care about the individual Amounts and never normalise your MixedAmount (for example, just storing `Mixed amts` and then extracting `amts` as a pattern match, then use should switch to using [Amount]. This should just involve removing the `Mixed` constructor. - If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of amount arithmetic (+), (-), then you should replace the constructor `Mixed` with the function `mixed`. To extract the list of Amounts, use the function `amounts`. - If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can replace that with `mixedAmountStripPrices`. (N.B. this does something slightly different from `normaliseMixedAmountSquashPricesForDisplay`, but I don't think there's any use case for squashing prices and then keeping the first of the squashed prices around. If you disagree let me know.) - Any remaining calls to `normaliseMixedAmount` can be removed, as that is now the identity function.
This commit is contained in:
Stephen Morgan
Simon Michael
parent
4013a81af8
commit
5e7b69356f
@ -110,11 +110,11 @@ splitPosting acct dates p@Posting{paccount,pamount}
|
||||
[d] -> (d, [])
|
||||
[] -> error' "splitPosting ran out of dates, should not happen (maybe sort your transactions by date)"
|
||||
days = initSafe [start..end]
|
||||
amt = (genericLength days) `divideMixedAmount` pamount
|
||||
amt = (fromIntegral $ length days) `divideMixedAmount` pamount
|
||||
-- give one of the postings an exact balancing amount to ensure the transaction is balanced
|
||||
-- lastamt = pamount - ptrace (amt `multiplyMixedAmount` (fromIntegral $ length days))
|
||||
lastamt = missingmixedamt
|
||||
daysamts = zip days (take (length days - 1) (repeat amt) ++ [lastamt])
|
||||
daysamts = zip days (replicate (length days - 1) amt ++ [lastamt])
|
||||
ps' = [postingSetDate (Just d) p{pamount=a} | (d,a) <- daysamts ]
|
||||
|
||||
-- | Set a posting's (primary) date, as if it had been parsed from the journal entry:
|
||||
|
||||
@ -47,7 +47,7 @@ import Hledger.Data.StringFormat
|
||||
import Hledger.Data.Timeclock
|
||||
import Hledger.Data.Transaction
|
||||
import Hledger.Data.TransactionModifier
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.Types hiding (MixedAmountKey, Mixed)
|
||||
import Hledger.Data.Valuation
|
||||
import Hledger.Utils.Test
|
||||
|
||||
|
||||
@ -101,6 +101,7 @@ module Hledger.Data.Amount (
|
||||
maAddAmount,
|
||||
maAddAmounts,
|
||||
amounts,
|
||||
amountsRaw,
|
||||
filterMixedAmount,
|
||||
filterMixedAmountByCommodity,
|
||||
mapMixedAmount,
|
||||
@ -152,10 +153,8 @@ import Data.Foldable (toList)
|
||||
import Data.List (find, 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.Maybe (fromMaybe, isNothing)
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import Data.Word (Word8)
|
||||
@ -589,48 +588,54 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
|
||||
|
||||
instance Semigroup MixedAmount where
|
||||
(<>) = maPlus
|
||||
sconcat = maSum
|
||||
stimes n = multiplyMixedAmount (fromIntegral n)
|
||||
|
||||
instance Monoid MixedAmount where
|
||||
mempty = nullmixedamt
|
||||
mconcat = maSum
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
|
||||
instance Num MixedAmount where
|
||||
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"
|
||||
fromInteger = mixedAmount . fromInteger
|
||||
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
|
||||
-- | Calculate the key used to store an Amount within a MixedAmount.
|
||||
amountKey :: Amount -> MixedAmountKey
|
||||
amountKey amt@Amount{acommodity=c} = case aprice amt of
|
||||
Nothing -> MixedAmountKeyNoPrice c
|
||||
Just (TotalPrice p) -> MixedAmountKeyTotalPrice c (acommodity p)
|
||||
Just (UnitPrice p) -> MixedAmountKeyUnitPrice c (acommodity p) (aquantity p)
|
||||
|
||||
-- | The empty mixed amount.
|
||||
nullmixedamt :: MixedAmount
|
||||
nullmixedamt = Mixed []
|
||||
nullmixedamt = Mixed mempty
|
||||
|
||||
-- | A temporary value for parsed transactions which had no amount specified.
|
||||
missingmixedamt :: MixedAmount
|
||||
missingmixedamt = mixedAmount missingamt
|
||||
|
||||
-- | Convert amounts in various commodities into a normalised MixedAmount.
|
||||
mixed :: [Amount] -> MixedAmount
|
||||
mixed = normaliseMixedAmount . Mixed
|
||||
-- | Convert amounts in various commodities into a mixed amount.
|
||||
mixed :: Foldable t => t Amount -> MixedAmount
|
||||
mixed = maAddAmounts nullmixedamt
|
||||
|
||||
-- | Create a MixedAmount from a single Amount.
|
||||
mixedAmount :: Amount -> MixedAmount
|
||||
mixedAmount = Mixed . pure
|
||||
mixedAmount a = Mixed $ M.singleton (amountKey a) a
|
||||
|
||||
-- | Add an Amount to a MixedAmount, normalising the result.
|
||||
maAddAmount :: MixedAmount -> Amount -> MixedAmount
|
||||
maAddAmount (Mixed as) a = normaliseMixedAmount . Mixed $ a : as
|
||||
maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstPrice (amountKey a) a ma
|
||||
|
||||
-- | 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
|
||||
maAddAmounts :: Foldable t => MixedAmount -> t Amount -> MixedAmount
|
||||
maAddAmounts = foldl' maAddAmount
|
||||
|
||||
-- | Negate mixed amount's quantities (and total prices, if any).
|
||||
maNegate :: MixedAmount -> MixedAmount
|
||||
@ -638,7 +643,7 @@ maNegate = transformMixedAmount negate
|
||||
|
||||
-- | Sum two MixedAmount.
|
||||
maPlus :: MixedAmount -> MixedAmount -> MixedAmount
|
||||
maPlus (Mixed as) (Mixed bs) = normaliseMixedAmount . Mixed $ as ++ bs
|
||||
maPlus (Mixed as) (Mixed bs) = Mixed $ M.unionWith sumSimilarAmountsUsingFirstPrice as bs
|
||||
|
||||
-- | Subtract a MixedAmount from another.
|
||||
maMinus :: MixedAmount -> MixedAmount -> MixedAmount
|
||||
@ -658,7 +663,7 @@ 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)
|
||||
transformMixedAmount f = mapMixedAmountUnsafe (transformAmount f)
|
||||
|
||||
-- | Calculate the average of some mixed amounts.
|
||||
averageMixedAmounts :: [MixedAmount] -> MixedAmount
|
||||
@ -699,7 +704,7 @@ maIsZero = mixedAmountIsZero
|
||||
maIsNonZero :: MixedAmount -> Bool
|
||||
maIsNonZero = not . mixedAmountIsZero
|
||||
|
||||
-- | Simplify a mixed amount's component amounts:
|
||||
-- | Get a mixed amount's component amounts.
|
||||
--
|
||||
-- * amounts in the same commodity are combined unless they have different prices or total prices
|
||||
--
|
||||
@ -711,34 +716,35 @@ maIsNonZero = not . mixedAmountIsZero
|
||||
--
|
||||
-- * the special "missing" mixed amount remains unchanged
|
||||
--
|
||||
normaliseMixedAmount :: MixedAmount -> MixedAmount
|
||||
normaliseMixedAmount = normaliseHelper False
|
||||
|
||||
normaliseHelper :: Bool -> MixedAmount -> MixedAmount
|
||||
normaliseHelper squashprices (Mixed as)
|
||||
| missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not
|
||||
| M.null nonzeros = Mixed [newzero]
|
||||
| otherwise = Mixed $ toList nonzeros
|
||||
amounts :: MixedAmount -> [Amount]
|
||||
amounts (Mixed ma)
|
||||
| missingkey `M.member` ma = [missingamt] -- missingamt should always be alone, but detect it even if not
|
||||
| M.null nonzeros = [newzero]
|
||||
| otherwise = toList nonzeros
|
||||
where
|
||||
newzero = fromMaybe nullamt $ find (not . T.null . acommodity) zeros
|
||||
(zeros, nonzeros) = M.partition amountIsZero amtMap
|
||||
amtMap = foldr (\a -> M.insertWith sumSimilarAmountsUsingFirstPrice (key a) a) mempty as
|
||||
key Amount{acommodity=c,aprice=p} = (c, if squashprices then Nothing else priceKey <$> p)
|
||||
where
|
||||
priceKey (UnitPrice x) = (acommodity x, Just $ aquantity x)
|
||||
priceKey (TotalPrice x) = (acommodity x, Nothing)
|
||||
missingkey = key missingamt
|
||||
(zeros, nonzeros) = M.partition amountIsZero ma
|
||||
missingkey = amountKey missingamt
|
||||
|
||||
-- | Like normaliseMixedAmount, but combine each commodity's amounts
|
||||
-- into just one by throwing away all prices except the first. This is
|
||||
-- only used as a rendering helper, and could show a misleading price.
|
||||
-- | Get a mixed amount's component amounts without normalising zero and missing
|
||||
-- amounts. This is used for JSON serialisation, so the order is important. In
|
||||
-- particular, we want the Amounts given in the order of the MixedAmountKeys,
|
||||
-- i.e. lexicographically first by commodity, then by price commodity, then by
|
||||
-- unit price from most negative to most positive.
|
||||
amountsRaw :: MixedAmount -> [Amount]
|
||||
amountsRaw (Mixed ma) = toList ma
|
||||
|
||||
normaliseMixedAmount :: MixedAmount -> MixedAmount
|
||||
normaliseMixedAmount = id -- XXX Remove
|
||||
|
||||
-- | Strip prices from a MixedAmount.
|
||||
normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount
|
||||
normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True
|
||||
normaliseMixedAmountSquashPricesForDisplay = mixedAmountStripPrices -- XXX Remove
|
||||
|
||||
-- | Unify a MixedAmount to a single commodity value if possible.
|
||||
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
|
||||
-- and discards zero amounts; but this one insists on simplifying to
|
||||
-- a single commodity, and will return Nothing if this is not possible.
|
||||
-- This consolidates amounts of the same commodity and discards zero
|
||||
-- amounts; but this one insists on simplifying to a single commodity,
|
||||
-- and will return Nothing if this is not possible.
|
||||
unifyMixedAmount :: MixedAmount -> Maybe Amount
|
||||
unifyMixedAmount = foldM combine 0 . amounts
|
||||
where
|
||||
@ -768,22 +774,27 @@ sumSimilarAmountsUsingFirstPrice a b = (a + b){aprice=p}
|
||||
|
||||
-- | Filter a mixed amount's component amounts by a predicate.
|
||||
filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount
|
||||
filterMixedAmount p (Mixed as) = Mixed $ filter p as
|
||||
filterMixedAmount p (Mixed ma) = Mixed $ M.filter p ma
|
||||
|
||||
-- | Return an unnormalised MixedAmount containing exactly one Amount
|
||||
-- with the specified commodity and the quantity of that commodity
|
||||
-- found in the original. NB if Amount's quantity is zero it will be
|
||||
-- discarded next time the MixedAmount gets normalised.
|
||||
filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount
|
||||
filterMixedAmountByCommodity c (Mixed as) = Mixed as'
|
||||
where
|
||||
as' = case filter ((==c) . acommodity) as of
|
||||
[] -> [nullamt{acommodity=c}]
|
||||
as'' -> [sum as'']
|
||||
filterMixedAmountByCommodity c (Mixed ma)
|
||||
| M.null ma' = mixedAmount nullamt{acommodity=c}
|
||||
| otherwise = Mixed ma'
|
||||
where ma' = M.filter ((c==) . acommodity) ma
|
||||
|
||||
-- | Apply a transform to a mixed amount's component 'Amount's.
|
||||
mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount
|
||||
mapMixedAmount f (Mixed as) = Mixed $ map f as
|
||||
mapMixedAmount f (Mixed ma) = mixed . map f $ toList ma
|
||||
|
||||
-- | Apply a transform to a mixed amount's component 'Amount's, which does not
|
||||
-- affect the key of the amount (i.e. doesn't change the commodity, price
|
||||
-- commodity, or unit price amount). This condition is not checked.
|
||||
mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount
|
||||
mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma -- Use M.map instead of fmap to maintain strictness
|
||||
|
||||
-- | Convert all component amounts to cost/selling price where
|
||||
-- possible (see amountCost).
|
||||
@ -795,17 +806,17 @@ mixedAmountCost = mapMixedAmount amountCost
|
||||
-- -- For now, use this when cross-commodity zero equality is important.
|
||||
-- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool
|
||||
-- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b')
|
||||
-- where a' = normaliseMixedAmountSquashPricesForDisplay a
|
||||
-- b' = normaliseMixedAmountSquashPricesForDisplay b
|
||||
-- where a' = mixedAmountStripPrices a
|
||||
-- b' = mixedAmountStripPrices b
|
||||
|
||||
-- | Given a map of standard commodity display styles, apply the
|
||||
-- appropriate one to each individual amount.
|
||||
styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
||||
styleMixedAmount styles = mapMixedAmount (styleAmount styles)
|
||||
styleMixedAmount styles = mapMixedAmountUnsafe (styleAmount styles)
|
||||
|
||||
-- | Reset each individual amount's display style to the default.
|
||||
mixedAmountUnstyled :: MixedAmount -> MixedAmount
|
||||
mixedAmountUnstyled = mapMixedAmount amountUnstyled
|
||||
mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled
|
||||
|
||||
-- | Get the string representation of a mixed amount, after
|
||||
-- normalising it to one amount per commodity. Assumes amounts have
|
||||
@ -871,8 +882,8 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)"
|
||||
-- - If displayed on multiple lines, any Amounts longer than the
|
||||
-- maximum width will be elided.
|
||||
showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder
|
||||
showMixedAmountB opts = showAmountsB opts . amounts
|
||||
. (if displayPrice opts then id else mixedAmountStripPrices) . normaliseMixedAmountSquashPricesForDisplay
|
||||
showMixedAmountB opts =
|
||||
showAmountsB opts . amounts . if displayPrice opts then id else mixedAmountStripPrices
|
||||
|
||||
data AmountDisplay = AmountDisplay
|
||||
{ adBuilder :: !WideBuilder -- ^ String representation of the Amount
|
||||
@ -916,20 +927,22 @@ ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)
|
||||
|
||||
-- | Set the display precision in the amount's commodities.
|
||||
mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
|
||||
mixedAmountSetPrecision p = mapMixedAmount (amountSetPrecision p)
|
||||
mixedAmountSetPrecision p = mapMixedAmountUnsafe (amountSetPrecision p)
|
||||
|
||||
-- | In each component amount, increase the display precision sufficiently
|
||||
-- to render it exactly (showing all significant decimal digits).
|
||||
mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount
|
||||
mixedAmountSetFullPrecision = mapMixedAmount amountSetFullPrecision
|
||||
mixedAmountSetFullPrecision = mapMixedAmountUnsafe amountSetFullPrecision
|
||||
|
||||
-- | Strip all prices from a MixedAmount.
|
||||
-- | Remove all prices from a MixedAmount.
|
||||
mixedAmountStripPrices :: MixedAmount -> MixedAmount
|
||||
mixedAmountStripPrices = mapMixedAmount amountStripPrices
|
||||
mixedAmountStripPrices (Mixed ma) =
|
||||
foldl' (\m a -> maAddAmount m a{aprice=Nothing}) (Mixed noPrices) withPrices
|
||||
where (noPrices, withPrices) = M.partition (isNothing . aprice) ma
|
||||
|
||||
-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
|
||||
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
||||
canonicaliseMixedAmount styles = mapMixedAmount (canonicaliseAmount styles)
|
||||
canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)
|
||||
|
||||
-- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.
|
||||
-- Has no effect on amounts without one.
|
||||
@ -982,14 +995,14 @@ tests_Amount = tests "Amount" [
|
||||
,usd (-1) `withPrecision` Precision 3
|
||||
,usd (-0.25)
|
||||
])
|
||||
@?= Mixed [usd 0 `withPrecision` Precision 3]
|
||||
@?= mixedAmount (usd 0 `withPrecision` Precision 3)
|
||||
|
||||
,test "adding mixed amounts with total prices" $ do
|
||||
maSum (map mixedAmount
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
@?= Mixed [usd (-1) @@ eur 2 ]
|
||||
@?= mixedAmount (usd (-1) @@ eur 2)
|
||||
|
||||
,test "showMixedAmount" $ do
|
||||
showMixedAmount (mixedAmount (usd 1)) @?= "$1.00"
|
||||
@ -1003,22 +1016,22 @@ tests_Amount = tests "Amount" [
|
||||
showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00"
|
||||
showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0"
|
||||
|
||||
,tests "normaliseMixedAmount" [
|
||||
,tests "amounts" [
|
||||
test "a missing amount overrides any other amounts" $
|
||||
amounts (normaliseMixedAmount $ mixed [usd 1, missingamt]) @?= [missingamt]
|
||||
amounts (mixed [usd 1, missingamt]) @?= [missingamt]
|
||||
,test "unpriced same-commodity amounts are combined" $
|
||||
amounts (normaliseMixedAmount $ mixed [usd 0, usd 2]) @?= [usd 2]
|
||||
amounts (mixed [usd 0, usd 2]) @?= [usd 2]
|
||||
,test "amounts with same unit price are combined" $
|
||||
amounts (normaliseMixedAmount $ mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1]
|
||||
amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1]
|
||||
,test "amounts with different unit prices are not combined" $
|
||||
amounts (normaliseMixedAmount $ mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2]
|
||||
amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2]
|
||||
,test "amounts with total prices are combined" $
|
||||
amounts (normaliseMixedAmount $ mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]
|
||||
amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]
|
||||
]
|
||||
|
||||
,test "normaliseMixedAmountSquashPricesForDisplay" $ do
|
||||
amounts (normaliseMixedAmountSquashPricesForDisplay nullmixedamt) @?= [nullamt]
|
||||
assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay
|
||||
,test "mixedAmountStripPrices" $ do
|
||||
amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt]
|
||||
assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices
|
||||
(mixed [usd 10
|
||||
,usd 10 @@ eur 7
|
||||
,usd (-10)
|
||||
|
||||
@ -547,8 +547,8 @@ journalMapPostings :: (Posting -> Posting) -> Journal -> Journal
|
||||
journalMapPostings f j@Journal{jtxns=ts} = j{jtxns=map (transactionMapPostings f) ts}
|
||||
|
||||
-- | Apply a transformation to a journal's posting amounts.
|
||||
journalMapPostingAmounts :: (Amount -> Amount) -> Journal -> Journal
|
||||
journalMapPostingAmounts f = journalMapPostings (postingTransformAmount (mapMixedAmount f))
|
||||
journalMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Journal -> Journal
|
||||
journalMapPostingAmounts f = journalMapPostings (postingTransformAmount f)
|
||||
|
||||
{-
|
||||
-------------------------------------------------------------------------------
|
||||
@ -929,7 +929,7 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
|
||||
-- need to see the balance as it stands after each individual posting.
|
||||
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
|
||||
addAmountAndCheckAssertionB p | hasAmount p = do
|
||||
newbal <- addToRunningBalanceB (paccount p) (pamount p)
|
||||
newbal <- addToRunningBalanceB (paccount p) $ pamount p
|
||||
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal
|
||||
return p
|
||||
addAmountAndCheckAssertionB p = return p
|
||||
@ -940,13 +940,12 @@ addAmountAndCheckAssertionB p = return p
|
||||
-- are ignored; if it is total, they will cause the assertion to fail.
|
||||
checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s ()
|
||||
checkBalanceAssertionB p@Posting{pbalanceassertion=Just (BalanceAssertion{baamount,batotal})} actualbal =
|
||||
forM_ assertedamts $ \amt -> checkBalanceAssertionOneCommodityB p amt actualbal
|
||||
forM_ (baamount : otheramts) $ \amt -> checkBalanceAssertionOneCommodityB p amt actualbal
|
||||
where
|
||||
assertedamts = baamount : otheramts
|
||||
where
|
||||
assertedcomm = acommodity baamount
|
||||
otheramts | batotal = map (\a -> a{aquantity=0}) $ amounts $ filterMixedAmount ((/=assertedcomm).acommodity) actualbal
|
||||
| otherwise = []
|
||||
assertedcomm = acommodity baamount
|
||||
otheramts | batotal = map (\a -> a{aquantity=0}) . amountsRaw
|
||||
$ filterMixedAmount ((/=assertedcomm).acommodity) actualbal
|
||||
| otherwise = []
|
||||
checkBalanceAssertionB _ _ = return ()
|
||||
|
||||
-- | Does this (single commodity) expected balance match the amount of that
|
||||
@ -971,7 +970,7 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
|
||||
else return actualbal
|
||||
let
|
||||
assertedcomm = acommodity assertedamt
|
||||
actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm $ actualbal'
|
||||
actualbalincomm = headDef nullamt . amountsRaw . filterMixedAmountByCommodity assertedcomm $ actualbal'
|
||||
pass =
|
||||
aquantity
|
||||
-- traceWith (("asserted:"++).showAmountDebug)
|
||||
@ -1181,16 +1180,16 @@ journalInferMarketPricesFromTransactions j =
|
||||
-- first commodity amount is considered.
|
||||
postingInferredmarketPrice :: Posting -> Maybe MarketPrice
|
||||
postingInferredmarketPrice p@Posting{pamount} =
|
||||
-- convert any total prices to unit prices
|
||||
case amounts $ mixedAmountTotalPriceToUnitPrice pamount of
|
||||
Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->
|
||||
Just MarketPrice {
|
||||
mpdate = postingDate p
|
||||
,mpfrom = fromcomm
|
||||
,mpto = tocomm
|
||||
,mprate = rate
|
||||
}
|
||||
_ -> Nothing
|
||||
-- convert any total prices to unit prices
|
||||
case amountsRaw $ mixedAmountTotalPriceToUnitPrice pamount of
|
||||
Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->
|
||||
Just MarketPrice {
|
||||
mpdate = postingDate p
|
||||
,mpfrom = fromcomm
|
||||
,mpto = tocomm
|
||||
,mprate = rate
|
||||
}
|
||||
_ -> Nothing
|
||||
|
||||
-- | Convert all this journal's amounts to cost using the transaction prices, if any.
|
||||
-- The journal's commodity styles are applied to the resulting amounts.
|
||||
@ -1229,12 +1228,12 @@ journalToCost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles) ts}
|
||||
-- Transaction price amounts (posting amounts' aprice field) are not included.
|
||||
--
|
||||
journalStyleInfluencingAmounts :: Journal -> [Amount]
|
||||
journalStyleInfluencingAmounts j =
|
||||
journalStyleInfluencingAmounts j =
|
||||
dbg7 "journalStyleInfluencingAmounts" $
|
||||
catMaybes $ concat [
|
||||
[mdefaultcommodityamt]
|
||||
,map (Just . pdamount) $ jpricedirectives j
|
||||
,map Just $ concatMap amounts $ map pamount $ journalPostings j
|
||||
,map Just . concatMap (amountsRaw . pamount) $ journalPostings j
|
||||
]
|
||||
where
|
||||
-- D's amount style isn't actually stored as an amount, make it into one
|
||||
@ -1561,7 +1560,7 @@ tests_Journal = tests "Journal" [
|
||||
]}
|
||||
assertRight ej
|
||||
let Right j = ej
|
||||
(jtxns j & head & tpostings & head & pamount) @?= mixedAmount (num 1)
|
||||
(jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]
|
||||
|
||||
,test "same-day-1" $ do
|
||||
assertRight $ journalBalanceTransactions True $
|
||||
|
||||
@ -50,6 +50,7 @@ import GHC.Generics (Generic)
|
||||
import System.Time (ClockTime)
|
||||
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.Amount (amountsRaw, mixed)
|
||||
|
||||
-- To JSON
|
||||
|
||||
@ -105,7 +106,11 @@ instance ToJSON AmountPrecision where
|
||||
|
||||
instance ToJSON Side
|
||||
instance ToJSON DigitGroupStyle
|
||||
instance ToJSON MixedAmount
|
||||
|
||||
instance ToJSON MixedAmount where
|
||||
toJSON = toJSON . amountsRaw
|
||||
toEncoding = toEncoding . amountsRaw
|
||||
|
||||
instance ToJSON BalanceAssertion
|
||||
instance ToJSON AmountPrice
|
||||
instance ToJSON MarketPrice
|
||||
@ -188,7 +193,10 @@ instance FromJSON AmountPrecision where
|
||||
|
||||
instance FromJSON Side
|
||||
instance FromJSON DigitGroupStyle
|
||||
instance FromJSON MixedAmount
|
||||
|
||||
instance FromJSON MixedAmount where
|
||||
parseJSON = fmap (mixed :: [Amount] -> MixedAmount) . parseJSON
|
||||
|
||||
instance FromJSON BalanceAssertion
|
||||
instance FromJSON AmountPrice
|
||||
instance FromJSON MarketPrice
|
||||
|
||||
@ -115,7 +115,7 @@ posting = nullposting
|
||||
|
||||
-- | Make a posting to an account.
|
||||
post :: AccountName -> Amount -> Posting
|
||||
post acc amt = posting {paccount=acc, pamount=Mixed [amt]}
|
||||
post acc amt = posting {paccount=acc, pamount=mixedAmount amt}
|
||||
|
||||
-- | Make a virtual (unbalanced) posting to an account.
|
||||
vpost :: AccountName -> Amount -> Posting
|
||||
@ -123,7 +123,7 @@ vpost acc amt = (post acc amt){ptype=VirtualPosting}
|
||||
|
||||
-- | Make a posting to an account, maybe with a balance assertion.
|
||||
post' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
|
||||
post' acc amt ass = posting {paccount=acc, pamount=Mixed [amt], pbalanceassertion=ass}
|
||||
post' acc amt ass = posting {paccount=acc, pamount=mixedAmount amt, pbalanceassertion=ass}
|
||||
|
||||
-- | Make a virtual (unbalanced) posting to an account, maybe with a balance assertion.
|
||||
vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting
|
||||
@ -197,10 +197,11 @@ hasBalanceAssignment p = not (hasAmount p) && isJust (pbalanceassertion p)
|
||||
accountNamesFromPostings :: [Posting] -> [AccountName]
|
||||
accountNamesFromPostings = nubSort . map paccount
|
||||
|
||||
-- | Sum all amounts from a list of postings.
|
||||
sumPostings :: [Posting] -> MixedAmount
|
||||
sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt
|
||||
|
||||
-- | Remove all prices of a posting
|
||||
-- | Strip all prices from a Posting.
|
||||
postingStripPrices :: Posting -> Posting
|
||||
postingStripPrices = postingTransformAmount mixedAmountStripPrices
|
||||
|
||||
|
||||
@ -65,7 +65,7 @@ where
|
||||
import Data.Default (def)
|
||||
import Data.List (intercalate, partition)
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
@ -283,9 +283,8 @@ postingAsLines elideamount onelineamounts acctwidth amtwidth p =
|
||||
-- amtwidth and thisamtwidth, make sure thisamtwidth does not depend on
|
||||
-- amtwidth at all.
|
||||
shownAmounts
|
||||
| elideamount || null (amounts $ pamount p) = [mempty]
|
||||
| otherwise = showAmountsLinesB displayopts . amounts $ pamount p
|
||||
where displayopts = noColour{displayOneLine=onelineamounts}
|
||||
| elideamount = [mempty]
|
||||
| otherwise = showAmountsLinesB noColour{displayOneLine=onelineamounts} . amounts $ pamount p
|
||||
thisamtwidth = maximumDef 0 $ map wbWidth shownAmounts
|
||||
|
||||
(samelinecomment, newlinecomments) =
|
||||
@ -554,35 +553,35 @@ priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)
|
||||
priceInferrerFor t pt = inferprice
|
||||
where
|
||||
postings = filter ((==pt).ptype) $ tpostings t
|
||||
pamounts = concatMap (amounts . pamount) postings
|
||||
pcommodities = map acommodity pamounts
|
||||
sumamounts = amounts $ sumPostings postings -- sum normalises to one amount per commodity & price
|
||||
pmixedamounts = map pamount postings
|
||||
pcommodities = map acommodity $ concatMap amountsRaw pmixedamounts
|
||||
sumamounts = amounts $ maSum pmixedamounts -- sum normalises to one amount per commodity & price
|
||||
sumcommodities = map acommodity sumamounts
|
||||
sumprices = filter (/=Nothing) $ map aprice sumamounts
|
||||
sumprices = filter isJust $ map aprice sumamounts
|
||||
caninferprices = length sumcommodities == 2 && null sumprices
|
||||
|
||||
inferprice p@Posting{pamount=Mixed [a]}
|
||||
| caninferprices && ptype p == pt && acommodity a == fromcommodity
|
||||
= p{pamount=mixedAmount $ a{aprice=Just conversionprice}, poriginal=Just $ originalPosting p}
|
||||
where
|
||||
fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
|
||||
totalpricesign = if aquantity a < 0 then negate else id
|
||||
conversionprice
|
||||
| fromcount==1 = TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision
|
||||
| otherwise = UnitPrice $ abs unitprice `withPrecision` unitprecision
|
||||
where
|
||||
fromcount = length $ filter ((==fromcommodity).acommodity) pamounts
|
||||
fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts
|
||||
fromprecision = asprecision $ astyle fromamount
|
||||
tocommodity = head $ filter (/=fromcommodity) sumcommodities
|
||||
toamount = head $ filter ((==tocommodity).acommodity) sumamounts
|
||||
toprecision = asprecision $ astyle toamount
|
||||
unitprice = (aquantity fromamount) `divideAmount` toamount
|
||||
-- Sum two display precisions, capping the result at the maximum bound
|
||||
unitprecision = case (fromprecision, toprecision) of
|
||||
(Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b)
|
||||
_ -> NaturalPrecision
|
||||
inferprice p = p
|
||||
inferprice p@Posting{pamount=amt} = case amountsRaw amt of
|
||||
[a] | caninferprices && ptype p == pt && acommodity a == fromcommodity
|
||||
-> p{ pamount=mixedAmount a{aprice=Just conversionprice}
|
||||
, poriginal=Just $ originalPosting p}
|
||||
where
|
||||
fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
|
||||
totalpricesign = if aquantity a < 0 then negate else id
|
||||
conversionprice = case filter (==fromcommodity) pcommodities of
|
||||
[_] -> TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision
|
||||
_ -> UnitPrice $ abs unitprice `withPrecision` unitprecision
|
||||
where
|
||||
fromamount = head $ filter ((==fromcommodity).acommodity) sumamounts
|
||||
fromprecision = asprecision $ astyle fromamount
|
||||
tocommodity = head $ filter (/=fromcommodity) sumcommodities
|
||||
toamount = head $ filter ((==tocommodity).acommodity) sumamounts
|
||||
toprecision = asprecision $ astyle toamount
|
||||
unitprice = aquantity fromamount `divideAmount` toamount
|
||||
-- Sum two display precisions, capping the result at the maximum bound
|
||||
unitprecision = case (fromprecision, toprecision) of
|
||||
(Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b)
|
||||
_ -> NaturalPrecision
|
||||
_ -> p
|
||||
|
||||
-- Get a transaction's secondary date, defaulting to the primary date.
|
||||
transactionDate2 :: Transaction -> Day
|
||||
@ -638,8 +637,8 @@ transactionMapPostings :: (Posting -> Posting) -> Transaction -> Transaction
|
||||
transactionMapPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}
|
||||
|
||||
-- | Apply a transformation to a transaction's posting amounts.
|
||||
transactionMapPostingAmounts :: (Amount -> Amount) -> Transaction -> Transaction
|
||||
transactionMapPostingAmounts f = transactionMapPostings (postingTransformAmount (mapMixedAmount f))
|
||||
transactionMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Transaction -> Transaction
|
||||
transactionMapPostingAmounts f = transactionMapPostings (postingTransformAmount f)
|
||||
|
||||
-- | The file path from which this transaction was parsed.
|
||||
transactionFile :: Transaction -> FilePath
|
||||
@ -655,13 +654,13 @@ tests_Transaction =
|
||||
tests "Transaction" [
|
||||
|
||||
tests "showPostingLines" [
|
||||
test "null posting" $ showPostingLines posting @?= [""]
|
||||
test "null posting" $ showPostingLines nullposting @?= [" 0"]
|
||||
, test "non-null posting" $
|
||||
let p =
|
||||
posting
|
||||
{ pstatus = Cleared
|
||||
, paccount = "a"
|
||||
, pamount = Mixed [usd 1, hrs 2]
|
||||
, pamount = mixed [usd 1, hrs 2]
|
||||
, pcomment = "pcomment1\npcomment2\n tag3: val3 \n"
|
||||
, ptype = RegularPosting
|
||||
, ptags = [("ptag1", "val1"), ("ptag2", "val2")]
|
||||
@ -742,7 +741,7 @@ tests_Transaction =
|
||||
[ nullposting
|
||||
{ pstatus = Cleared
|
||||
, paccount = "a"
|
||||
, pamount = Mixed [usd 1, hrs 2]
|
||||
, pamount = mixed [usd 1, hrs 2]
|
||||
, pcomment = "\npcomment2\n"
|
||||
, ptype = RegularPosting
|
||||
, ptags = [("ptag1", "val1"), ("ptag2", "val2")]
|
||||
@ -771,8 +770,8 @@ tests_Transaction =
|
||||
"coopportunity"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t}
|
||||
, posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t}
|
||||
[ posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18), ptransaction = Just t}
|
||||
, posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.18)), ptransaction = Just t}
|
||||
]
|
||||
in showTransaction t) @?=
|
||||
(T.unlines
|
||||
@ -795,8 +794,8 @@ tests_Transaction =
|
||||
"coopportunity"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}
|
||||
, posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]}
|
||||
[ posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18)}
|
||||
, posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.19))}
|
||||
])) @?=
|
||||
(T.unlines
|
||||
[ "2007-01-28 coopportunity"
|
||||
@ -834,7 +833,7 @@ tests_Transaction =
|
||||
"x"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` Precision 0)]}
|
||||
[ posting {paccount = "a", pamount = mixedAmount $ num 1 `at` (usd 2 `withPrecision` Precision 0)}
|
||||
, posting {paccount = "b", pamount = missingmixedamt}
|
||||
])) @?=
|
||||
(T.unlines ["2010-01-01 x", " a 1 @ $2", " b", ""])
|
||||
@ -855,7 +854,7 @@ tests_Transaction =
|
||||
"test"
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}]))
|
||||
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}]))
|
||||
,test "detect unbalanced entry, multiple missing amounts" $
|
||||
assertLeft $
|
||||
balanceTransaction
|
||||
@ -889,8 +888,8 @@ tests_Transaction =
|
||||
""
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) @?=
|
||||
Right (Mixed [usd (-1)])
|
||||
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?=
|
||||
Right (mixedAmount $ usd (-1))
|
||||
,test "conversion price is inferred" $
|
||||
(pamount . head . tpostings <$>
|
||||
balanceTransaction
|
||||
@ -906,10 +905,10 @@ tests_Transaction =
|
||||
""
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "a", pamount = Mixed [usd 1.35]}
|
||||
, posting {paccount = "b", pamount = Mixed [eur (-1)]}
|
||||
[ posting {paccount = "a", pamount = mixedAmount (usd 1.35)}
|
||||
, posting {paccount = "b", pamount = mixedAmount (eur (-1))}
|
||||
])) @?=
|
||||
Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` NaturalPrecision)])
|
||||
Right (mixedAmount $ usd 1.35 @@ (eur 1 `withPrecision` NaturalPrecision))
|
||||
,test "balanceTransaction balances based on cost if there are unit prices" $
|
||||
assertRight $
|
||||
balanceTransaction
|
||||
@ -925,8 +924,8 @@ tests_Transaction =
|
||||
""
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]}
|
||||
, posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]}
|
||||
[ posting {paccount = "a", pamount = mixedAmount $ usd 1 `at` eur 2}
|
||||
, posting {paccount = "a", pamount = mixedAmount $ usd (-2) `at` eur 1}
|
||||
])
|
||||
,test "balanceTransaction balances based on cost if there are total prices" $
|
||||
assertRight $
|
||||
@ -943,8 +942,8 @@ tests_Transaction =
|
||||
""
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "a", pamount = Mixed [usd 1 @@ eur 1]}
|
||||
, posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur (-1)]}
|
||||
[ posting {paccount = "a", pamount = mixedAmount $ usd 1 @@ eur 1}
|
||||
, posting {paccount = "a", pamount = mixedAmount $ usd (-2) @@ eur (-1)}
|
||||
])
|
||||
]
|
||||
, tests "isTransactionBalanced" [
|
||||
@ -962,8 +961,8 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "b", pamount = Mixed [usd 1.00]}
|
||||
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
]
|
||||
,test "detect unbalanced" $
|
||||
assertBool "" $
|
||||
@ -980,8 +979,8 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "b", pamount = Mixed [usd 1.00]}
|
||||
, posting {paccount = "c", pamount = Mixed [usd (-1.01)]}
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.01))}
|
||||
]
|
||||
,test "detect unbalanced, one posting" $
|
||||
assertBool "" $
|
||||
@ -998,7 +997,7 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "b", pamount = Mixed [usd 1.00]}]
|
||||
[posting {paccount = "b", pamount = mixedAmount (usd 1.00)}]
|
||||
,test "one zero posting is considered balanced for now" $
|
||||
assertBool "" $
|
||||
isTransactionBalanced Nothing $
|
||||
@ -1013,7 +1012,7 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "b", pamount = Mixed [usd 0]}]
|
||||
[posting {paccount = "b", pamount = mixedAmount (usd 0)}]
|
||||
,test "virtual postings don't need to balance" $
|
||||
assertBool "" $
|
||||
isTransactionBalanced Nothing $
|
||||
@ -1028,9 +1027,9 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "b", pamount = Mixed [usd 1.00]}
|
||||
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
|
||||
, posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting}
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = VirtualPosting}
|
||||
]
|
||||
,test "balanced virtual postings need to balance among themselves" $
|
||||
assertBool "" $
|
||||
@ -1047,9 +1046,9 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "b", pamount = Mixed [usd 1.00]}
|
||||
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
|
||||
, posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting}
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = BalancedVirtualPosting}
|
||||
]
|
||||
,test "balanced virtual postings need to balance among themselves (2)" $
|
||||
assertBool "" $
|
||||
@ -1065,10 +1064,10 @@ tests_Transaction =
|
||||
"a"
|
||||
""
|
||||
[]
|
||||
[ posting {paccount = "b", pamount = Mixed [usd 1.00]}
|
||||
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
|
||||
, posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting}
|
||||
, posting {paccount = "3", pamount = Mixed [usd (-100)], ptype = BalancedVirtualPosting}
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = BalancedVirtualPosting}
|
||||
, posting {paccount = "3", pamount = mixedAmount (usd (-100)), ptype = BalancedVirtualPosting}
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
@ -114,13 +114,13 @@ tmPostingRuleToFunction querytxt pr =
|
||||
Just n -> \p ->
|
||||
-- Multiply the old posting's amount by the posting rule's multiplier.
|
||||
let
|
||||
pramount = dbg6 "pramount" $ head $ amounts $ pamount pr
|
||||
pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr
|
||||
matchedamount = dbg6 "matchedamount" $ pamount p
|
||||
-- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928).
|
||||
-- Approach 1: convert to a unit price and increase the display precision slightly
|
||||
-- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount
|
||||
-- Approach 2: multiply the total price (keeping it positive) as well as the quantity
|
||||
as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount
|
||||
as = dbg6 "multipliedamount" $ multiplyMixedAmount n matchedamount
|
||||
in
|
||||
case acommodity pramount of
|
||||
"" -> as
|
||||
@ -130,10 +130,9 @@ tmPostingRuleToFunction querytxt pr =
|
||||
c -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as
|
||||
|
||||
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
|
||||
postingRuleMultiplier p =
|
||||
case amounts $ pamount p of
|
||||
[a] | aismultiplier a -> Just $ aquantity a
|
||||
_ -> Nothing
|
||||
postingRuleMultiplier p = case amountsRaw $ pamount p of
|
||||
[a] | aismultiplier a -> Just $ aquantity a
|
||||
_ -> Nothing
|
||||
|
||||
renderPostingCommentDates :: Posting -> Posting
|
||||
renderPostingCommentDates p = p { pcomment = comment' }
|
||||
|
||||
@ -16,12 +16,13 @@ For more detailed documentation on each type, see the corresponding modules.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
-- {-# LANGUAGE DeriveAnyClass #-} -- https://hackage.haskell.org/package/deepseq-1.4.4.0/docs/Control-DeepSeq.html#v:rnf
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
module Hledger.Data.Types
|
||||
@ -38,6 +39,10 @@ import Text.Blaze (ToMarkup(..))
|
||||
--You will eventually need all the values stored.
|
||||
--The stored values don't represent large virtual data structures to be lazily computed.
|
||||
import qualified Data.Map as M
|
||||
import Data.Ord (comparing)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Text (Text)
|
||||
-- import qualified Data.Text as T
|
||||
import Data.Time.Calendar
|
||||
@ -230,7 +235,38 @@ data Amount = Amount {
|
||||
aprice :: !(Maybe AmountPrice) -- ^ the (fixed, transaction-specific) price for this amount, if any
|
||||
} deriving (Eq,Ord,Generic,Show)
|
||||
|
||||
newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Generic,Show)
|
||||
newtype MixedAmount = Mixed (M.Map MixedAmountKey Amount) deriving (Eq,Ord,Generic,Show)
|
||||
|
||||
-- | Stores the CommoditySymbol of the Amount, along with the CommoditySymbol of
|
||||
-- the price, and its unit price if being used.
|
||||
data MixedAmountKey
|
||||
= MixedAmountKeyNoPrice !CommoditySymbol
|
||||
| MixedAmountKeyTotalPrice !CommoditySymbol !CommoditySymbol
|
||||
| MixedAmountKeyUnitPrice !CommoditySymbol !CommoditySymbol !Quantity
|
||||
deriving (Eq,Generic,Show)
|
||||
|
||||
-- | We don't auto-derive the Ord instance because it would give an undesired ordering.
|
||||
-- We want the keys to be sorted lexicographically:
|
||||
-- (1) By the primary commodity of the amount.
|
||||
-- (2) By the commodity of the price, with no price being first.
|
||||
-- (3) By the unit price, from most negative to most positive, with total prices
|
||||
-- before unit prices.
|
||||
-- For example, we would like the ordering to give
|
||||
-- MixedAmountKeyNoPrice "X" < MixedAmountKeyTotalPrice "X" "Z" < MixedAmountKeyNoPrice "Y"
|
||||
instance Ord MixedAmountKey where
|
||||
compare = comparing commodity <> comparing pCommodity <> comparing pPrice
|
||||
where
|
||||
commodity (MixedAmountKeyNoPrice c) = c
|
||||
commodity (MixedAmountKeyTotalPrice c _) = c
|
||||
commodity (MixedAmountKeyUnitPrice c _ _) = c
|
||||
|
||||
pCommodity (MixedAmountKeyNoPrice _) = Nothing
|
||||
pCommodity (MixedAmountKeyTotalPrice _ pc) = Just pc
|
||||
pCommodity (MixedAmountKeyUnitPrice _ pc _) = Just pc
|
||||
|
||||
pPrice (MixedAmountKeyNoPrice _) = Nothing
|
||||
pPrice (MixedAmountKeyTotalPrice _ _) = Nothing
|
||||
pPrice (MixedAmountKeyUnitPrice _ _ q) = Just q
|
||||
|
||||
data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting
|
||||
deriving (Eq,Show,Generic)
|
||||
|
||||
@ -17,8 +17,9 @@ module Hledger.Data.Valuation (
|
||||
,ValuationType(..)
|
||||
,PriceOracle
|
||||
,journalPriceOracle
|
||||
-- ,amountApplyValuation
|
||||
-- ,amountValueAtDate
|
||||
,amountApplyCostValuation
|
||||
,amountApplyValuation
|
||||
,amountValueAtDate
|
||||
,mixedAmountApplyCostValuation
|
||||
,mixedAmountApplyValuation
|
||||
,mixedAmountValueAtDate
|
||||
@ -105,12 +106,7 @@ priceDirectiveToMarketPrice PriceDirective{..} =
|
||||
-- See amountApplyValuation and amountCost.
|
||||
mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount
|
||||
mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v =
|
||||
valuation . costing
|
||||
where
|
||||
valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v
|
||||
costing = case cost of
|
||||
Cost -> styleMixedAmount styles . mixedAmountCost
|
||||
NoCost -> id
|
||||
mapMixedAmount (amountApplyCostValuation priceoracle styles periodlast today postingdate cost v)
|
||||
|
||||
-- | Apply a specified valuation to this mixed amount, using the
|
||||
-- provided price oracle, commodity styles, and reference dates.
|
||||
@ -119,6 +115,19 @@ mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle ->
|
||||
mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =
|
||||
mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v)
|
||||
|
||||
-- | Apply a specified costing and valuation to this Amount,
|
||||
-- using the provided price oracle, commodity styles, and reference dates.
|
||||
-- Costing is done first if requested, and after that any valuation.
|
||||
-- See amountApplyValuation and amountCost.
|
||||
amountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> Amount -> Amount
|
||||
amountApplyCostValuation priceoracle styles periodlast today postingdate cost v =
|
||||
valuation . costing
|
||||
where
|
||||
valuation = maybe id (amountApplyValuation priceoracle styles periodlast today postingdate) v
|
||||
costing = case cost of
|
||||
Cost -> styleAmount styles . amountCost
|
||||
NoCost -> id
|
||||
|
||||
-- | Apply a specified valuation to this amount, using the provided
|
||||
-- price oracle, reference dates, and whether this is for a
|
||||
-- multiperiod report or not. Also fix up its display style using the
|
||||
|
||||
@ -78,7 +78,7 @@ import Text.Megaparsec.Char (char, string)
|
||||
import Hledger.Utils hiding (words')
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.AccountName
|
||||
import Hledger.Data.Amount (nullamt, usd)
|
||||
import Hledger.Data.Amount (amountsRaw, mixedAmount, nullamt, usd)
|
||||
import Hledger.Data.Dates
|
||||
import Hledger.Data.Posting
|
||||
import Hledger.Data.Transaction
|
||||
@ -562,8 +562,9 @@ matchesAccount (Tag _ _) _ = False
|
||||
matchesAccount _ _ = True
|
||||
|
||||
matchesMixedAmount :: Query -> MixedAmount -> Bool
|
||||
matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt
|
||||
matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as
|
||||
matchesMixedAmount q ma = case amountsRaw ma of
|
||||
[] -> q `matchesAmount` nullamt
|
||||
as -> any (q `matchesAmount`) as
|
||||
|
||||
matchesCommodity :: Query -> CommoditySymbol -> Bool
|
||||
matchesCommodity (Sym r) = regexMatchText r
|
||||
@ -614,8 +615,8 @@ matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p
|
||||
matchesPosting (StatusQ s) p = postingStatus p == s
|
||||
matchesPosting (Real v) p = v == isReal p
|
||||
matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a
|
||||
matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt
|
||||
matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as
|
||||
matchesPosting q@(Amt _ _) Posting{pamount=as} = q `matchesMixedAmount` as
|
||||
matchesPosting (Sym r) Posting{pamount=as} = any (matchesCommodity (Sym r)) . map acommodity $ amountsRaw as
|
||||
matchesPosting (Tag n v) p = case (reString n, v) of
|
||||
("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p
|
||||
("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p
|
||||
@ -811,10 +812,10 @@ tests_Query = tests "Query" [
|
||||
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
|
||||
,test "cur:" $ do
|
||||
let toSym = either id (const $ error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)
|
||||
assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol
|
||||
assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr
|
||||
assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
|
||||
assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
|
||||
assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- becomes "^$$", ie testing for null symbol
|
||||
assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- have to quote $ for regexpr
|
||||
assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}
|
||||
assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}
|
||||
]
|
||||
|
||||
,test "matchesTransaction" $ do
|
||||
|
||||
@ -407,7 +407,7 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
|
||||
-- | Check that all the commodities used in this journal's postings have been declared
|
||||
-- by commodity directives, returning an error message otherwise.
|
||||
journalCheckCommoditiesDeclared :: Journal -> Either String ()
|
||||
journalCheckCommoditiesDeclared j =
|
||||
journalCheckCommoditiesDeclared j =
|
||||
sequence_ $ map checkcommodities $ journalPostings j
|
||||
where
|
||||
checkcommodities Posting{..} =
|
||||
@ -423,7 +423,7 @@ journalCheckCommoditiesDeclared j =
|
||||
where
|
||||
mfirstundeclaredcomm =
|
||||
find (`M.notMember` jcommodities j) . map acommodity $
|
||||
(maybe id ((:) . baamount) pbalanceassertion) (filter (/= missingamt) $ amounts pamount)
|
||||
(maybe id ((:) . baamount) pbalanceassertion) . filter (/= missingamt) $ amountsRaw pamount
|
||||
|
||||
|
||||
setYear :: Year -> JournalParser m ()
|
||||
|
||||
@ -711,7 +711,7 @@ postingp mTransactionYear = do
|
||||
return (status, account)
|
||||
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
|
||||
lift skipNonNewlineSpaces
|
||||
amount <- option missingmixedamt $ mixedAmount <$> amountp
|
||||
amount <- optional amountp
|
||||
lift skipNonNewlineSpaces
|
||||
massertion <- optional balanceassertionp
|
||||
lift skipNonNewlineSpaces
|
||||
@ -721,7 +721,7 @@ postingp mTransactionYear = do
|
||||
, pdate2=mdate2
|
||||
, pstatus=status
|
||||
, paccount=account'
|
||||
, pamount=amount
|
||||
, pamount=maybe missingmixedamt mixedAmount amount
|
||||
, pcomment=comment
|
||||
, ptype=ptype
|
||||
, ptags=tags
|
||||
@ -823,7 +823,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
|
||||
posting{
|
||||
paccount="expenses:food:dining",
|
||||
pamount=Mixed [usd 10],
|
||||
pamount=mixedAmount (usd 10),
|
||||
pcomment="a: a a\nb: b b\n",
|
||||
ptags=[("a","a a"), ("b","b b")]
|
||||
}
|
||||
@ -832,7 +832,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
" a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
|
||||
nullposting{
|
||||
paccount="a"
|
||||
,pamount=Mixed [num 1]
|
||||
,pamount=mixedAmount (num 1)
|
||||
,pcomment="date:2012/11/28, date2=2012/11/29,b:b\n"
|
||||
,ptags=[("date", "2012/11/28"), ("date2=2012/11/29,b", "b")] -- TODO tag name parsed too greedily
|
||||
,pdate=Just $ fromGregorian 2012 11 28
|
||||
@ -843,7 +843,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
" a 1. ; [2012/11/28=2012/11/29]\n"
|
||||
nullposting{
|
||||
paccount="a"
|
||||
,pamount=Mixed [num 1]
|
||||
,pamount=mixedAmount (num 1)
|
||||
,pcomment="[2012/11/28=2012/11/29]\n"
|
||||
,ptags=[]
|
||||
,pdate= Just $ fromGregorian 2012 11 28
|
||||
@ -872,7 +872,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
"= (some value expr)\n some:postings 1.\n"
|
||||
nulltransactionmodifier {
|
||||
tmquerytxt = "(some value expr)"
|
||||
,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}]
|
||||
,tmpostingrules = [nullposting{paccount="some:postings", pamount=mixedAmount (num 1)}]
|
||||
}
|
||||
]
|
||||
|
||||
@ -905,7 +905,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
pdate=Nothing,
|
||||
pstatus=Cleared,
|
||||
paccount="a",
|
||||
pamount=Mixed [usd 1],
|
||||
pamount=mixedAmount (usd 1),
|
||||
pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
|
||||
ptype=RegularPosting,
|
||||
ptags=[("ptag1","val1"),("ptag2","val2")],
|
||||
|
||||
@ -182,7 +182,7 @@ entryp = do
|
||||
tstatus = Cleared,
|
||||
tpostings = [
|
||||
nullposting{paccount=a
|
||||
,pamount=Mixed [amountSetPrecision (Precision 2) $ num hours] -- don't assume hours; do set precision to 2
|
||||
,pamount=mixedAmount . amountSetPrecision (Precision 2) $ num hours -- don't assume hours; do set precision to 2
|
||||
,ptype=VirtualPosting
|
||||
,ptransaction=Just t
|
||||
}
|
||||
|
||||
@ -90,7 +90,7 @@ Right samplejournal2 =
|
||||
tcomment="",
|
||||
ttags=[],
|
||||
tpostings=
|
||||
[posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]}
|
||||
[posting {paccount="assets:bank:checking", pamount=mixedAmount (usd 1)}
|
||||
,posting {paccount="income:salary", pamount=missingmixedamt}
|
||||
],
|
||||
tprecedingcomment=""
|
||||
|
||||
@ -170,7 +170,7 @@ postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn
|
||||
isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev
|
||||
SecondaryDate -> postingDate2 p /= postingDate2 pprev
|
||||
p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p}
|
||||
b' = runningcalcfn itemnum b (pamount p)
|
||||
b' = runningcalcfn itemnum b $ pamount p
|
||||
|
||||
-- | Generate one postings report line item, containing the posting,
|
||||
-- the current running balance, and optionally the posting date and/or
|
||||
@ -231,7 +231,7 @@ summarisePostingsInDateSpan (DateSpan b e) wd mdepth showempty ps
|
||||
isclipped a = maybe True (accountNameLevel a >=) mdepth
|
||||
|
||||
negatePostingAmount :: Posting -> Posting
|
||||
negatePostingAmount p = p { pamount = maNegate $ pamount p }
|
||||
negatePostingAmount = postingTransformAmount negate
|
||||
|
||||
|
||||
-- tests
|
||||
|
||||
@ -72,7 +72,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
|
||||
_ -> [maincontent]
|
||||
where
|
||||
-- as with print, show amounts with all of their decimal places
|
||||
t = transactionMapPostingAmounts amountSetFullPrecision t'
|
||||
t = transactionMapPostingAmounts mixedAmountSetFullPrecision t'
|
||||
maincontent = Widget Greedy Greedy $ do
|
||||
let
|
||||
prices = journalPriceOracle (infer_value_ ropts) j
|
||||
|
||||
@ -158,7 +158,7 @@ validatePostings acctRes amtRes = let
|
||||
zipRow (Left e) (Left e') = Left (Just e, Just e')
|
||||
zipRow (Left e) (Right _) = Left (Just e, Nothing)
|
||||
zipRow (Right _) (Left e) = Left (Nothing, Just e)
|
||||
zipRow (Right acct) (Right amt) = Right (nullposting {paccount = acct, pamount = Mixed [amt]})
|
||||
zipRow (Right acct) (Right amt) = Right (nullposting {paccount = acct, pamount = mixedAmount amt})
|
||||
|
||||
errorToFormMsg = first (("Invalid value: " <>) . T.pack .
|
||||
foldl (\s a -> s <> parseErrorTextPretty a) "" .
|
||||
|
||||
@ -233,7 +233,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
|
||||
EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case
|
||||
Just (amount, comment) -> do
|
||||
let posting = nullposting{paccount=T.pack $ stripbrackets account
|
||||
,pamount=Mixed [amount]
|
||||
,pamount=mixedAmount amount
|
||||
,pcomment=comment
|
||||
,ptype=accountNamePostingType $ T.pack account
|
||||
}
|
||||
|
||||
@ -98,7 +98,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
||||
closingps =
|
||||
concat [
|
||||
[posting{paccount = a
|
||||
,pamount = mixed [precise $ negate b]
|
||||
,pamount = mixedAmount . precise $ negate b
|
||||
-- after each commodity's last posting, assert 0 balance (#1035)
|
||||
-- balance assertion amounts are unpriced (#824)
|
||||
,pbalanceassertion =
|
||||
@ -108,11 +108,11 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
||||
}
|
||||
]
|
||||
-- maybe an interleaved posting transferring this balance to equity
|
||||
++ [posting{paccount=closingacct, pamount=Mixed [precise b]} | interleaved]
|
||||
++ [posting{paccount=closingacct, pamount=mixedAmount $ precise b} | interleaved]
|
||||
|
||||
| -- get the balances for each commodity and transaction price
|
||||
(a,_,_,mb) <- acctbals
|
||||
, let bs = amounts $ normaliseMixedAmount mb
|
||||
, let bs = amounts mb
|
||||
-- mark the last balance in each commodity with True
|
||||
, let bs' = concat [reverse $ zip (reverse bs) (True : repeat False)
|
||||
| bs <- groupBy ((==) `on` acommodity) bs]
|
||||
@ -121,21 +121,21 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
||||
|
||||
-- or a final multicommodity posting transferring all balances to equity
|
||||
-- (print will show this as multiple single-commodity postings)
|
||||
++ [posting{paccount=closingacct, pamount=if explicit then mapMixedAmount precise totalamt else missingmixedamt} | not interleaved]
|
||||
++ [posting{paccount=closingacct, pamount=if explicit then mixedAmountSetFullPrecision totalamt else missingmixedamt} | not interleaved]
|
||||
|
||||
-- the opening transaction
|
||||
openingtxn = nulltransaction{tdate=openingdate, tdescription=openingdesc, tpostings=openingps}
|
||||
openingps =
|
||||
concat [
|
||||
[posting{paccount = a
|
||||
,pamount = mixed [precise b]
|
||||
,pamount = mixedAmount $ precise b
|
||||
,pbalanceassertion =
|
||||
case mcommoditysum of
|
||||
Just s -> Just nullassertion{baamount=precise s{aprice=Nothing}}
|
||||
Nothing -> Nothing
|
||||
}
|
||||
]
|
||||
++ [posting{paccount=openingacct, pamount=Mixed [precise $ negate b]} | interleaved]
|
||||
++ [posting{paccount=openingacct, pamount=mixedAmount . precise $ negate b} | interleaved]
|
||||
|
||||
| (a,_,_,mb) <- acctbals
|
||||
, let bs = amounts $ normaliseMixedAmount mb
|
||||
@ -145,7 +145,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 (maNegate totalamt) else missingmixedamt} | not interleaved]
|
||||
++ [posting{paccount=openingacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved]
|
||||
|
||||
-- print them
|
||||
when closing . T.putStr $ showTransaction closingtxn
|
||||
|
||||
@ -33,7 +33,7 @@ prices opts j = do
|
||||
ps = filter (matchesPosting q) $ allPostings j
|
||||
mprices = jpricedirectives j
|
||||
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps
|
||||
icprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ mapAmount invertPrice ps
|
||||
icprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts $ map (postingTransformAmount $ mapMixedAmount invertPrice) ps
|
||||
allprices = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices
|
||||
mapM_ (T.putStrLn . showPriceDirective) $
|
||||
sortOn pddate $
|
||||
@ -71,8 +71,8 @@ invertPrice a =
|
||||
pa' = pa { aquantity = abs $ aquantity a, acommodity = acommodity a, aprice = Nothing, astyle = astyle a }
|
||||
|
||||
postingsPriceDirectivesFromCosts :: Posting -> [PriceDirective]
|
||||
postingsPriceDirectivesFromCosts p = mapMaybe (amountPriceDirectiveFromCost date) . amounts $ pamount p where
|
||||
date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p
|
||||
postingsPriceDirectivesFromCosts p = mapMaybe (amountPriceDirectiveFromCost date) . amountsRaw $ pamount p
|
||||
where date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p
|
||||
|
||||
amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
|
||||
amountPriceDirectiveFromCost d a =
|
||||
@ -92,8 +92,3 @@ stylePriceDirectiveExceptPrecision styles pd@PriceDirective{pdamount=a} =
|
||||
|
||||
allPostings :: Journal -> [Posting]
|
||||
allPostings = concatMap tpostings . jtxns
|
||||
|
||||
mapAmount :: (Amount -> Amount) -> [Posting] -> [Posting]
|
||||
mapAmount f = map pf where
|
||||
pf p = p { pamount = mf (pamount p) }
|
||||
mf = mixed . map f . amounts
|
||||
|
||||
@ -59,7 +59,7 @@ print' opts j = do
|
||||
-- that. For now we try to reverse it by increasing all amounts' decimal places
|
||||
-- sufficiently to show the amount exactly. The displayed amounts may have minor
|
||||
-- differences from the originals, such as trailing zeroes added.
|
||||
let j' = journalMapPostingAmounts amountSetFullPrecision j
|
||||
let j' = journalMapPostingAmounts mixedAmountSetFullPrecision j
|
||||
case maybestringopt "match" $ rawopts_ opts of
|
||||
Nothing -> printEntries opts j'
|
||||
Just desc -> printMatch opts j' $ T.pack $ dbg1 "finding best match for description" desc
|
||||
@ -181,7 +181,7 @@ postingToCSV p =
|
||||
let credit = if q < 0 then showamt $ negate a_ else "" in
|
||||
let debit = if q >= 0 then showamt a_ else "" in
|
||||
[account, amount, c, credit, debit, status, comment])
|
||||
. amounts $ pamount p
|
||||
. amounts $ pamount p
|
||||
where
|
||||
status = T.pack . show $ pstatus p
|
||||
account = showAccountName Nothing (ptype p) (paccount p)
|
||||
|
||||
@ -190,7 +190,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
|
||||
BalancedVirtualPosting -> (wrap "[" "]", acctwidth-2)
|
||||
VirtualPosting -> (wrap "(" ")", acctwidth-2)
|
||||
_ -> (id,acctwidth)
|
||||
amt = showAmountsLinesB dopts . (\x -> if null x then [nullamt] else x) . amounts $ pamount p
|
||||
amt = showAmountsLinesB dopts . (\x -> if null x then [nullamt] else x) . amountsRaw $ pamount p
|
||||
bal = showAmountsLinesB dopts $ amounts b
|
||||
-- Since postingsReport strips prices from all Amounts when not used, we can display prices.
|
||||
dopts = oneLine{displayColour=color_, displayPrice=True}
|
||||
|
||||
@ -82,7 +82,7 @@ showLedgerStats l today span =
|
||||
path = journalFilePath j
|
||||
ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j
|
||||
as = nub $ map paccount $ concatMap tpostings ts
|
||||
cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts -- PARTIAL:
|
||||
cs = either error' Map.keys . commodityStylesFromAmounts . concatMap (amountsRaw . pamount) $ concatMap tpostings ts -- PARTIAL:
|
||||
lastdate | null ts = Nothing
|
||||
| otherwise = Just $ tdate $ last ts
|
||||
lastelapsed = fmap (diffDays today) lastdate
|
||||
|
||||
Loading…
Reference in New Issue
Block a user