{-# LANGUAGE StandaloneDeriving #-} {-| 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 unit price, which is another (unpriced) simple amount in a different commodity. If present, this is rendered like so: @ EUR 3 \@ $1.35 @ 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. We can do two kinds of limited arithmetic with simple or mixed amounts: price-preserving (for amounts with the same prices) or price-ignoring (ignores and discards any prices). -} -- XXX due for review/rewrite module Hledger.Data.Amount ( -- * Amount nullamt, canonicaliseAmountCommodity, setAmountPrecision, -- ** arithmetic costOfAmount, divideAmount, -- ** rendering showAmount, showAmountDebug, showAmountWithoutPrice, maxprecision, maxprecisionwithpoint, -- * MixedAmount nullmixedamt, missingamt, amounts, normaliseMixedAmount, canonicaliseMixedAmountCommodity, setMixedAmountPrecision, -- ** arithmetic costOfMixedAmount, divideMixedAmount, isNegativeMixedAmount, isZeroMixedAmount, isReallyZeroMixedAmountCost, sumMixedAmountsPreservingHighestPrecision, -- ** rendering showMixedAmount, showMixedAmountDebug, showMixedAmountOrZero, showMixedAmountOrZeroWithoutPrice, showMixedAmountWithoutPrice, showMixedAmountWithPrecision, -- * misc. tests_Hledger_Data_Amount ) where import Data.Char (isDigit) import Data.List import Data.Map (findWithDefault) import Data.Ord import Test.HUnit import Text.Printf import qualified Data.Map as Map import Hledger.Data.Types import Hledger.Data.Commodity import Hledger.Utils instance Show Amount where show = showAmount instance Show MixedAmount where show = showMixedAmount deriving instance Show HistoricalPrice instance Num Amount where abs (Amount c q p) = Amount c (abs q) p signum (Amount c q p) = Amount c (signum q) p fromInteger i = Amount (comm "") (fromInteger i) Nothing (+) = similarAmountsOp (+) (-) = similarAmountsOp (-) (*) = similarAmountsOp (*) instance Num MixedAmount where fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as where negateAmountPreservingPrice a = (-a){price=price a} (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs -- (+) (Mixed as) (Mixed bs) = normaliseMixedAmountPreservingHighestPrecision $ 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" -- | Apply a binary arithmetic operator to two amounts, after converting -- the first to the commodity (and display precision) of the second in a -- simplistic way. This should be used only for two amounts in the same -- commodity, since the conversion rate is assumed to be 1. -- NB preserving the second commodity is preferred since sum and other -- folds start with the no-commodity zero amount. similarAmountsOp :: (Double -> Double -> Double) -> Amount -> Amount -> Amount similarAmountsOp op a (Amount bc bq _) = Amount bc (quantity (convertAmountToSimilarCommodity bc a) `op` bq) Nothing -- | Convert an amount to the specified commodity, assuming an exchange rate of 1. convertAmountToSimilarCommodity :: Commodity -> Amount -> Amount convertAmountToSimilarCommodity c (Amount _ q _) = Amount c q Nothing -- -- | Convert a mixed amount to the specified commodity, assuming an exchange rate of 1. -- convertMixedAmountToSimilarCommodity :: Commodity -> MixedAmount -> Amount -- convertMixedAmountToSimilarCommodity c (Mixed as) = Amount c total Nothing -- where -- total = sum $ map (quantity . convertAmountToSimilarCommodity c) as -- | 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 _ q price) = case price of Nothing -> a Just (UnitPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*q) Nothing Just (TotalPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*signum q) Nothing _ -> error' "costOfAmount: Malformed price encountered, programmer error" -- | 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 the display precision in the amount's commodity. setAmountPrecision :: Int -> Amount -> Amount setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}} -- XXX refactor -- | Get the unambiguous string representation of an amount, for debugging. showAmountDebug :: Amount -> String showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}" (show c) (show q) (maybe "" showPriceDebug pri) -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice a = showAmount a{price=Nothing} -- | Get the string representation of an amount, without any price or commodity symbol. showAmountWithoutPriceOrCommodity :: Amount -> String showAmountWithoutPriceOrCommodity a@Amount{commodity=c} = showAmount a{commodity=c{symbol=""}, price=Nothing} showPrice :: Price -> String showPrice (UnitPrice pa) = " @ " ++ showMixedAmount pa showPrice (TotalPrice pa) = " @@ " ++ showMixedAmount pa showPriceDebug :: Price -> String showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa -- | Get the string representation of an amount, based on its commodity's -- display settings. Amounts which look like zero are rendered without sign or commodity. showAmount :: Amount -> String showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) = case side of L -> printf "%s%s%s%s" sym' space quantity' price R -> printf "%s%s%s%s" quantity' space sym' price where quantity = showamountquantity a displayingzero = null $ filter (`elem` "123456789") $ quantity (quantity',sym') | displayingzero = ("0","") | otherwise = (quantity,quoteCommoditySymbolIfNeeded sym) space = if (not (null sym') && spaced) then " " else "" price = maybe "" showPrice pri -- | Get the string representation of the number part of of an amount, -- using the display settings from its commodity. showamountquantity :: Amount -> String showamountquantity (Amount (Commodity {decimalpoint=d,precision=p,separator=s,separatorpositions=spos}) q _) = 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 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 -- | Replace a number string's decimal point with the specified character, -- and add the specified digit group separators. 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 -- | Add thousands-separating commas to a decimal number string punctuatethousands :: String -> String punctuatethousands s = sign ++ addcommas int ++ frac where (sign,num) = break isDigit s (int,frac) = break (=='.') num addcommas = reverse . concat . intersperse "," . triples . reverse triples [] = [] triples l = take 3 l : triples (drop 3 l) -- | Does this amount appear to be zero when displayed with its given precision ? isZeroAmount :: Amount -> Bool isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity -- | 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 = null . filter (`elem` "123456789") . printf ("%."++show zeroprecision++"f") . quantity where zeroprecision = 8 -- | Is this amount negative ? The price is ignored. isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{quantity=q} = q < 0 -- | Get a mixed amount's component amounts. amounts :: MixedAmount -> [Amount] amounts (Mixed as) = as -- | Does this mixed amount appear to be zero when displayed with its given precision ? isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount -- | Is this mixed amount "really" zero ? See isReallyZeroAmount. isReallyZeroMixedAmount :: MixedAmount -> Bool isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount -- | 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 $ normaliseMixedAmount m -- | Is this mixed amount "really" zero, after converting to cost -- commodities where possible ? isReallyZeroMixedAmountCost :: MixedAmount -> Bool isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount -- -- | MixedAmount derives Eq in Types.hs, but that doesn't know that we -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code in there. -- -- When zero equality is important, use this, for now; should be used -- -- everywhere. -- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool -- mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b') -- where a' = normaliseMixedAmount a -- b' = normaliseMixedAmount 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 show $ amounts $ normaliseMixedAmount m -- | 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. NB a mixed amount can have an -- empty amounts list in which case it shows as \"\". showMixedAmountWithPrecision :: Int -> MixedAmount -> String showMixedAmountWithPrecision p m = vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmount m -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String showMixedAmountDebug m = printf "Mixed [%s]" as where as = intercalate "\n " $ map showAmountDebug $ amounts $ normaliseMixedAmount 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) = normaliseMixedAmountIgnoringPrice m width = maximum $ map (length . show) as showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice -- | Get the string representation of a mixed amount, and if it -- appears to be all zero just show a bare 0, ledger-style. showMixedAmountOrZero :: MixedAmount -> String showMixedAmountOrZero a | a == missingamt = "" | isZeroMixedAmount a = "0" | otherwise = showMixedAmount a -- | Get the string representation of a mixed amount, or a bare 0, -- without any \@ prices. showMixedAmountOrZeroWithoutPrice :: MixedAmount -> String showMixedAmountOrZeroWithoutPrice a | isZeroMixedAmount a = "0" | otherwise = showMixedAmountWithoutPrice a -- | Simplify a mixed amount by removing redundancy in its component amounts, as follows: -- -- 1. combine amounts which have the same commodity, discarding all but the first's price. -- -- 2. remove zero amounts -- -- 3. if there are no amounts at all, add a single zero amount normaliseMixedAmount :: MixedAmount -> MixedAmount normaliseMixedAmount (Mixed as) = Mixed as'' where as'' = if null nonzeros then [nullamt] else nonzeros (_,nonzeros) = partition (\a -> isReallyZeroAmount a && Mixed [a] /= missingamt) as' as' = map sumSamePricedAmountsPreservingPrice $ group $ sort as sort = sortBy (\a1 a2 -> compare (sym a1) (sym a2)) group = groupBy (\a1 a2 -> sym a1 == sym a2) sym = symbol . commodity -- | Replace a mixed amount's commodity with the canonicalised version from -- the provided commodity map. canonicaliseMixedAmountCommodity :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map (canonicaliseAmountCommodity canonicalcommoditymap) as -- | Replace an amount's commodity with the canonicalised version from -- the provided commodity map. canonicaliseAmountCommodity :: Maybe (Map.Map String Commodity) -> Amount -> Amount canonicaliseAmountCommodity Nothing = id canonicaliseAmountCommodity (Just canonicalcommoditymap) = fixamount where -- like journalCanonicaliseAmounts fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c} fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap -- various sum variants.. sumAmountsDiscardingPrice [] = nullamt sumAmountsDiscardingPrice as = (sum as){price=Nothing} sumSamePricedAmountsPreservingPrice [] = nullamt sumSamePricedAmountsPreservingPrice as = (sum as){price=price $ head as} -- | Simplify a mixed amount by combining any component amounts which have -- the same commodity, ignoring and discarding their unit prices if any. -- Also removes zero amounts, or adds a single zero amount if there are no -- amounts at all. normaliseMixedAmountIgnoringPrice :: MixedAmount -> MixedAmount normaliseMixedAmountIgnoringPrice (Mixed as) = Mixed as'' where as'' = map sumAmountsDiscardingPrice $ group $ sort as' group = groupBy (same amountSymbol) sort = sortBy (comparing amountSymbol) as' | null nonzeros = [head $ zeros ++ [nullamt]] | otherwise = nonzeros where (zeros,nonzeros) = partition isZeroAmount as -- | Simplify a mixed amount by combining any component amounts which have -- the same commodity, ignoring and discarding their unit prices if any. -- Also removes zero amounts, or adds a single zero amount if there are no -- amounts at all. normaliseMixedAmountPreservingHighestPrecision :: MixedAmount -> MixedAmount normaliseMixedAmountPreservingHighestPrecision (Mixed as) = Mixed as'' where as'' = map sumSamePricedAmountsPreservingPriceAndHighestPrecision $ group $ sort as' group = groupBy (same amountSymbolAndPrice) sort = sortBy (comparing amountSymbolAndPrice) as' | null nonzeros = [head $ zeros ++ [nullamt]] | otherwise = nonzeros (zeros,nonzeros) = partition isReallyZeroAmount as same f a b = f a == f b amountSymbol :: Amount -> String amountSymbol = symbol . commodity amountSymbolAndPrice :: Amount -> (String, Maybe Price) amountSymbolAndPrice a = (amountSymbol a, price a) -- | Add these mixed amounts, preserving prices and preserving the highest -- precision in each commodity. sumMixedAmountsPreservingHighestPrecision :: [MixedAmount] -> MixedAmount sumMixedAmountsPreservingHighestPrecision ms = foldl' (+~) 0 ms where (+~) (Mixed as) (Mixed bs) = normaliseMixedAmountPreservingHighestPrecision $ Mixed $ as ++ bs sumSamePricedAmountsPreservingPriceAndHighestPrecision [] = nullamt sumSamePricedAmountsPreservingPriceAndHighestPrecision as = (sumAmountsPreservingHighestPrecision as){price=price $ head as} sumAmountsPreservingHighestPrecision :: [Amount] -> Amount sumAmountsPreservingHighestPrecision as = foldl' (+~) 0 as where (+~) = amountopPreservingHighestPrecision (+) amountopPreservingHighestPrecision :: (Double -> Double -> Double) -> Amount -> Amount -> Amount amountopPreservingHighestPrecision op a@(Amount ac@Commodity{precision=ap} _ _) (Amount bc@Commodity{precision=bp} bq _) = Amount c q Nothing where q = quantity (convertAmountToSimilarCommodity bc a) `op` bq c = if ap > bp then ac else bc -- -- | 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 -- | Divide an amount's quantity by a constant. divideAmount :: Amount -> Double -> Amount divideAmount a@Amount{quantity=q} d = a{quantity=q/d} -- | The empty simple amount. nullamt :: Amount nullamt = Amount unknown 0 Nothing -- | The empty mixed amount. nullmixedamt :: MixedAmount nullmixedamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. missingamt :: MixedAmount missingamt = Mixed [Amount unknown{symbol="AUTO"} 0 Nothing] tests_Hledger_Data_Amount = TestList [ -- amounts "costOfAmount" ~: do costOfAmount (euros 1) `is` euros 1 costOfAmount (euros 2){price=Just $ UnitPrice $ Mixed [dollars 2]} `is` dollars 4 costOfAmount (euros 1){price=Just $ TotalPrice $ Mixed [dollars 2]} `is` dollars 2 costOfAmount (euros (-1)){price=Just $ TotalPrice $ Mixed [dollars 2]} `is` dollars (-2) ,"isZeroAmount" ~: do assertBool "" $ isZeroAmount $ Amount unknown 0 Nothing assertBool "" $ isZeroAmount $ dollars 0 ,"negating amounts" ~: do let a = dollars 1 negate a `is` a{quantity=(-1)} let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} negate b `is` b{quantity=(-1)} -- XXX failing ,"adding amounts" ~: do let a1 = dollars 1.23 let a2 = dollars (-1.23) let a3 = dollars (-1.23) (a1 + a2) `is` Amount (comm "$") 0 Nothing (a1 + a3) `is` Amount (comm "$") 0 Nothing (a2 + a3) `is` Amount (comm "$") (-2.46) Nothing (a3 + a3) `is` Amount (comm "$") (-2.46) Nothing sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing -- highest precision is preserved (sum [Amount dollar 1.25 Nothing, Amount dollar{precision=0} (-1) Nothing, Amount dollar{precision=3} (-0.25) Nothing]) `is` (Amount dollar{precision=3} 0 Nothing) -- adding different commodities assumes conversion rate 1 assertBool "" $ isZeroAmount (a1 - euros 1.23) ,"showAmount" ~: do showAmount (dollars 0 + pounds 0) `is` "0" -- mixed amounts ,"normaliseMixedAmount" ~: do normaliseMixedAmount (Mixed []) `is` Mixed [nullamt] assertBool "" $ isZeroMixedAmount $ normaliseMixedAmount (Mixed [Amount {commodity=dollar, quantity=10, price=Nothing} ,Amount {commodity=dollar, quantity=10, price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))} ,Amount {commodity=dollar, quantity=(-10), price=Nothing} ,Amount {commodity=dollar, quantity=(-10), price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))} ]) ,"normaliseMixedAmountIgnoringPrice" ~: do normaliseMixedAmountIgnoringPrice (Mixed []) `is` Mixed [nullamt] (commodity (head (amounts (normaliseMixedAmountIgnoringPrice (Mixed [Amount {commodity=dollar, quantity=10, price=Nothing} ,Amount {commodity=dollar, quantity=10, price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))} ,Amount {commodity=dollar, quantity=(-10), price=Nothing} ,Amount {commodity=dollar, quantity=(-10), price=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))} ]))))) `is` unknown -- XXX failing ,"adding mixed amounts" ~: do let dollar0 = dollar{precision=0} (sum $ map (Mixed . (\a -> [a])) [Amount dollar 1.25 Nothing, Amount dollar0 (-1) Nothing, Amount dollar (-0.25) Nothing]) `is` Mixed [Amount unknown 0 Nothing] ,"showMixedAmount" ~: do showMixedAmount (Mixed [Amount dollar 0 Nothing]) `is` "0" showMixedAmount (Mixed []) `is` "0" showMixedAmount missingamt `is` "" ,"showMixedAmountOrZero" ~: do showMixedAmountOrZero (Mixed [Amount dollar 0 Nothing]) `is` "0" showMixedAmountOrZero (Mixed []) `is` "0" showMixedAmountOrZero missingamt `is` "" ,"punctuatethousands" ~: do punctuatethousands "" `is` "" punctuatethousands "1234567.8901" `is` "1,234,567.8901" punctuatethousands "-100" `is` "-100" ]