simplify amounts code, make tests pass
This commit is contained in:
		
							parent
							
								
									1273f02a9a
								
							
						
					
					
						commit
						10fd7ebc42
					
				| @ -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 | ||||
|       (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) | ||||
|       -- like journalCanonicaliseAmounts | ||||
|       fixamount a@Amount{commodity=c} = a{commodity=fixcommodity c} | ||||
|       fixcommodity c@Commodity{symbol=s} = findWithDefault c s canonicalcommoditymap | ||||
| 
 | ||||
| -- | Does this amount appear to be zero when displayed with its given precision ? | ||||
| isZeroAmount :: Amount -> Bool | ||||
| isZeroAmount = null . filter (`elem` "123456789") . showAmountWithoutPriceOrCommodity | ||||
| ------------------------------------------------------------------------------- | ||||
| -- MixedAmount | ||||
| 
 | ||||
| -- | 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 | ||||
| instance Show MixedAmount where show = showMixedAmount | ||||
| 
 | ||||
| -- | Is this amount negative ? The price is ignored. | ||||
| isNegativeAmount :: Amount -> Bool | ||||
| isNegativeAmount Amount{quantity=q} = q < 0 | ||||
| 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  | ||||
|       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 | ||||
| 
 | ||||
| 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" | ||||
| 
 | ||||
|   ] | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user