13641eab66
Amounts and journal values are often rendered too verbosely in debug output, obscuring what's important. Here we try adjusting the level of detail in the Show instance based on the global debug level. Needs more work.
603 lines
23 KiB
Haskell
603 lines
23 KiB
Haskell
{-# LANGUAGE StandaloneDeriving, RecordWildCards #-}
|
|
{-|
|
|
A simple 'Amount' is some quantity of money, shares, or anything else.
|
|
It has a (possibly null) 'Commodity' and a numeric quantity:
|
|
|
|
@
|
|
$1
|
|
£-50
|
|
EUR 3.44
|
|
GOOG 500
|
|
1.5h
|
|
90 apples
|
|
0
|
|
@
|
|
|
|
It may also have an assigned 'Price', representing this amount's per-unit
|
|
or total cost in a different commodity. If present, this is rendered like
|
|
so:
|
|
|
|
@
|
|
EUR 2 \@ $1.50 (unit price)
|
|
EUR 2 \@\@ $3 (total price)
|
|
@
|
|
|
|
A 'MixedAmount' is zero or more simple amounts, so can represent multiple
|
|
commodities; this is the type most often used:
|
|
|
|
@
|
|
0
|
|
$50 + EUR 3
|
|
16h + $13.55 + AAPL 500 + 6 oranges
|
|
@
|
|
|
|
When a mixed amount has been \"normalised\", it has no more than one amount
|
|
in each commodity and no zero amounts; or it has just a single zero amount
|
|
and no others.
|
|
|
|
Limited arithmetic with simple and mixed amounts is supported, best used
|
|
with similar amounts since it mostly ignores assigned prices and commodity
|
|
exchange rates.
|
|
|
|
-}
|
|
|
|
module Hledger.Data.Amount (
|
|
-- * Amount
|
|
amount,
|
|
nullamt,
|
|
missingamt,
|
|
num,
|
|
usd,
|
|
eur,
|
|
gbp,
|
|
hrs,
|
|
at,
|
|
(@@),
|
|
amountWithCommodity,
|
|
-- ** arithmetic
|
|
costOfAmount,
|
|
divideAmount,
|
|
sumAmounts,
|
|
-- ** rendering
|
|
amountstyle,
|
|
showAmount,
|
|
showAmountDebug,
|
|
showAmountWithoutPrice,
|
|
maxprecision,
|
|
maxprecisionwithpoint,
|
|
setAmountPrecision,
|
|
withPrecision,
|
|
canonicaliseAmount,
|
|
canonicalStyles,
|
|
-- * MixedAmount
|
|
nullmixedamt,
|
|
missingmixedamt,
|
|
mixed,
|
|
amounts,
|
|
normaliseMixedAmountPreservingFirstPrice,
|
|
normaliseMixedAmountPreservingPrices,
|
|
-- ** arithmetic
|
|
costOfMixedAmount,
|
|
divideMixedAmount,
|
|
isNegativeMixedAmount,
|
|
isZeroMixedAmount,
|
|
isReallyZeroMixedAmount,
|
|
isReallyZeroMixedAmountCost,
|
|
-- ** rendering
|
|
showMixedAmount,
|
|
showMixedAmountDebug,
|
|
showMixedAmountWithoutPrice,
|
|
showMixedAmountWithPrecision,
|
|
setMixedAmountPrecision,
|
|
canonicaliseMixedAmount,
|
|
-- * misc.
|
|
ltraceamount,
|
|
tests_Hledger_Data_Amount
|
|
) where
|
|
|
|
import Data.Char (isDigit)
|
|
import Data.List
|
|
import Data.Map (findWithDefault)
|
|
import Data.Ord (comparing)
|
|
import Test.HUnit
|
|
import Text.Printf
|
|
import qualified Data.Map as M
|
|
|
|
import Hledger.Data.Types
|
|
import Hledger.Data.Commodity
|
|
import Hledger.Utils
|
|
|
|
|
|
deriving instance Show HistoricalPrice
|
|
|
|
amountstyle = AmountStyle L False 0 '.' ',' []
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Amount
|
|
|
|
instance Show Amount where
|
|
show _a@Amount{..}
|
|
-- debugLevel < 3 = showAmountWithoutPrice a
|
|
-- debugLevel < 6 = showAmount a
|
|
| debugLevel < 9 =
|
|
printf "Amount {acommodity=%s, aquantity=%s, ..}" (show acommodity) (show aquantity)
|
|
| otherwise = --showAmountDebug a
|
|
printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)
|
|
|
|
instance Num Amount where
|
|
abs a@Amount{aquantity=q} = a{aquantity=abs q}
|
|
signum a@Amount{aquantity=q} = a{aquantity=signum q}
|
|
fromInteger i = nullamt{aquantity=fromInteger i}
|
|
negate a@Amount{aquantity=q} = a{aquantity=(-q)}
|
|
(+) = similarAmountsOp (+)
|
|
(-) = similarAmountsOp (-)
|
|
(*) = similarAmountsOp (*)
|
|
|
|
-- | The empty simple amount.
|
|
amount, nullamt :: Amount
|
|
amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle}
|
|
nullamt = amount
|
|
|
|
-- handy amount constructors for tests
|
|
num n = amount{acommodity="", aquantity=n}
|
|
usd n = amount{acommodity="$", aquantity=n, astyle=amountstyle{asprecision=2}}
|
|
eur n = amount{acommodity="€", aquantity=n, astyle=amountstyle{asprecision=2}}
|
|
gbp n = amount{acommodity="£", aquantity=n, astyle=amountstyle{asprecision=2}}
|
|
hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R}}
|
|
|
|
-- | Apply a binary arithmetic operator to two amounts in the same
|
|
-- commodity. Warning, as a kludge to support folds (eg sum) we assign
|
|
-- the second's commodity to the first so the same commodity requirement
|
|
-- is not checked. The highest precision of either amount is preserved in
|
|
-- the result. Any prices are currently ignored and discarded. The display
|
|
-- style is that of the first amount, with precision set to the highest of
|
|
-- either amount.
|
|
similarAmountsOp :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
|
|
similarAmountsOp op Amount{acommodity=_, aquantity=aq, astyle=AmountStyle{asprecision=ap}}
|
|
Amount{acommodity=bc, aquantity=bq, astyle=bs@AmountStyle{asprecision=bp}} =
|
|
-- trace ("a:"++showAmount a) $ trace ("b:"++showAmount b++"\n") $ tracewith (("=:"++).showAmount)
|
|
amount{acommodity=bc, aquantity=aq `op` bq, astyle=bs{asprecision=max ap bp}}
|
|
-- ac==bc = amount{acommodity=ac, aquantity=aq `op` bq, astyle=as{asprecision=max ap bp}}
|
|
-- otherwise = error "tried to do simple arithmetic with amounts in different commodities"
|
|
|
|
-- | Convert an amount to the specified commodity, ignoring and discarding
|
|
-- any assigned prices and assuming an exchange rate of 1.
|
|
amountWithCommodity :: Commodity -> Amount -> Amount
|
|
amountWithCommodity c a = a{acommodity=c, aprice=NoPrice}
|
|
|
|
-- | A more complete amount adding operation.
|
|
sumAmounts :: [Amount] -> MixedAmount
|
|
sumAmounts = normaliseMixedAmountPreservingPrices . Mixed
|
|
|
|
-- | Set an amount's unit price.
|
|
at :: Amount -> Amount -> Amount
|
|
amt `at` priceamt = amt{aprice=UnitPrice priceamt}
|
|
|
|
-- | Set an amount's total price.
|
|
(@@) :: Amount -> Amount -> Amount
|
|
amt @@ priceamt = amt{aprice=TotalPrice priceamt}
|
|
|
|
tests_sumAmounts = [
|
|
"sumAmounts" ~: do
|
|
-- when adding, we don't convert to the price commodity - just
|
|
-- combine what amounts we can.
|
|
-- amounts with same unit price
|
|
sumAmounts [usd 1 `at` eur 1, usd 1 `at` eur 1] `is` Mixed [usd 2 `at` eur 1]
|
|
-- amounts with different unit prices
|
|
-- amounts with total prices
|
|
sumAmounts [usd 1 @@ eur 1, usd 1 @@ eur 1] `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]
|
|
-- amounts with no, unit, and/or total prices
|
|
]
|
|
|
|
-- | Convert an amount to the commodity of its assigned price, if any. Notes:
|
|
--
|
|
-- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error)
|
|
--
|
|
-- - price amounts should be positive, though this is not currently enforced
|
|
costOfAmount :: Amount -> Amount
|
|
costOfAmount a@Amount{aquantity=q, aprice=price} =
|
|
case price of
|
|
NoPrice -> a
|
|
UnitPrice p@Amount{aquantity=pq} -> p{aquantity=pq * q}
|
|
TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q}
|
|
|
|
-- | Divide an amount's quantity by a constant.
|
|
divideAmount :: Amount -> Double -> Amount
|
|
divideAmount a@Amount{aquantity=q} d = a{aquantity=q/d}
|
|
|
|
-- | Is this amount negative ? The price is ignored.
|
|
isNegativeAmount :: Amount -> Bool
|
|
isNegativeAmount Amount{aquantity=q} = q < 0
|
|
|
|
digits = "123456789" :: String
|
|
|
|
-- | Does this amount appear to be zero when displayed with its given precision ?
|
|
isZeroAmount :: Amount -> Bool
|
|
isZeroAmount a -- a==missingamt = False
|
|
| otherwise = (null . filter (`elem` digits) . showAmountWithoutPriceOrCommodity) a
|
|
|
|
-- | Is this amount "really" zero, regardless of the display precision ?
|
|
-- Since we are using floating point, for now just test to some high precision.
|
|
isReallyZeroAmount :: Amount -> Bool
|
|
isReallyZeroAmount a -- a==missingamt = False
|
|
| otherwise = (null . filter (`elem` digits) . printf ("%."++show zeroprecision++"f") . aquantity) a
|
|
where zeroprecision = 8
|
|
|
|
-- | Get the string representation of an amount, based on its commodity's
|
|
-- display settings except using the specified precision.
|
|
showAmountWithPrecision :: Int -> Amount -> String
|
|
showAmountWithPrecision p = showAmount . setAmountPrecision p
|
|
|
|
-- | Set an amount's display precision.
|
|
setAmountPrecision :: Int -> Amount -> Amount
|
|
setAmountPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}
|
|
|
|
-- | Set an amount's display precision, flipped.
|
|
withPrecision :: Amount -> Int -> Amount
|
|
withPrecision = flip setAmountPrecision
|
|
|
|
-- | Get a string representation of an amount for debugging,
|
|
-- appropriate to the current debug level. 9 shows maximum detail.
|
|
showAmountDebug :: Amount -> String
|
|
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
|
|
showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)
|
|
|
|
-- | Get the string representation of an amount, without any \@ price.
|
|
showAmountWithoutPrice :: Amount -> String
|
|
showAmountWithoutPrice a = showAmount a{aprice=NoPrice}
|
|
|
|
-- | Get the string representation of an amount, without any price or commodity symbol.
|
|
showAmountWithoutPriceOrCommodity :: Amount -> String
|
|
showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice}
|
|
|
|
showPrice :: Price -> String
|
|
showPrice NoPrice = ""
|
|
showPrice (UnitPrice pa) = " @ " ++ showAmount pa
|
|
showPrice (TotalPrice pa) = " @@ " ++ showAmount pa
|
|
|
|
showPriceDebug :: Price -> String
|
|
showPriceDebug NoPrice = ""
|
|
showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa
|
|
showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa
|
|
|
|
-- | Get the string representation of an amount, based on its commodity's
|
|
-- display settings. String representations equivalent to zero are
|
|
-- converted to just \"0\".
|
|
showAmount :: Amount -> String
|
|
showAmount Amount{acommodity="AUTO"} = ""
|
|
showAmount a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) =
|
|
case ascommodityside of
|
|
L -> printf "%s%s%s%s" c' space quantity' price
|
|
R -> printf "%s%s%s%s" quantity' space c' price
|
|
where
|
|
quantity = showamountquantity a
|
|
displayingzero = null $ filter (`elem` digits) $ quantity
|
|
(quantity',c') | displayingzero = ("0","")
|
|
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
|
|
space = if (not (null c') && ascommodityspaced) then " " else "" :: String
|
|
price = showPrice p
|
|
|
|
-- | Get the string representation of the number part of of an amount,
|
|
-- using the display settings from its commodity.
|
|
showamountquantity :: Amount -> String
|
|
showamountquantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p, asdecimalpoint=d, asseparator=s, asseparatorpositions=spos}} =
|
|
punctuatenumber d s spos $ qstr
|
|
where
|
|
-- isint n = fromIntegral (round n) == n
|
|
qstr -- p == maxprecision && isint q = printf "%d" (round q::Integer)
|
|
| p == maxprecisionwithpoint = printf "%f" q
|
|
| p == maxprecision = chopdotzero $ printf "%f" q
|
|
| otherwise = printf ("%."++show p++"f") q
|
|
|
|
-- | Replace a number string's decimal point with the specified character,
|
|
-- and add the specified digit group separators. The last digit group will
|
|
-- be repeated as needed.
|
|
punctuatenumber :: Char -> Char -> [Int] -> String -> String
|
|
punctuatenumber dec sep grps str = sign ++ reverse (addseps sep (extend grps) (reverse int)) ++ frac''
|
|
where
|
|
(sign,num) = break isDigit str
|
|
(int,frac) = break (=='.') num
|
|
frac' = dropWhile (=='.') frac
|
|
frac'' | null frac' = ""
|
|
| otherwise = dec:frac'
|
|
extend [] = []
|
|
extend gs = init gs ++ repeat (last gs)
|
|
addseps _ [] str = str
|
|
addseps sep (g:gs) str
|
|
| length str <= g = str
|
|
| otherwise = let (s,rest) = splitAt g str
|
|
in s ++ [sep] ++ addseps sep gs rest
|
|
|
|
chopdotzero str = reverse $ case reverse str of
|
|
'0':'.':s -> s
|
|
s -> s
|
|
|
|
-- | For rendering: a special precision value which means show all available digits.
|
|
maxprecision :: Int
|
|
maxprecision = 999998
|
|
|
|
-- | For rendering: a special precision value which forces display of a decimal point.
|
|
maxprecisionwithpoint :: Int
|
|
maxprecisionwithpoint = 999999
|
|
|
|
-- like journalCanonicaliseAmounts
|
|
-- | Canonicalise an amount's display style using the provided commodity style map.
|
|
canonicaliseAmount :: M.Map Commodity AmountStyle -> Amount -> Amount
|
|
canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
|
|
where
|
|
s' = findWithDefault s c styles
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- MixedAmount
|
|
|
|
instance Show MixedAmount where
|
|
show
|
|
-- debugLevel < 3 = intercalate "\\n" . lines . showMixedAmountWithoutPrice
|
|
-- debugLevel < 6 = intercalate "\\n" . lines . showMixedAmount
|
|
| otherwise = showMixedAmountDebug
|
|
|
|
instance Num MixedAmount where
|
|
fromInteger i = Mixed [fromInteger i]
|
|
negate (Mixed as) = Mixed $ map negate as
|
|
(+) (Mixed as) (Mixed bs) = normaliseMixedAmountPreservingPrices $ Mixed $ as ++ bs
|
|
(*) = error' "programming error, mixed amounts do not support multiplication"
|
|
abs = error' "programming error, mixed amounts do not support abs"
|
|
signum = error' "programming error, mixed amounts do not support signum"
|
|
|
|
-- | The empty mixed amount.
|
|
nullmixedamt :: MixedAmount
|
|
nullmixedamt = Mixed []
|
|
|
|
-- | A temporary value for parsed transactions which had no amount specified.
|
|
missingamt :: Amount
|
|
missingamt = amount{acommodity="AUTO"}
|
|
|
|
missingmixedamt :: MixedAmount
|
|
missingmixedamt = Mixed [missingamt]
|
|
|
|
mixed :: Amount -> MixedAmount
|
|
mixed a = Mixed [a]
|
|
|
|
-- | Simplify a mixed amount's component amounts: we can combine amounts
|
|
-- with the same commodity and unit price. Also remove any zero or missing
|
|
-- amounts and replace an empty amount list with a single zero amount.
|
|
normaliseMixedAmountPreservingPrices :: MixedAmount -> MixedAmount
|
|
normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as''
|
|
where
|
|
as'' = if null nonzeros then [nullamt] else nonzeros
|
|
(_,nonzeros) = partition isReallyZeroAmount as'
|
|
as' = map sumAmountsUsingFirstPrice $ group $ sort $ filter (/= missingamt) as
|
|
sort = sortBy (\a1 a2 -> compare (acommodity a1, aprice a1) (acommodity a2, aprice a2))
|
|
group = groupBy (\a1 a2 -> acommodity a1 == acommodity a2 && sameunitprice a1 a2)
|
|
where
|
|
sameunitprice a1 a2 =
|
|
case (aprice a1, aprice a2) of
|
|
(NoPrice, NoPrice) -> True
|
|
(UnitPrice p1, UnitPrice p2) -> p1 == p2
|
|
_ -> False
|
|
|
|
tests_normaliseMixedAmountPreservingPrices = [
|
|
"normaliseMixedAmountPreservingPrices" ~: do
|
|
assertEqual "discard missing amount" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [usd 0, missingamt])
|
|
assertEqual "combine unpriced same-commodity amounts" (Mixed [usd 2]) (normaliseMixedAmountPreservingPrices $ Mixed [usd 0, usd 2])
|
|
assertEqual "don't combine total-priced amounts"
|
|
(Mixed
|
|
[usd 1 @@ eur 1
|
|
,usd (-2) @@ eur 1
|
|
])
|
|
(normaliseMixedAmountPreservingPrices $ Mixed
|
|
[usd 1 @@ eur 1
|
|
,usd (-2) @@ eur 1
|
|
])
|
|
|
|
]
|
|
|
|
-- | Simplify a mixed amount's component amounts: combine amounts with
|
|
-- the same commodity, using the first amount's price for subsequent
|
|
-- amounts in each commodity (ie, this function alters the amount and
|
|
-- is best used as a rendering helper.). Also remove any zero amounts
|
|
-- and replace an empty amount list with a single zero amount.
|
|
normaliseMixedAmountPreservingFirstPrice :: MixedAmount -> MixedAmount
|
|
normaliseMixedAmountPreservingFirstPrice (Mixed as) = Mixed as''
|
|
where
|
|
as'' = if null nonzeros then [nullamt] else nonzeros
|
|
(_,nonzeros) = partition (\a -> isReallyZeroAmount a && a /= missingamt) as'
|
|
as' = map sumAmountsUsingFirstPrice $ group $ sort as
|
|
sort = sortBy (\a1 a2 -> compare (acommodity a1) (acommodity a2))
|
|
group = groupBy (\a1 a2 -> acommodity a1 == acommodity a2)
|
|
|
|
-- discardPrice :: Amount -> Amount
|
|
-- discardPrice a = a{price=Nothing}
|
|
|
|
-- discardPrices :: MixedAmount -> MixedAmount
|
|
-- discardPrices (Mixed as) = Mixed $ map discardPrice as
|
|
|
|
sumAmountsUsingFirstPrice [] = nullamt
|
|
sumAmountsUsingFirstPrice as = (sum as){aprice=aprice $ head as}
|
|
|
|
-- | Get a mixed amount's component amounts.
|
|
amounts :: MixedAmount -> [Amount]
|
|
amounts (Mixed as) = as
|
|
|
|
-- | Convert a mixed amount's component amounts to the commodity of their
|
|
-- assigned price, if any.
|
|
costOfMixedAmount :: MixedAmount -> MixedAmount
|
|
costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as
|
|
|
|
-- | Divide a mixed amount's quantities by a constant.
|
|
divideMixedAmount :: MixedAmount -> Double -> MixedAmount
|
|
divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as
|
|
|
|
-- | Is this mixed amount negative, if it can be normalised to a single commodity ?
|
|
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
|
|
isNegativeMixedAmount m = case as of [a] -> Just $ isNegativeAmount a
|
|
_ -> Nothing
|
|
where as = amounts $ normaliseMixedAmountPreservingFirstPrice m
|
|
|
|
-- | Does this mixed amount appear to be zero when displayed with its given precision ?
|
|
isZeroMixedAmount :: MixedAmount -> Bool
|
|
isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmountPreservingFirstPrice
|
|
|
|
-- | Is this mixed amount "really" zero ? See isReallyZeroAmount.
|
|
isReallyZeroMixedAmount :: MixedAmount -> Bool
|
|
isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmountPreservingFirstPrice
|
|
|
|
-- | Is this mixed amount "really" zero, after converting to cost
|
|
-- commodities where possible ?
|
|
isReallyZeroMixedAmountCost :: MixedAmount -> Bool
|
|
isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount
|
|
|
|
-- -- | 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.
|
|
-- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool
|
|
-- mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b')
|
|
-- where a' = normaliseMixedAmountPreservingFirstPrice a
|
|
-- b' = normaliseMixedAmountPreservingFirstPrice b
|
|
|
|
-- | Get the string representation of a mixed amount, showing each of
|
|
-- its component amounts. NB a mixed amount can have an empty amounts
|
|
-- list in which case it shows as \"\".
|
|
showMixedAmount :: MixedAmount -> String
|
|
showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m
|
|
|
|
-- | Compact labelled trace of a mixed amount, for debugging.
|
|
ltraceamount :: String -> MixedAmount -> MixedAmount
|
|
ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)
|
|
|
|
-- | Set the display precision in the amount's commodities.
|
|
setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount
|
|
setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as
|
|
|
|
-- | Get the string representation of a mixed amount, showing each of its
|
|
-- component amounts with the specified precision, ignoring their
|
|
-- commoditys' display precision settings.
|
|
showMixedAmountWithPrecision :: Int -> MixedAmount -> String
|
|
showMixedAmountWithPrecision p m =
|
|
vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountPreservingFirstPrice m
|
|
|
|
-- | Get an unambiguous string representation of a mixed amount for debugging.
|
|
showMixedAmountDebug :: MixedAmount -> String
|
|
showMixedAmountDebug m | m == missingmixedamt = "(missing)"
|
|
| otherwise = printf "Mixed [%s]" as
|
|
where as = intercalate "\n " $ map showAmountDebug $ amounts m -- normaliseMixedAmountPreservingFirstPrice m
|
|
|
|
-- | Get the string representation of a mixed amount, but without
|
|
-- any \@ prices.
|
|
showMixedAmountWithoutPrice :: MixedAmount -> String
|
|
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
|
|
where
|
|
(Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m
|
|
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice}
|
|
width = maximum $ map (length . showAmount) as
|
|
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
|
|
|
|
-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
|
|
canonicaliseMixedAmount :: M.Map Commodity AmountStyle -> MixedAmount -> MixedAmount
|
|
canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
|
|
|
|
-- | Given a list of amounts in parse order, build a map from commodities
|
|
-- to canonical display styles for amounts in that commodity.
|
|
canonicalStyles :: [Amount] -> M.Map Commodity AmountStyle
|
|
canonicalStyles amts = M.fromList commstyles
|
|
where
|
|
samecomm = \a1 a2 -> acommodity a1 == acommodity a2
|
|
commamts = [(acommodity $ head as, as) | as <- groupBy samecomm $ sortBy (comparing acommodity) amts]
|
|
commstyles = [(c, s)
|
|
| (c,as) <- commamts
|
|
, let styles = map astyle as
|
|
, let maxprec = maximum $ map asprecision styles
|
|
, let s = (head styles){asprecision=maxprec}
|
|
]
|
|
|
|
-- lookupStyle :: M.Map Commodity AmountStyle -> Commodity -> AmountStyle
|
|
-- lookupStyle
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- misc
|
|
|
|
tests_Hledger_Data_Amount = TestList $
|
|
tests_normaliseMixedAmountPreservingPrices
|
|
++ tests_sumAmounts
|
|
++ [
|
|
|
|
-- Amount
|
|
|
|
"costOfAmount" ~: do
|
|
costOfAmount (eur 1) `is` eur 1
|
|
costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4
|
|
costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2
|
|
costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2)
|
|
|
|
,"isZeroAmount" ~: do
|
|
assertBool "" $ isZeroAmount $ amount
|
|
assertBool "" $ isZeroAmount $ usd 0
|
|
|
|
,"negating amounts" ~: do
|
|
let a = usd 1
|
|
negate a `is` a{aquantity=(-1)}
|
|
let b = (usd 1){aprice=UnitPrice $ eur 2}
|
|
negate b `is` b{aquantity=(-1)}
|
|
|
|
,"adding amounts without prices" ~: do
|
|
let a1 = usd 1.23
|
|
let a2 = usd (-1.23)
|
|
let a3 = usd (-1.23)
|
|
(a1 + a2) `is` usd 0
|
|
(a1 + a3) `is` usd 0
|
|
(a2 + a3) `is` usd (-2.46)
|
|
(a3 + a3) `is` usd (-2.46)
|
|
sum [a1,a2,a3,-a3] `is` usd 0
|
|
-- highest precision is preserved
|
|
let ap1 = usd 1 `withPrecision` 1
|
|
ap3 = usd 1 `withPrecision` 3
|
|
(asprecision $ astyle $ sum [ap1,ap3]) `is` 3
|
|
(asprecision $ astyle $ sum [ap3,ap1]) `is` 3
|
|
-- adding different commodities assumes conversion rate 1
|
|
assertBool "" $ isZeroAmount (a1 - eur 1.23)
|
|
|
|
,"showAmount" ~: do
|
|
showAmount (usd 0 + gbp 0) `is` "0"
|
|
|
|
-- MixedAmount
|
|
|
|
,"normaliseMixedAmountPreservingFirstPrice" ~: do
|
|
normaliseMixedAmountPreservingFirstPrice (Mixed []) `is` Mixed [nullamt]
|
|
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountPreservingFirstPrice
|
|
(Mixed [usd 10
|
|
,usd 10 @@ eur 7
|
|
,usd (-10)
|
|
,usd (-10) @@ eur 7
|
|
])
|
|
|
|
,"adding mixed amounts" ~: do
|
|
(sum $ map (Mixed . (\a -> [a]))
|
|
[usd 1.25
|
|
,usd (-1) `withPrecision` 0
|
|
,usd (-0.25)
|
|
])
|
|
`is` Mixed [amount{aquantity=0}]
|
|
|
|
,"adding mixed amounts with total prices" ~: do
|
|
(sum $ map (Mixed . (\a -> [a]))
|
|
[usd 1 @@ eur 1
|
|
,usd (-2) @@ eur 1
|
|
])
|
|
`is` (Mixed [usd 1 @@ eur 1
|
|
,usd (-2) @@ eur 1
|
|
])
|
|
|
|
,"showMixedAmount" ~: do
|
|
showMixedAmount (Mixed [usd 1]) `is` "$1.00"
|
|
showMixedAmount (Mixed [usd 1 `at` eur 2]) `is` "$1.00 @ €2.00"
|
|
showMixedAmount (Mixed [usd 0]) `is` "0"
|
|
showMixedAmount (Mixed []) `is` "0"
|
|
showMixedAmount missingmixedamt `is` ""
|
|
|
|
,"showMixedAmountWithoutPrice" ~: do
|
|
let a = usd 1 `at` eur 2
|
|
showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00"
|
|
showMixedAmountWithoutPrice (Mixed [a, (-a)]) `is` "0"
|
|
|
|
]
|