diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 758835403..a9fcdeda2 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -42,47 +42,46 @@ price-preserving (for amounts with the same prices) or price-ignoring -- 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 + -- * 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, + -- ** 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 @@ -92,47 +91,38 @@ import Hledger.Data.Commodity import Hledger.Utils -instance Show Amount where show = showAmount -instance Show MixedAmount where show = showMixedAmount deriving instance Show HistoricalPrice +------------------------------------------------------------------------------- +-- Amount + +instance Show Amount where show = showAmount + 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 + negate a@Amount{quantity=q} = a{quantity=(-q)} (+) = 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" +-- | The empty simple amount. +nullamt :: Amount +nullamt = Amount unknown 0 Nothing --- | 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. +-- | Apply a binary arithmetic operator to two amounts, ignoring and +-- discarding any assigned prices, and converting the first to the +-- commodity of the second in a simplistic way (1-1 exchange rate). +-- The highest precision of either amount is preserved in the result. similarAmountsOp :: (Double -> Double -> Double) -> Amount -> Amount -> Amount -similarAmountsOp op a (Amount bc bq _) = - Amount bc (quantity (convertAmountToSimilarCommodity bc a) `op` bq) Nothing +similarAmountsOp op a@(Amount Commodity{precision=ap} _ _) (Amount bc@Commodity{precision=bp} bq _) = + 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. -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 specified commodity, ignoring and discarding +-- any assigned prices and assuming an exchange rate of 1. +convertAmountToCommodity :: Commodity -> Amount -> Amount +convertAmountToCommodity c (Amount _ q _) = Amount c q Nothing -- | 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) @@ -145,6 +135,24 @@ costOfAmount a@(Amount _ q price) = Just (TotalPrice (Mixed [Amount pc pq Nothing])) -> Amount pc (pq*signum q) Nothing _ -> 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 -- display settings except using the specified precision. showAmountWithPrecision :: Int -> Amount -> String @@ -154,7 +162,6 @@ showAmountWithPrecision p = showAmount . setAmountPrecision p 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}" @@ -177,7 +184,8 @@ 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. +-- display settings. Amounts whose string representation would mean zero +-- are rendered as just "0". 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) = @@ -204,18 +212,6 @@ showamountquantity (Amount (Commodity {decimalpoint=d,precision=p,separator=s,se | 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 @@ -234,35 +230,89 @@ punctuatenumber dec sep grps str = sign ++ reverse (addseps sep (extend grps) (r | 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 +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 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 - (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) + as'' = if null nonzeros then [nullamt] else nonzeros + (_,nonzeros) = partition (\a -> isReallyZeroAmount a && Mixed [a] /= missingamt) as' + as' = map sumAmountsDiscardingAllButFirstPrice $ group $ sort as + sort = sortBy (\a1 a2 -> compare (sym a1) (sym a2)) + group = groupBy (\a1 a2 -> sym a1 == sym a2) + sym = symbol . commodity --- | 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 +sumAmountsDiscardingAllButFirstPrice [] = nullamt +sumAmountsDiscardingAllButFirstPrice as = (sum as){price=price $ 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 $ normaliseMixedAmount m + -- | Does this mixed amount appear to be zero when displayed with its given precision ? isZeroMixedAmount :: MixedAmount -> Bool isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount @@ -271,22 +321,20 @@ isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmount 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. +-- -- | Convert a mixed amount to the specified commodity, assuming an exchange rate of 1. +-- convertMixedAmountToCommodity :: Commodity -> MixedAmount -> Amount +-- convertMixedAmountToCommodity c (Mixed as) = Amount c total Nothing +-- 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 a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b') -- where a' = normaliseMixedAmount a @@ -320,7 +368,8 @@ showMixedAmountDebug m = printf "Mixed [%s]" as showMixedAmountWithoutPrice :: MixedAmount -> String showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as 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 showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice @@ -338,132 +387,17 @@ 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] - +------------------------------------------------------------------------------- +-- misc tests_Hledger_Data_Amount = TestList [ - -- amounts + -- Amount "costOfAmount" ~: do costOfAmount (euros 1) `is` euros 1 @@ -479,7 +413,7 @@ tests_Hledger_Data_Amount = TestList [ 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 + negate b `is` b{quantity=(-1)} ,"adding amounts" ~: do let a1 = dollars 1.23 @@ -491,31 +425,25 @@ tests_Hledger_Data_Amount = TestList [ (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) + let ap1 = (dollars 1){commodity=dollar{precision=1}} + 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 assertBool "" $ isZeroAmount (a1 - euros 1.23) ,"showAmount" ~: do showAmount (dollars 0 + pounds 0) `is` "0" - -- mixed amounts + -- MixedAmount ,"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 + ,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}]))} + ]) ,"adding mixed amounts" ~: do let dollar0 = dollar{precision=0} @@ -526,7 +454,9 @@ tests_Hledger_Data_Amount = TestList [ `is` Mixed [Amount unknown 0 Nothing] ,"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 missingamt `is` "" @@ -535,9 +465,9 @@ tests_Hledger_Data_Amount = TestList [ showMixedAmountOrZero (Mixed []) `is` "0" showMixedAmountOrZero missingamt `is` "" - ,"punctuatethousands" ~: do - punctuatethousands "" `is` "" - punctuatethousands "1234567.8901" `is` "1,234,567.8901" - punctuatethousands "-100" `is` "-100" + ,"showMixedAmountWithoutPrice" ~: do + let a = (dollars 1){price=Just $ UnitPrice $ Mixed [euros 2]} + showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00" + showMixedAmountWithoutPrice (Mixed [a, (-a)]) `is` "0" ] diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 2b101081a..445014ec6 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -71,7 +71,7 @@ accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nub . map paccount sumPostings :: [Posting] -> MixedAmount -sumPostings = sumMixedAmountsPreservingHighestPrecision . map pamount +sumPostings = sum . map pamount postingDate :: Posting -> Day postingDate p = maybe nulldate tdate $ ptransaction p diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index 6a90edd8a..82c5fdf05 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -136,7 +136,7 @@ getPostings st enteredps = do -- force a decimal point in the output in case there's a -- digit group separator that would be mistaken for one 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 let amount = fromparse $ runParser (someamount <|> return missingamt) ctx "" amountstr amount' = fromparse $ runParser (someamount <|> return missingamt) nullctx "" amountstr