slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simplify amounts code, make tests pass

Browse Source
This commit is contained in:
Simon Michael 2011-08-31 16:54:10 +00:00
parent 1273f02a9a
commit 10fd7ebc42
3 changed files with 185 additions and 255 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

436
hledger-lib/Hledger/Data/Amount.hs
View File

@ -42,47 +42,46 @@ price-preserving (for amounts with the same prices) or price-ignoring
-- XXX due for review/rewrite -- XXX due for review/rewrite
module Hledger.Data.Amount ( module Hledger.Data.Amount (
-- * Amount -- * Amount
nullamt, nullamt,
canonicaliseAmountCommodity, canonicaliseAmountCommodity,
setAmountPrecision, setAmountPrecision,
-- ** arithmetic -- ** arithmetic
costOfAmount, costOfAmount,
divideAmount, divideAmount,
-- ** rendering -- ** rendering
showAmount, showAmount,
showAmountDebug, showAmountDebug,
showAmountWithoutPrice, showAmountWithoutPrice,
maxprecision, maxprecision,
maxprecisionwithpoint, maxprecisionwithpoint,
-- * MixedAmount -- * MixedAmount
nullmixedamt, nullmixedamt,
missingamt, missingamt,
amounts, amounts,
normaliseMixedAmount, normaliseMixedAmount,
canonicaliseMixedAmountCommodity, canonicaliseMixedAmountCommodity,
setMixedAmountPrecision, setMixedAmountPrecision,
-- ** arithmetic -- ** arithmetic
costOfMixedAmount, costOfMixedAmount,
divideMixedAmount, divideMixedAmount,
isNegativeMixedAmount, isNegativeMixedAmount,
isZeroMixedAmount, isZeroMixedAmount,
isReallyZeroMixedAmountCost, isReallyZeroMixedAmountCost,
sumMixedAmountsPreservingHighestPrecision, -- ** rendering
-- ** rendering showMixedAmount,
showMixedAmount, showMixedAmountDebug,
showMixedAmountDebug, showMixedAmountOrZero,
showMixedAmountOrZero, showMixedAmountOrZeroWithoutPrice,
showMixedAmountOrZeroWithoutPrice, showMixedAmountWithoutPrice,
showMixedAmountWithoutPrice, showMixedAmountWithPrecision,
showMixedAmountWithPrecision, -- * misc.
-- * misc. tests_Hledger_Data_Amount
tests_Hledger_Data_Amount ) where
) where
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.List import Data.List
import Data.Map (findWithDefault) import Data.Map (findWithDefault)
import Data.Ord
import Test.HUnit import Test.HUnit
import Text.Printf import Text.Printf
import qualified Data.Map as Map import qualified Data.Map as Map
@ -92,47 +91,38 @@ import Hledger.Data.Commodity
import Hledger.Utils import Hledger.Utils
instance Show Amount where show = showAmount
instance Show MixedAmount where show = showMixedAmount
deriving instance Show HistoricalPrice deriving instance Show HistoricalPrice
-------------------------------------------------------------------------------
-- Amount
instance Show Amount where show = showAmount
instance Num Amount where instance Num Amount where
abs (Amount c q p) = Amount c (abs q) p abs (Amount c q p) = Amount c (abs q) p
signum (Amount c q p) = Amount c (signum q) p signum (Amount c q p) = Amount c (signum q) p
fromInteger i = Amount (comm "") (fromInteger i) Nothing fromInteger i = Amount (comm "") (fromInteger i) Nothing
negate a@Amount{quantity=q} = a{quantity=(-q)}
(+) = similarAmountsOp (+) (+) = similarAmountsOp (+)
(-) = similarAmountsOp (-) (-) = similarAmountsOp (-)
(*) = similarAmountsOp (*) (*) = similarAmountsOp (*)
instance Num MixedAmount where -- | The empty simple amount.
fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] nullamt :: Amount
negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as nullamt = Amount unknown 0 Nothing
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 -- | Apply a binary arithmetic operator to two amounts, ignoring and
-- the first to the commodity (and display precision) of the second in a -- discarding any assigned prices, and converting the first to the
-- simplistic way. This should be used only for two amounts in the same -- commodity of the second in a simplistic way (1-1 exchange rate).
-- commodity, since the conversion rate is assumed to be 1. -- The highest precision of either amount is preserved in the result.
-- 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 :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
similarAmountsOp op a (Amount bc bq _) = similarAmountsOp op a@(Amount Commodity{precision=ap} _ _) (Amount bc@Commodity{precision=bp} bq _) =
Amount bc (quantity (convertAmountToSimilarCommodity bc a) `op` bq) Nothing Amount bc{precision=max ap bp} (quantity (convertAmountToCommodity bc a) `op` bq) Nothing
-- | Convert an amount to the specified commodity, assuming an exchange rate of 1. -- | Convert an amount to the specified commodity, ignoring and discarding
convertAmountToSimilarCommodity :: Commodity -> Amount -> Amount -- any assigned prices and assuming an exchange rate of 1.
convertAmountToSimilarCommodity c (Amount _ q _) = Amount c q Nothing convertAmountToCommodity :: Commodity -> Amount -> Amount
convertAmountToCommodity 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: -- | 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 must be MixedAmounts with exactly one component Amount (or there will be a runtime error)
@ -145,6 +135,24 @@ costOfAmount a@(Amount _ q price) =
Just (TotalPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*signum q) Nothing Just (TotalPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*signum q) Nothing
_ -> error' "costOfAmount: Malformed price encountered, programmer error" _ -> error' "costOfAmount: Malformed price encountered, programmer error"
-- | Divide an amount's quantity by a constant.
divideAmount :: Amount -> Double -> Amount
divideAmount a@Amount{quantity=q} d = a{quantity=q/d}
-- | Is this amount negative ? The price is ignored.
isNegativeAmount :: Amount -> Bool
isNegativeAmount Amount{quantity=q} = q < 0
-- | 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
-- | Get the string representation of an amount, based on its commodity's -- | Get the string representation of an amount, based on its commodity's
-- display settings except using the specified precision. -- display settings except using the specified precision.
showAmountWithPrecision :: Int -> Amount -> String showAmountWithPrecision :: Int -> Amount -> String
@ -154,7 +162,6 @@ showAmountWithPrecision p = showAmount . setAmountPrecision p
setAmountPrecision :: Int -> Amount -> Amount setAmountPrecision :: Int -> Amount -> Amount
setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}} setAmountPrecision p a@Amount{commodity=c} = a{commodity=c{precision=p}}
-- XXX refactor
-- | Get the unambiguous string representation of an amount, for debugging. -- | Get the unambiguous string representation of an amount, for debugging.
showAmountDebug :: Amount -> String showAmountDebug :: Amount -> String
showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}" showAmountDebug (Amount c q pri) = printf "Amount {commodity = %s, quantity = %s, price = %s}"
@ -177,7 +184,8 @@ showPriceDebug (UnitPrice pa) = " @ " ++ showMixedAmountDebug pa
showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa showPriceDebug (TotalPrice pa) = " @@ " ++ showMixedAmountDebug pa
-- | Get the string representation of an amount, based on its commodity's -- | 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. -- display settings. Amounts whose string representation would mean zero
-- are rendered as just "0".
showAmount :: Amount -> String showAmount :: Amount -> String
showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message showAmount (Amount (Commodity {symbol="AUTO"}) _ _) = "" -- can appear in an error message
showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) = showAmount a@(Amount (Commodity {symbol=sym,side=side,spaced=spaced}) _ pri) =
@ -204,18 +212,6 @@ showamountquantity (Amount (Commodity {decimalpoint=d,precision=p,separator=s,se
| p == maxprecision = chopdotzero $ printf "%f" q | p == maxprecision = chopdotzero $ printf "%f" q
| otherwise = printf ("%."++show p++"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, -- | Replace a number string's decimal point with the specified character,
-- and add the specified digit group separators. -- and add the specified digit group separators.
punctuatenumber :: Char -> Char -> [Int] -> String -> String punctuatenumber :: Char -> Char -> [Int] -> String -> String
@ -234,35 +230,89 @@ punctuatenumber dec sep grps str = sign ++ reverse (addseps sep (extend grps) (r
| otherwise = let (s,rest) = splitAt g str | otherwise = let (s,rest) = splitAt g str
in s ++ [sep] ++ addseps sep gs rest in s ++ [sep] ++ addseps sep gs rest
-- | Add thousands-separating commas to a decimal number string chopdotzero str = reverse $ case reverse str of
punctuatethousands :: String -> String '0':'.':s -> s
punctuatethousands s = s -> s
sign ++ addcommas int ++ frac
-- | 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 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
-------------------------------------------------------------------------------
-- MixedAmount
instance Show MixedAmount where show = showMixedAmount
instance Num MixedAmount where
fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]
negate (Mixed as) = Mixed $ map negate as
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ 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 :: MixedAmount
missingamt = Mixed [Amount unknown{symbol="AUTO"} 0 Nothing]
-- | 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 where
(sign,num) = break isDigit s as'' = if null nonzeros then [nullamt] else nonzeros
(int,frac) = break (=='.') num (_,nonzeros) = partition (\a -> isReallyZeroAmount a && Mixed [a] /= missingamt) as'
addcommas = reverse . concat . intersperse "," . triples . reverse as' = map sumAmountsDiscardingAllButFirstPrice $ group $ sort as
triples [] = [] sort = sortBy (\a1 a2 -> compare (sym a1) (sym a2))
triples l = take 3 l : triples (drop 3 l) group = groupBy (\a1 a2 -> sym a1 == sym a2)
sym = symbol . commodity
-- | Does this amount appear to be zero when displayed with its given precision ? sumAmountsDiscardingAllButFirstPrice [] = nullamt
isZeroAmount :: Amount -> Bool sumAmountsDiscardingAllButFirstPrice as = (sum as){price=price $ head as}
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. -- | Get a mixed amount's component amounts.
amounts :: MixedAmount -> [Amount] amounts :: MixedAmount -> [Amount]
amounts (Mixed as) = as 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 $ normaliseMixedAmount m
-- | Does this mixed amount appear to be zero when displayed with its given precision ? -- | Does this mixed amount appear to be zero when displayed with its given precision ?
isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount :: MixedAmount -> Bool
isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount
@ -271,22 +321,20 @@ isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount
isReallyZeroMixedAmount :: MixedAmount -> Bool isReallyZeroMixedAmount :: MixedAmount -> Bool
isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmount 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 -- | Is this mixed amount "really" zero, after converting to cost
-- commodities where possible ? -- commodities where possible ?
isReallyZeroMixedAmountCost :: MixedAmount -> Bool isReallyZeroMixedAmountCost :: MixedAmount -> Bool
isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount
-- -- | MixedAmount derives Eq in Types.hs, but that doesn't know that we -- -- | Convert a mixed amount to the specified commodity, assuming an exchange rate of 1.
-- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code in there. -- convertMixedAmountToCommodity :: Commodity -> MixedAmount -> Amount
-- -- When zero equality is important, use this, for now; should be used -- convertMixedAmountToCommodity c (Mixed as) = Amount c total Nothing
-- -- everywhere. -- where
-- total = sum $ map (quantity . convertAmountToCommodity c) as
-- -- | 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 :: MixedAmount -> MixedAmount -> Bool
-- mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b') -- mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b')
-- where a' = normaliseMixedAmount a -- where a' = normaliseMixedAmount a
@ -320,7 +368,8 @@ showMixedAmountDebug m = printf "Mixed [%s]" as
showMixedAmountWithoutPrice :: MixedAmount -> String showMixedAmountWithoutPrice :: MixedAmount -> String
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
where where
(Mixed as) = normaliseMixedAmountIgnoringPrice m (Mixed as) = normaliseMixedAmount $ stripPrices m
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{price=Nothing}
width = maximum $ map (length . show) as width = maximum $ map (length . show) as
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
@ -338,132 +387,17 @@ showMixedAmountOrZeroWithoutPrice a
| isZeroMixedAmount a = "0" | isZeroMixedAmount a = "0"
| otherwise = showMixedAmountWithoutPrice a | 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 -- | Replace a mixed amount's commodity with the canonicalised version from
-- the provided commodity map. -- the provided commodity map.
canonicaliseMixedAmountCommodity :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount canonicaliseMixedAmountCommodity :: Maybe (Map.Map String Commodity) -> MixedAmount -> MixedAmount
canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map (canonicaliseAmountCommodity canonicalcommoditymap) as canonicaliseMixedAmountCommodity canonicalcommoditymap (Mixed as) = Mixed $ map (canonicaliseAmountCommodity canonicalcommoditymap) as
-- | Replace an amount's commodity with the canonicalised version from -------------------------------------------------------------------------------
-- the provided commodity map. -- misc
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 [ tests_Hledger_Data_Amount = TestList [
-- amounts -- Amount
"costOfAmount" ~: do "costOfAmount" ~: do
costOfAmount (euros 1) `is` euros 1 costOfAmount (euros 1) `is` euros 1
@ -479,7 +413,7 @@ tests_Hledger_Data_Amount = TestList [
let a = dollars 1 let a = dollars 1
negate a `is` a{quantity=(-1)} negate a `is` a{quantity=(-1)}
let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} let b = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}
negate b `is` b{quantity=(-1)} -- XXX failing negate b `is` b{quantity=(-1)}
,"adding amounts" ~: do ,"adding amounts" ~: do
let a1 = dollars 1.23 let a1 = dollars 1.23
@ -491,31 +425,25 @@ tests_Hledger_Data_Amount = TestList [
(a3 + 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 sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing
-- highest precision is preserved -- highest precision is preserved
(sum [Amount dollar 1.25 Nothing, Amount dollar{precision=0} (-1) Nothing, Amount dollar{precision=3} (-0.25) Nothing]) let ap1 = (dollars 1){commodity=dollar{precision=1}}
`is` (Amount dollar{precision=3} 0 Nothing) ap3 = (dollars 1){commodity=dollar{precision=3}}
(sum [ap1,ap3]) `is` ap3{quantity=2}
(sum [ap3,ap1]) `is` ap3{quantity=2}
-- adding different commodities assumes conversion rate 1 -- adding different commodities assumes conversion rate 1
assertBool "" $ isZeroAmount (a1 - euros 1.23) assertBool "" $ isZeroAmount (a1 - euros 1.23)
,"showAmount" ~: do ,"showAmount" ~: do
showAmount (dollars 0 + pounds 0) `is` "0" showAmount (dollars 0 + pounds 0) `is` "0"
-- mixed amounts -- MixedAmount
,"normaliseMixedAmount" ~: do ,"normaliseMixedAmount" ~: do
normaliseMixedAmount (Mixed []) `is` Mixed [nullamt] normaliseMixedAmount (Mixed []) `is` Mixed [nullamt]
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmount (Mixed [Amount {commodity=dollar, quantity=10, price=Nothing} 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=Just (TotalPrice (Mixed [Amount {commodity=euro, quantity=7, price=Nothing}]))}
,Amount {commodity=dollar, quantity=(-10), 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}]))} ,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 ,"adding mixed amounts" ~: do
let dollar0 = dollar{precision=0} let dollar0 = dollar{precision=0}
@ -526,7 +454,9 @@ tests_Hledger_Data_Amount = TestList [
`is` Mixed [Amount unknown 0 Nothing] `is` Mixed [Amount unknown 0 Nothing]
,"showMixedAmount" ~: do ,"showMixedAmount" ~: do
showMixedAmount (Mixed [Amount dollar 0 Nothing]) `is` "0" showMixedAmount (Mixed [dollars 1]) `is` "$1.00"
showMixedAmount (Mixed [(dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}]) `is` "$1.00 @ €2.00"
showMixedAmount (Mixed [dollars 0]) `is` "0"
showMixedAmount (Mixed []) `is` "0" showMixedAmount (Mixed []) `is` "0"
showMixedAmount missingamt `is` "" showMixedAmount missingamt `is` ""
@ -535,9 +465,9 @@ tests_Hledger_Data_Amount = TestList [
showMixedAmountOrZero (Mixed []) `is` "0" showMixedAmountOrZero (Mixed []) `is` "0"
showMixedAmountOrZero missingamt `is` "" showMixedAmountOrZero missingamt `is` ""
,"punctuatethousands" ~: do ,"showMixedAmountWithoutPrice" ~: do
punctuatethousands "" `is` "" let a = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]}
punctuatethousands "1234567.8901" `is` "1,234,567.8901" showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00"
punctuatethousands "-100" `is` "-100" showMixedAmountWithoutPrice (Mixed [a, (-a)]) `is` "0"
] ]

2
hledger-lib/Hledger/Data/Posting.hs
View File

@ -71,7 +71,7 @@ accountNamesFromPostings :: [Posting] -> [AccountName]
accountNamesFromPostings = nub . map paccount accountNamesFromPostings = nub . map paccount
sumPostings :: [Posting] -> MixedAmount sumPostings :: [Posting] -> MixedAmount
sumPostings = sumMixedAmountsPreservingHighestPrecision . map pamount sumPostings = sum . map pamount
postingDate :: Posting -> Day postingDate :: Posting -> Day
postingDate p = maybe nulldate tdate $ ptransaction p postingDate p = maybe nulldate tdate $ ptransaction p

2
hledger/Hledger/Cli/Add.hs
View File

@ -136,7 +136,7 @@ getPostings st enteredps = do
-- force a decimal point in the output in case there's a -- force a decimal point in the output in case there's a
-- digit group separator that would be mistaken for one -- digit group separator that would be mistaken for one
historicalamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ pamount $ fromJust bestmatch' historicalamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ pamount $ fromJust bestmatch'
balancingamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ negate $ sumMixedAmountsPreservingHighestPrecision $ map pamount enteredrealps balancingamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ negate $ sum $ map pamount enteredrealps
amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount amountstr <- runInteractionDefault $ askFor (printf "amount %d" n) defaultamountstr validateamount
let amount = fromparse $ runParser (someamount <|> return missingamt) ctx "" amountstr let amount = fromparse $ runParser (someamount <|> return missingamt) ctx "" amountstr
amount' = fromparse $ runParser (someamount <|> return missingamt) nullctx "" amountstr amount' = fromparse $ runParser (someamount <|> return missingamt) nullctx "" amountstr