amounts cleanups, and support zeros with commodity

This commit is contained in:
Simon Michael 2014-07-28 06:32:09 -07:00
parent 7fb154f820
commit 40ab1e17f6
8 changed files with 171 additions and 155 deletions

View File

@ -57,13 +57,12 @@ module Hledger.Data.Amount (
-- ** arithmetic
costOfAmount,
divideAmount,
sumAmounts,
-- ** rendering
amountstyle,
showAmount,
showAmountWithZeroCommodity,
showAmountDebug,
showAmountWithoutPrice,
showMixedAmountOneLineWithoutPrice,
maxprecision,
maxprecisionwithpoint,
setAmountPrecision,
@ -76,8 +75,8 @@ module Hledger.Data.Amount (
amounts,
filterMixedAmount,
filterMixedAmountByCommodity,
normaliseMixedAmountPreservingFirstPrice,
normaliseMixedAmountPreservingPrices,
normaliseMixedAmountSquashPricesForDisplay,
normaliseMixedAmount,
-- ** arithmetic
costOfMixedAmount,
divideMixedAmount,
@ -89,6 +88,8 @@ module Hledger.Data.Amount (
showMixedAmount,
showMixedAmountDebug,
showMixedAmountWithoutPrice,
showMixedAmountOneLineWithoutPrice,
showMixedAmountWithZeroCommodity,
showMixedAmountWithPrecision,
setMixedAmountPrecision,
canonicaliseMixedAmount,
@ -98,6 +99,7 @@ module Hledger.Data.Amount (
) where
import Data.Char (isDigit)
import Data.Function (on)
import Data.List
import Data.Map (findWithDefault)
import Data.Maybe
@ -140,26 +142,31 @@ amount, nullamt :: Amount
amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle}
nullamt = amount
-- | A temporary value for parsed transactions which had no amount specified.
missingamt :: Amount
missingamt = amount{acommodity="AUTO"}
-- handy amount constructors for tests
num n = amount{acommodity="", aquantity=n}
usd n = amount{acommodity="$", aquantity=n, astyle=amountstyle{asprecision=2}}
eur n = amount{acommodity="", aquantity=n, astyle=amountstyle{asprecision=2}}
gbp n = amount{acommodity="£", aquantity=n, astyle=amountstyle{asprecision=2}}
hrs n = amount{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=1, ascommodityside=R}}
amt `at` priceamt = amt{aprice=UnitPrice priceamt}
amt @@ priceamt = amt{aprice=TotalPrice priceamt}
-- | Apply a binary arithmetic operator to two amounts in the same
-- commodity. Warning, as a kludge to support folds (eg sum) we assign
-- the second's commodity to the first so the same commodity requirement
-- is not checked. The highest precision of either amount is preserved in
-- the result. Any prices are currently ignored and discarded. The display
-- style is that of the first amount, with precision set to the highest of
-- either amount.
similarAmountsOp :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
similarAmountsOp op Amount{acommodity=_, aquantity=aq, astyle=AmountStyle{asprecision=ap}}
Amount{acommodity=bc, aquantity=bq, astyle=bs@AmountStyle{asprecision=bp}} =
-- trace ("a:"++showAmount a) $ trace ("b:"++showAmount b++"\n") $ tracewith (("=:"++).showAmount)
amount{acommodity=bc, aquantity=aq `op` bq, astyle=bs{asprecision=max ap bp}}
-- ac==bc = amount{acommodity=ac, aquantity=aq `op` bq, astyle=as{asprecision=max ap bp}}
-- | Apply a binary arithmetic operator to two amounts, which should
-- be in the same commodity if non-zero (warning, this is not checked).
-- A zero result keeps the commodity of the second amount.
-- The result's display style is that of the second amount, with
-- precision set to the highest of either amount.
-- Prices are ignored and discarded.
similarAmountsOp :: (Quantity -> Quantity -> Quantity) -> Amount -> Amount -> Amount
similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{asprecision=p1}}
Amount{acommodity=c2, aquantity=q2, astyle=s2@AmountStyle{asprecision=p2}} =
-- trace ("a1:"++showAmountDebug a1) $ trace ("a2:"++showAmountDebug a2) $ traceWith (("= :"++).showAmountDebug)
amount{acommodity=c2, aquantity=q1 `op` q2, astyle=s2{asprecision=max p1 p2}}
-- c1==c2 || q1==0 || q2==0 =
-- otherwise = error "tried to do simple arithmetic with amounts in different commodities"
-- | Convert an amount to the specified commodity, ignoring and discarding
@ -167,30 +174,6 @@ similarAmountsOp op Amount{acommodity=_, aquantity=aq, astyle=AmountStyle{aspre
amountWithCommodity :: Commodity -> Amount -> Amount
amountWithCommodity c a = a{acommodity=c, aprice=NoPrice}
-- | A more complete amount adding operation.
sumAmounts :: [Amount] -> MixedAmount
sumAmounts = normaliseMixedAmountPreservingPrices . Mixed
-- | Set an amount's unit price.
at :: Amount -> Amount -> Amount
amt `at` priceamt = amt{aprice=UnitPrice priceamt}
-- | Set an amount's total price.
(@@) :: Amount -> Amount -> Amount
amt @@ priceamt = amt{aprice=TotalPrice priceamt}
tests_sumAmounts = [
"sumAmounts" ~: do
-- when adding, we don't convert to the price commodity - just
-- combine what amounts we can.
-- amounts with same unit price
sumAmounts [usd 1 `at` eur 1, usd 1 `at` eur 1] `is` Mixed [usd 2 `at` eur 1]
-- amounts with different unit prices
-- amounts with total prices
sumAmounts [usd 1 @@ eur 1, usd 1 @@ eur 1] `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]
-- amounts with no, unit, and/or total prices
]
-- | Convert an amount to the commodity of its assigned price, if any. Notes:
--
-- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error)
@ -262,23 +245,31 @@ showPriceDebug NoPrice = ""
showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa
showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa
-- | Get the string representation of an amount, based on its commodity's
-- display settings. String representations equivalent to zero are
-- converted to just \"0\".
-- | Get the string representation of an amount, based on its
-- commodity's display settings. String representations equivalent to
-- zero are converted to just \"0\". The special "missing" amount is
-- displayed as the empty string.
showAmount :: Amount -> String
showAmount Amount{acommodity="AUTO"} = ""
showAmount a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) =
showAmount = showAmountHelper False
showAmountHelper :: Bool -> Amount -> String
showAmountHelper _ Amount{acommodity="AUTO"} = ""
showAmountHelper showzerocommodity a@(Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}}) =
case ascommodityside of
L -> printf "%s%s%s%s" c' space quantity' price
R -> printf "%s%s%s%s" quantity' space c' price
where
quantity = showamountquantity a
displayingzero = null $ filter (`elem` digits) $ quantity
(quantity',c') | displayingzero = ("0","")
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
(quantity',c') | displayingzero && not showzerocommodity = ("0","")
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
space = if (not (null c') && ascommodityspaced) then " " else "" :: String
price = showPrice p
-- | Like showAmount, but show a zero amount's commodity if it has one.
showAmountWithZeroCommodity :: Amount -> String
showAmountWithZeroCommodity = showAmountHelper True
-- | Get the string representation of the number part of of an amount,
-- using the display settings from its commodity.
showamountquantity :: Amount -> String
@ -346,81 +337,102 @@ instance Show MixedAmount where
instance Num MixedAmount where
fromInteger i = Mixed [fromInteger i]
negate (Mixed as) = Mixed $ map negate as
(+) (Mixed as) (Mixed bs) = normaliseMixedAmountPreservingPrices $ Mixed $ as ++ bs
(*) = error' "programming error, mixed amounts do not support multiplication"
abs = error' "programming error, mixed amounts do not support abs"
signum = error' "programming error, mixed amounts do not support signum"
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
(*) = error' "error, mixed amounts do not support multiplication"
abs = error' "error, mixed amounts do not support abs"
signum = error' "error, mixed amounts do not support signum"
-- | The empty mixed amount.
nullmixedamt :: MixedAmount
nullmixedamt = Mixed []
-- | A temporary value for parsed transactions which had no amount specified.
missingamt :: Amount
missingamt = amount{acommodity="AUTO"}
missingmixedamt :: MixedAmount
missingmixedamt = Mixed [missingamt]
mixed :: Amount -> MixedAmount
mixed a = Mixed [a]
-- | Convert amounts in various commodities into a normalised MixedAmount.
mixed :: [Amount] -> MixedAmount
mixed = normaliseMixedAmount . Mixed
-- | Simplify a mixed amount's component amounts: we can combine amounts
-- with the same commodity and unit price. Also remove any zero or missing
-- amounts and replace an empty amount list with a single zero amount.
normaliseMixedAmountPreservingPrices :: MixedAmount -> MixedAmount
normaliseMixedAmountPreservingPrices (Mixed as) = Mixed as''
where
as'' = if null nonzeros then [nullamt] else nonzeros
(_,nonzeros) = partition isReallyZeroAmount as'
as' = map sumAmountsUsingFirstPrice $ group $ sort $ filter (/= missingamt) as
sort = sortBy (\a1 a2 -> compare (acommodity a1, aprice a1) (acommodity a2, aprice a2))
group = groupBy (\a1 a2 -> acommodity a1 == acommodity a2 && sameunitprice a1 a2)
where
sameunitprice a1 a2 =
case (aprice a1, aprice a2) of
(NoPrice, NoPrice) -> True
(UnitPrice p1, UnitPrice p2) -> p1 == p2
_ -> False
-- | Simplify a mixed amount's component amounts:
--
-- * amounts in the same commodity are combined unless they have different prices or total prices
--
-- * multiple zero amounts are replaced by just one. If they had the same commodity, it is preserved.
--
-- * an empty amount list is replaced with a single commodityless zero
--
-- * the special "missing" mixed amount remains unchanged
--
normaliseMixedAmount :: MixedAmount -> MixedAmount
normaliseMixedAmount = normaliseHelper False
tests_normaliseMixedAmountPreservingPrices = [
"normaliseMixedAmountPreservingPrices" ~: do
assertEqual "discard missing amount" (Mixed [nullamt]) (normaliseMixedAmountPreservingPrices $ Mixed [usd 0, missingamt])
assertEqual "combine unpriced same-commodity amounts" (Mixed [usd 2]) (normaliseMixedAmountPreservingPrices $ Mixed [usd 0, usd 2])
assertEqual "don't combine total-priced amounts"
(Mixed
[usd 1 @@ eur 1
,usd (-2) @@ eur 1
])
(normaliseMixedAmountPreservingPrices $ Mixed
[usd 1 @@ eur 1
,usd (-2) @@ eur 1
])
normaliseHelper :: Bool -> MixedAmount -> MixedAmount
normaliseHelper squashprices (Mixed as)
| missingamt `elem` as = missingmixedamt -- missingamt should always be alone, but detect it even if not
| null nonzeros = Mixed [newzero]
| otherwise = Mixed nonzeros
where
newzero = case filter (/= "") (map acommodity zeros) of
[c] -> nullamt{acommodity=c}
_ -> nullamt
(zeros, nonzeros) = partition isReallyZeroAmount $
map sumSimilarAmountsUsingFirstPrice $
groupBy groupfn $
sortBy sortfn $
as
sortfn | squashprices = compare `on` acommodity
| otherwise = compare `on` \a -> (acommodity a, aprice a)
groupfn | squashprices = (==) `on` acommodity
| otherwise = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2
combinableprices Amount{aprice=NoPrice} Amount{aprice=NoPrice} = True
combinableprices Amount{aprice=UnitPrice p1} Amount{aprice=UnitPrice p2} = p1 == p2
combinableprices _ _ = False
tests_normaliseMixedAmount = [
"normaliseMixedAmount" ~: do
-- assertEqual "missing amount is discarded" (Mixed [nullamt]) (normaliseMixedAmount $ Mixed [usd 0, missingamt])
assertEqual "any missing amount means a missing mixed amount" missingmixedamt (normaliseMixedAmount $ Mixed [usd 0, missingamt])
assertEqual "unpriced same-commodity amounts are combined" (Mixed [usd 2]) (normaliseMixedAmount $ Mixed [usd 0, usd 2])
-- amounts with same unit price are combined
normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) `is` Mixed [usd 2 `at` eur 1]
-- amounts with different unit prices are not combined
normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) `is` Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]
-- amounts with total prices are not combined
normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]
]
-- | Simplify a mixed amount's component amounts: combine amounts with
-- the same commodity, using the first amount's price for subsequent
-- amounts in each commodity (ie, this function alters the amount and
-- is best used as a rendering helper.). Also remove any zero amounts
-- and replace an empty amount list with a single zero amount.
normaliseMixedAmountPreservingFirstPrice :: MixedAmount -> MixedAmount
normaliseMixedAmountPreservingFirstPrice (Mixed as) = Mixed as''
where
as'' = if null nonzeros then [nullamt] else nonzeros
(_,nonzeros) = partition (\a -> isReallyZeroAmount a && a /= missingamt) as'
as' = map sumAmountsUsingFirstPrice $ group $ sort as
sort = sortBy (\a1 a2 -> compare (acommodity a1) (acommodity a2))
group = groupBy (\a1 a2 -> acommodity a1 == acommodity a2)
-- | Like normaliseMixedAmount, but combine each commodity's amounts
-- into just one by throwing away all prices except the first. This is
-- only used as a rendering helper, and could show a misleading price.
normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True
-- discardPrice :: Amount -> Amount
-- discardPrice a = a{price=Nothing}
tests_normaliseMixedAmountSquashPricesForDisplay = [
"normaliseMixedAmountSquashPricesForDisplay" ~: do
normaliseMixedAmountSquashPricesForDisplay (Mixed []) `is` Mixed [nullamt]
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay
(Mixed [usd 10
,usd 10 @@ eur 7
,usd (-10)
,usd (-10) @@ eur 7
])
]
-- discardPrices :: MixedAmount -> MixedAmount
-- discardPrices (Mixed as) = Mixed $ map discardPrice as
-- | Sum same-commodity amounts in a lossy way, applying the first
-- price to the result and discarding any other prices. Only used as a
-- rendering helper.
sumSimilarAmountsUsingFirstPrice :: [Amount] -> Amount
sumSimilarAmountsUsingFirstPrice [] = nullamt
sumSimilarAmountsUsingFirstPrice as = (sum as){aprice=aprice $ head as}
sumAmountsUsingFirstPrice [] = nullamt
sumAmountsUsingFirstPrice as = (sum as){aprice=aprice $ head as}
-- | Sum same-commodity amounts. If there were different prices, set
-- the price to a special marker indicating "various". Only used as a
-- rendering helper.
-- sumSimilarAmountsNotingPriceDifference :: [Amount] -> Amount
-- sumSimilarAmountsNotingPriceDifference [] = nullamt
-- sumSimilarAmountsNotingPriceDifference as = undefined
-- | Get a mixed amount's component amounts.
amounts :: MixedAmount -> [Amount]
@ -454,15 +466,15 @@ divideMixedAmount (Mixed as) d = Mixed $ map (flip divideAmount d) as
isNegativeMixedAmount :: MixedAmount -> Maybe Bool
isNegativeMixedAmount m = case as of [a] -> Just $ isNegativeAmount a
_ -> Nothing
where as = amounts $ normaliseMixedAmountPreservingFirstPrice m
where as = amounts $ normaliseMixedAmountSquashPricesForDisplay m
-- | Does this mixed amount appear to be zero when displayed with its given precision ?
isZeroMixedAmount :: MixedAmount -> Bool
isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmountPreservingFirstPrice
isZeroMixedAmount = all isZeroAmount . amounts . normaliseMixedAmountSquashPricesForDisplay
-- | Is this mixed amount "really" zero ? See isReallyZeroAmount.
isReallyZeroMixedAmount :: MixedAmount -> Bool
isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmountPreservingFirstPrice
isReallyZeroMixedAmount = all isReallyZeroAmount . amounts . normaliseMixedAmountSquashPricesForDisplay
-- | Is this mixed amount "really" zero, after converting to cost
-- commodities where possible ?
@ -474,14 +486,26 @@ isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount
-- -- For now, use this when cross-commodity zero equality is important.
-- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool
-- mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZeroMixedAmount b')
-- where a' = normaliseMixedAmountPreservingFirstPrice a
-- b' = normaliseMixedAmountPreservingFirstPrice b
-- where a' = normaliseMixedAmountSquashPricesForDisplay a
-- b' = normaliseMixedAmountSquashPricesForDisplay 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 \"\".
-- | Get the string representation of a mixed amount, after
-- normalising it to one amount per commodity. Assumes amounts have
-- no or similar prices, otherwise this can show misleading prices.
showMixedAmount :: MixedAmount -> String
showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $ normaliseMixedAmountPreservingFirstPrice m
showMixedAmount = showMixedAmountHelper False
-- | Like showMixedAmount, but zero amounts are shown with their
-- commodity if they have one.
showMixedAmountWithZeroCommodity :: MixedAmount -> String
showMixedAmountWithZeroCommodity = showMixedAmountHelper True
showMixedAmountHelper :: Bool -> MixedAmount -> String
showMixedAmountHelper showzerocommodity m =
vConcatRightAligned $ map showw $ amounts $ normaliseMixedAmountSquashPricesForDisplay m
where
showw | showzerocommodity = showAmountWithZeroCommodity
| otherwise = showAmount
-- | Compact labelled trace of a mixed amount, for debugging.
ltraceamount :: String -> MixedAmount -> MixedAmount
@ -496,20 +520,20 @@ setMixedAmountPrecision p (Mixed as) = Mixed $ map (setAmountPrecision p) as
-- commoditys' display precision settings.
showMixedAmountWithPrecision :: Int -> MixedAmount -> String
showMixedAmountWithPrecision p m =
vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountPreservingFirstPrice m
vConcatRightAligned $ map (showAmountWithPrecision p) $ amounts $ normaliseMixedAmountSquashPricesForDisplay m
-- | Get an unambiguous string representation of a mixed amount for debugging.
showMixedAmountDebug :: MixedAmount -> String
showMixedAmountDebug m | m == missingmixedamt = "(missing)"
| otherwise = printf "Mixed [%s]" as
where as = intercalate "\n " $ map showAmountDebug $ amounts m -- normaliseMixedAmountPreservingFirstPrice m
where as = intercalate "\n " $ map showAmountDebug $ amounts m
-- | Get the string representation of a mixed amount, but without
-- any \@ prices.
showMixedAmountWithoutPrice :: MixedAmount -> String
showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth as
where
(Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m
(Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice}
width = maximum $ map (length . showAmount) as
showfixedwidth = printf (printf "%%%ds" width) . showAmountWithoutPrice
@ -519,7 +543,7 @@ showMixedAmountWithoutPrice m = concat $ intersperse "\n" $ map showfixedwidth a
showMixedAmountOneLineWithoutPrice :: MixedAmount -> String
showMixedAmountOneLineWithoutPrice m = concat $ intersperse ", " $ map showAmountWithoutPrice as
where
(Mixed as) = normaliseMixedAmountPreservingFirstPrice $ stripPrices m
(Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice}
-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
@ -530,8 +554,8 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl
-- misc
tests_Hledger_Data_Amount = TestList $
tests_normaliseMixedAmountPreservingPrices
++ tests_sumAmounts
tests_normaliseMixedAmount
++ tests_normaliseMixedAmountSquashPricesForDisplay
++ [
-- Amount
@ -574,25 +598,16 @@ tests_Hledger_Data_Amount = TestList $
-- MixedAmount
,"normaliseMixedAmountPreservingFirstPrice" ~: do
normaliseMixedAmountPreservingFirstPrice (Mixed []) `is` Mixed [nullamt]
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountPreservingFirstPrice
(Mixed [usd 10
,usd 10 @@ eur 7
,usd (-10)
,usd (-10) @@ eur 7
])
,"adding mixed amounts" ~: do
(sum $ map (Mixed . (\a -> [a]))
,"adding mixed amounts, preserving minimum precision and a single commodity on zero" ~: do
(sum $ map (Mixed . (:[]))
[usd 1.25
,usd (-1) `withPrecision` 0
,usd (-0.25)
])
`is` Mixed [amount{aquantity=0}]
`is` Mixed [usd 0 `withPrecision` 0]
,"adding mixed amounts with total prices" ~: do
(sum $ map (Mixed . (\a -> [a]))
(sum $ map (Mixed . (:[]))
[usd 1 @@ eur 1
,usd (-2) @@ eur 1
])

View File

@ -79,7 +79,7 @@ nullposting = Posting
posting = nullposting
post :: AccountName -> Amount -> Posting
post acct amt = posting {paccount=acct, pamount=mixed amt}
post acct amt = posting {paccount=acct, pamount=Mixed [amt]}
-- XXX once rendered user output, but just for debugging now; clean up
showPosting :: Posting -> String

View File

@ -565,7 +565,7 @@ transactionFromCsvRecord rules record = t
precomment = maybe "" render $ mfieldtemplate "precomment"
currency = maybe (fromMaybe "" mdefaultcurrency) render $ mfieldtemplate "currency"
amountstr = (currency++) $ negateIfParenthesised $ getAmountStr rules record
amount = either amounterror mixed $ runParser (do {a <- amountp; eof; return a}) nullctx "" amountstr
amount = either amounterror (Mixed . (:[])) $ runParser (do {a <- amountp; eof; return a}) nullctx "" amountstr
amounterror err = error' $ unlines
["error: could not parse \""++amountstr++"\" as an amount"
,showRecord record

View File

@ -649,7 +649,7 @@ amountp' s = either (error' . show) id $ parseWithCtx nullctx amountp s
-- | Parse a mixed amount from a string, or get an error.
mamountp' :: String -> MixedAmount
mamountp' = mixed . amountp'
mamountp' = Mixed . (:[]) . amountp'
signp :: GenParser Char JournalContext String
signp = do

View File

@ -116,13 +116,14 @@ balanceReportItem opts _ a@Account{aname=name}
-- total = headDef 0 mbrtotals
tests_balanceReport =
let (opts,journal) `gives` r = do
let (eitems, etotal) = r
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
assertEqual "items" eitems aitems
-- assertEqual "" (length eitems) (length aitems)
-- mapM (\(e,a) -> assertEqual "" e a) $ zip eitems aitems
assertEqual "total" etotal atotal
let
(opts,journal) `gives` r = do
let (eitems, etotal) = r
(aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
showw (acct,amt) = (acct, showMixedAmountDebug amt)
assertEqual "items" (map showw eitems) (map showw aitems)
assertEqual "total" (showMixedAmountDebug etotal) (showMixedAmountDebug atotal)
usd0 = nullamt{acommodity="$"}
in [
"balanceReport with no args on null journal" ~: do
@ -142,7 +143,7 @@ tests_balanceReport =
,(("income:salary","salary",1), mamountp' "$-1.00")
,(("liabilities:debts","liabilities:debts",0), mamountp' "$1.00")
],
Mixed [nullamt])
Mixed [usd0])
,"balanceReport with --depth=N" ~: do
(defreportopts{depth_=Just 1}, samplejournal) `gives`
@ -152,7 +153,7 @@ tests_balanceReport =
,(("income", "income", 0), mamountp' "$-2.00")
,(("liabilities", "liabilities", 0), mamountp' "$1.00")
],
Mixed [nullamt])
Mixed [usd0])
,"balanceReport with depth:N" ~: do
(defreportopts{query_="depth:1"}, samplejournal) `gives`
@ -162,7 +163,7 @@ tests_balanceReport =
,(("income", "income", 0), mamountp' "$-2.00")
,(("liabilities", "liabilities", 0), mamountp' "$1.00")
],
Mixed [nullamt])
Mixed [usd0])
,"balanceReport with a date or secondary date span" ~: do
(defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
@ -173,7 +174,7 @@ tests_balanceReport =
(("assets:bank:checking","assets:bank:checking",0),mamountp' "$1.00")
,(("income:salary","income:salary",0),mamountp' "$-1.00")
],
Mixed [nullamt])
Mixed [usd0])
,"balanceReport with desc:" ~: do
(defreportopts{query_="desc:income"}, samplejournal) `gives`
@ -181,13 +182,13 @@ tests_balanceReport =
(("assets:bank:checking","assets:bank:checking",0),mamountp' "$1.00")
,(("income:salary","income:salary",0), mamountp' "$-1.00")
],
Mixed [nullamt])
Mixed [usd0])
,"balanceReport with not:desc:" ~: do
(defreportopts{query_="not:desc:income"}, samplejournal) `gives`
([
(("assets","assets",0), mamountp' "$-2.00")
,(("assets:bank","bank",1), Mixed [nullamt])
,(("assets:bank","bank",1), Mixed [usd0])
,(("assets:bank:checking","checking",2),mamountp' "$-1.00")
,(("assets:bank:saving","saving",2), mamountp' "$1.00")
,(("assets:cash","cash",1), mamountp' "$-2.00")
@ -197,7 +198,7 @@ tests_balanceReport =
,(("income:gifts","income:gifts",0), mamountp' "$-1.00")
,(("liabilities:debts","liabilities:debts",0), mamountp' "$1.00")
],
Mixed [nullamt])
Mixed [usd0])
{-

View File

@ -85,7 +85,7 @@ handleAdd = do
(balanceTransaction Nothing $ nulltransaction {
tdate=parsedate date
,tdescription=desc
,tpostings=[nullposting{paccount=acct, pamount=mixed amt} | (acct,amt) <- zip accts amts]
,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts]
})
-- display errors or add transaction

View File

@ -213,7 +213,7 @@ postingWizard es@EntryState{..} = do
let es1 = es{esArgs=drop 1 esArgs}
(amt,comment) <- amountAndCommentWizard es1
return $ Just nullposting{paccount=stripbrackets acct
,pamount=mixed amt
,pamount=Mixed [amt]
,pcomment=comment
,ptype=accountNamePostingType acct
}

View File

@ -338,7 +338,7 @@ balanceReportItemAsText opts format ((_, accountName, depth), Mixed amounts) =
-- 'amounts' could contain several quantities of the same commodity with different price.
-- In order to combine them into single value (which is expected) we take the first price and
-- use it for the whole mixed amount. This could be suboptimal. XXX
let Mixed normAmounts = normaliseMixedAmountPreservingFirstPrice (Mixed amounts) in
let Mixed normAmounts = normaliseMixedAmountSquashPricesForDisplay (Mixed amounts) in
case normAmounts of
[] -> []
[a] -> [formatBalanceReportItem opts (Just accountName) depth a format]