lib,cli,ui,bin: Eliminate all uses of Mixed outside of Hledger.Data.Amount.

Exceptions are for dealing with the pamount field, which is really just
dealing with an unnormalised list of amounts.

This creates an API for dealing with MixedAmount, so we never have to
access the internals outside of Hledger.Data.Amount.

Also remove a comment, since it looks like #1207 has been resolved.
This commit is contained in:
Stephen Morgan 2021-01-31 15:23:46 +11:00
parent dabb3ef82e
commit d6a4310d8f
18 changed files with 85 additions and 94 deletions

View File

@ -162,7 +162,7 @@ sameSignNonZero is
| otherwise = (map pos $ filter (test.fourth4) nzs, sign) | otherwise = (map pos $ filter (test.fourth4) nzs, sign)
where where
nzs = filter ((/=0).fourth4) is nzs = filter ((/=0).fourth4) is
pos (acct,_,_,Mixed as) = (acct, abs $ read $ show $ maybe 0 aquantity $ headMay as) pos (acct,_,_,as) = (acct, abs $ read $ show $ maybe 0 aquantity $ headMay $ amounts as)
sign = if fourth4 (head nzs) >= 0 then 1 else (-1) sign = if fourth4 (head nzs) >= 0 then 1 else (-1)
test = if sign > 0 then (>0) else (<0) test = if sign > 0 then (>0) else (<0)

View File

@ -223,10 +223,10 @@ checkAssertion accounts = checkAssertion'
-- Add missing amounts (with 0 value), normalise, throw away style -- Add missing amounts (with 0 value), normalise, throw away style
-- information, and sort by commodity name. -- information, and sort by commodity name.
fixup (H.Mixed m1) (H.Mixed m2) = H.Mixed $ fixup m1 m2 =
let m = H.Mixed (m1 ++ [m_ { H.aquantity = 0 } | m_ <- m2]) let m = H.mixed $ amounts m1 ++ [m_ { H.aquantity = 0 } | m_ <- amounts m2]
(H.Mixed as) = H.normaliseMixedAmount m as = amounts $ H.normaliseMixedAmount m
in sortOn H.acommodity . map (\a -> a { H.astyle = H.amountstyle }) $ as in H.mixed $ sortOn H.acommodity . map (\a -> a { H.astyle = H.amountstyle }) $ as
-- | Check if an account name is mentioned in an assertion. -- | Check if an account name is mentioned in an assertion.
inAssertion :: H.AccountName -> Predicate -> Bool inAssertion :: H.AccountName -> Predicate -> Bool

View File

@ -530,7 +530,7 @@ nullmixedamt = Mixed []
-- | A temporary value for parsed transactions which had no amount specified. -- | A temporary value for parsed transactions which had no amount specified.
missingmixedamt :: MixedAmount missingmixedamt :: MixedAmount
missingmixedamt = Mixed [missingamt] missingmixedamt = mixedAmount missingamt
-- | Convert amounts in various commodities into a normalised MixedAmount. -- | Convert amounts in various commodities into a normalised MixedAmount.
mixed :: [Amount] -> MixedAmount mixed :: [Amount] -> MixedAmount
@ -964,37 +964,37 @@ tests_Amount = tests "Amount" [
@?= Mixed [usd (-1) @@ eur 2 ] @?= Mixed [usd (-1) @@ eur 2 ]
,test "showMixedAmount" $ do ,test "showMixedAmount" $ do
showMixedAmount (Mixed [usd 1]) @?= "$1.00" showMixedAmount (mixedAmount (usd 1)) @?= "$1.00"
showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00" showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00"
showMixedAmount (Mixed [usd 0]) @?= "0" showMixedAmount (mixedAmount (usd 0)) @?= "0"
showMixedAmount (Mixed []) @?= "0" showMixedAmount nullmixedamt @?= "0"
showMixedAmount missingmixedamt @?= "" showMixedAmount missingmixedamt @?= ""
,test "showMixedAmountWithoutPrice" $ do ,test "showMixedAmountWithoutPrice" $ do
let a = usd 1 `at` eur 2 let a = usd 1 `at` eur 2
showMixedAmountWithoutPrice False (Mixed [a]) @?= "$1.00" showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00"
showMixedAmountWithoutPrice False (Mixed [a, -a]) @?= "0" showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0"
,tests "normaliseMixedAmount" [ ,tests "normaliseMixedAmount" [
test "a missing amount overrides any other amounts" $ test "a missing amount overrides any other amounts" $
normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt amounts (normaliseMixedAmount $ mixed [usd 1, missingamt]) @?= [missingamt]
,test "unpriced same-commodity amounts are combined" $ ,test "unpriced same-commodity amounts are combined" $
normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2] amounts (normaliseMixedAmount $ mixed [usd 0, usd 2]) @?= [usd 2]
,test "amounts with same unit price are combined" $ ,test "amounts with same unit price are combined" $
normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1] amounts (normaliseMixedAmount $ mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1]
,test "amounts with different unit prices are not combined" $ ,test "amounts with different unit prices are not combined" $
normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2] amounts (normaliseMixedAmount $ mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2]
,test "amounts with total prices are combined" $ ,test "amounts with total prices are combined" $
normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 2 @@ eur 2] amounts (normaliseMixedAmount $ mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]
] ]
,test "normaliseMixedAmountSquashPricesForDisplay" $ do ,test "normaliseMixedAmountSquashPricesForDisplay" $ do
normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt] amounts (normaliseMixedAmountSquashPricesForDisplay nullmixedamt) @?= [nullamt]
assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay
(Mixed [usd 10 (mixed [usd 10
,usd 10 @@ eur 7 ,usd 10 @@ eur 7
,usd (-10) ,usd (-10)
,usd (-10) @@ eur 7 ,usd (-10) @@ eur (-7)
]) ])
] ]

View File

@ -524,7 +524,7 @@ filterTransactionAmounts q t@Transaction{tpostings=ps} = t{tpostings=map (filter
-- | Filter out all parts of this posting's amount which do not match the query. -- | Filter out all parts of this posting's amount which do not match the query.
filterPostingAmount :: Query -> Posting -> Posting filterPostingAmount :: Query -> Posting -> Posting
filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as} filterPostingAmount q p@Posting{pamount=as} = p{pamount=filterMixedAmount (q `matchesAmount`) as}
filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings :: Query -> Transaction -> Transaction
filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}
@ -897,21 +897,15 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
return p return p
-- no explicit posting amount, but there is a balance assignment -- no explicit posting amount, but there is a balance assignment
-- TODO this doesn't yet handle inclusive assignments right, #1207
| Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do | Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do
(diff,newbal) <- case batotal of newbal <- if batotal
-- a total balance assignment (==, all commodities) -- a total balance assignment (==, all commodities)
True -> do then return $ mixedAmount baamount
let newbal = Mixed [baamount] -- a partial balance assignment (=, one commodity)
diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal else do
return (diff,newbal) oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
-- a partial balance assignment (=, one commodity) return $ maAddAmount oldbalothercommodities baamount
False -> do diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
let assignedbalthiscommodity = Mixed [baamount]
newbal = maPlus oldbalothercommodities assignedbalthiscommodity
diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
return (diff,newbal)
let p' = p{pamount=diff, poriginal=Just $ originalPosting p} let p' = p{pamount=diff, poriginal=Just $ originalPosting p}
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal
return p' return p'
@ -1153,7 +1147,7 @@ canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=m
-- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} -- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps}
-- where -- where
-- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} -- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}
-- fixmixedamount (Mixed as) = Mixed $ map fixamount as -- fixmixedamount = mapMixedAmount fixamount
-- fixamount = fixprice -- fixamount = fixprice
-- fixprice a@Amount{price=Just _} = a -- fixprice a@Amount{price=Just _} = a
-- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c} -- fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c}
@ -1182,8 +1176,8 @@ journalInferMarketPricesFromTransactions j =
postingInferredmarketPrice :: Posting -> Maybe MarketPrice postingInferredmarketPrice :: Posting -> Maybe MarketPrice
postingInferredmarketPrice p@Posting{pamount} = postingInferredmarketPrice p@Posting{pamount} =
-- convert any total prices to unit prices -- convert any total prices to unit prices
case mixedAmountTotalPriceToUnitPrice pamount of case amounts $ mixedAmountTotalPriceToUnitPrice pamount of
Mixed ( Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})} : _) -> Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->
Just MarketPrice { Just MarketPrice {
mpdate = postingDate p mpdate = postingDate p
,mpfrom = fromcomm ,mpfrom = fromcomm
@ -1561,7 +1555,7 @@ tests_Journal = tests "Journal" [
]} ]}
assertRight ej assertRight ej
let Right j = ej let Right j = ej
(jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1] (jtxns j & head & tpostings & head & pamount) @?= mixedAmount (num 1)
,test "same-day-1" $ do ,test "same-day-1" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions True $

View File

@ -202,8 +202,7 @@ sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt
-- | Remove all prices of a posting -- | Remove all prices of a posting
removePrices :: Posting -> Posting removePrices :: Posting -> Posting
removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } removePrices = postingTransformAmount (mapMixedAmount $ \a -> a{aprice=Nothing})
where remove a = a { aprice = Nothing }
-- | Get a posting's (primary) date - it's own primary date if specified, -- | Get a posting's (primary) date - it's own primary date if specified,
-- otherwise the parent transaction's primary date, or the null date if -- otherwise the parent transaction's primary date, or the null date if

View File

@ -121,7 +121,7 @@ entryFromTimeclockInOut i o
showtime = take 5 . show showtime = take 5 . show
hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
acctname = tlaccount i acctname = tlaccount i
amount = Mixed [hrs hours] amount = mixedAmount $ hrs hours
ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}] ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}]

View File

@ -551,7 +551,7 @@ priceInferrerFor t pt = inferprice
inferprice p@Posting{pamount=Mixed [a]} inferprice p@Posting{pamount=Mixed [a]}
| caninferprices && ptype p == pt && acommodity a == fromcommodity | caninferprices && ptype p == pt && acommodity a == fromcommodity
= p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p} = p{pamount=mixedAmount $ a{aprice=Just conversionprice}, poriginal=Just $ originalPosting p}
where where
fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
totalpricesign = if aquantity a < 0 then negate else id totalpricesign = if aquantity a < 0 then negate else id

View File

@ -120,14 +120,14 @@ tmPostingRuleToFunction querytxt pr =
-- Approach 1: convert to a unit price and increase the display precision slightly -- Approach 1: convert to a unit price and increase the display precision slightly
-- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount
-- Approach 2: multiply the total price (keeping it positive) as well as the quantity -- Approach 2: multiply the total price (keeping it positive) as well as the quantity
Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount
in in
case acommodity pramount of case acommodity pramount of
"" -> Mixed as "" -> as
-- TODO multipliers with commodity symbols are not yet a documented feature. -- TODO multipliers with commodity symbols are not yet a documented feature.
-- For now: in addition to multiplying the quantity, it also replaces the -- For now: in addition to multiplying the quantity, it also replaces the
-- matched amount's commodity, display style, and price with those of the posting rule. -- matched amount's commodity, display style, and price with those of the posting rule.
c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] c -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
postingRuleMultiplier p = postingRuleMultiplier p =

View File

@ -729,7 +729,7 @@ spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp = spaceandamountormissingp =
option missingmixedamt $ try $ do option missingmixedamt $ try $ do
lift $ skipNonNewlineSpaces1 lift $ skipNonNewlineSpaces1
Mixed . (:[]) <$> amountp mixedAmount <$> amountp
-- | Parse a single-commodity amount, with optional symbol on the left -- | Parse a single-commodity amount, with optional symbol on the left
-- or right, followed by, in any order: an optional transaction price, -- or right, followed by, in any order: an optional transaction price,
@ -855,7 +855,7 @@ amountp' s =
-- | Parse a mixed amount from a string, or get an error. -- | Parse a mixed amount from a string, or get an error.
mamountp' :: String -> MixedAmount mamountp' :: String -> MixedAmount
mamountp' = Mixed . (:[]) . amountp' mamountp' = mixedAmount . amountp'
-- | Parse a minus or plus sign followed by zero or more spaces, -- | Parse a minus or plus sign followed by zero or more spaces,
-- or nothing, returning a function that negates or does nothing. -- or nothing, returning a function that negates or does nothing.
@ -1560,7 +1560,7 @@ tests_Common = tests "Common" [
assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" "" assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" ""
,tests "spaceandamountormissingp" [ ,tests "spaceandamountormissingp" [
test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ usd 47.18)
,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt ,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt
-- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
-- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing -- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing

View File

@ -1048,7 +1048,7 @@ getBalance rules record currency n = do
-- The whole CSV record is provided for the error message. -- The whole CSV record is provided for the error message.
parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount
parseAmount rules record currency s = parseAmount rules record currency s =
either mkerror (Mixed . (:[])) $ -- PARTIAL: either mkerror mixedAmount $ -- PARTIAL:
runParser (evalStateT (amountp <* eof) journalparsestate) "" $ runParser (evalStateT (amountp <* eof) journalparsestate) "" $
currency <> simplifySign s currency <> simplifySign s
where where

View File

@ -711,7 +711,7 @@ postingp mTransactionYear = do
return (status, account) return (status, account)
let (ptype, account') = (accountNamePostingType account, textUnbracket account) let (ptype, account') = (accountNamePostingType account, textUnbracket account)
lift skipNonNewlineSpaces lift skipNonNewlineSpaces
amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp amount <- option missingmixedamt $ mixedAmount <$> amountp
lift skipNonNewlineSpaces lift skipNonNewlineSpaces
massertion <- optional balanceassertionp massertion <- optional balanceassertionp
lift skipNonNewlineSpaces lift skipNonNewlineSpaces

View File

@ -125,7 +125,7 @@ tests_BalanceReport = tests "BalanceReport" [
,("income:gifts","income:gifts",0, mamountp' "$-1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00")
,("income:salary","income:salary",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with --tree" $ ,test "with --tree" $
(defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives`
@ -142,7 +142,7 @@ tests_BalanceReport = tests "BalanceReport" [
,("income:gifts","gifts",1, mamountp' "$-1.00") ,("income:gifts","gifts",1, mamountp' "$-1.00")
,("income:salary","salary",1, mamountp' "$-1.00") ,("income:salary","salary",1, mamountp' "$-1.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with --depth=N" $ ,test "with --depth=N" $
(defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`
@ -150,7 +150,7 @@ tests_BalanceReport = tests "BalanceReport" [
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, mamountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with depth:N" $ ,test "with depth:N" $
(defreportspec{rsQuery=Depth 1}, samplejournal) `gives` (defreportspec{rsQuery=Depth 1}, samplejournal) `gives`
@ -158,7 +158,7 @@ tests_BalanceReport = tests "BalanceReport" [
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, mamountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with date:" $ ,test "with date:" $
(defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives` (defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
@ -170,7 +170,7 @@ tests_BalanceReport = tests "BalanceReport" [
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0,mamountp' "$-1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with desc:" $ ,test "with desc:" $
(defreportspec{rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives` (defreportspec{rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives`
@ -178,7 +178,7 @@ tests_BalanceReport = tests "BalanceReport" [
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with not:desc:" $ ,test "with not:desc:" $
(defreportspec{rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives` (defreportspec{rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`
@ -189,7 +189,7 @@ tests_BalanceReport = tests "BalanceReport" [
,("expenses:supplies","expenses:supplies",0, mamountp' "$1.00") ,("expenses:supplies","expenses:supplies",0, mamountp' "$1.00")
,("income:gifts","income:gifts",0, mamountp' "$-1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with period on a populated period" $ ,test "with period on a populated period" $
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}}, samplejournal) `gives`
@ -198,7 +198,7 @@ tests_BalanceReport = tests "BalanceReport" [
("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
,("income:salary","income:salary",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00")
], ],
Mixed [usd 0]) mixedAmount (usd 0))
,test "with period on an unpopulated period" $ ,test "with period on an unpopulated period" $
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`

View File

@ -280,15 +280,15 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
-- - the goal is zero -- - the goal is zero
percentage :: Change -> BudgetGoal -> Maybe Percentage percentage :: Change -> BudgetGoal -> Maybe Percentage
percentage actual budget = percentage actual budget =
case (maybecost $ normaliseMixedAmount actual, maybecost $ normaliseMixedAmount budget) of case (costedAmounts actual, costedAmounts budget) of
(Mixed [a], Mixed [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b) ([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b)
-> Just $ 100 * aquantity a / aquantity b -> Just $ 100 * aquantity a / aquantity b
_ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage _ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage
Nothing Nothing
where where
maybecost = case cost_ of costedAmounts = case cost_ of
Cost -> mixedAmountCost Cost -> amounts . mixedAmountCost . normaliseMixedAmount
NoCost -> id NoCost -> amounts . normaliseMixedAmount
maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals) maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id | otherwise = id

View File

@ -591,8 +591,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
,test "with -H on a populated period" $ ,test "with -H on a populated period" $
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`
( (
[ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (Mixed [amt0 {aquantity=1}]) [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (mixedAmount amt0{aquantity=1})
, PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (Mixed [amt0 {aquantity=(-1)}]) , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (mixedAmount amt0{aquantity=(-1)})
], ],
mamountp' "$0.00") mamountp' "$0.00")
@ -600,23 +600,23 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
-- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` -- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
-- ( -- (
-- [ -- [
-- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})
-- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})
-- ], -- ],
-- Mixed [usd0]) -- mixedAmount usd0)
-- ,test "a valid history on an empty period (more complex)" $ -- ,test "a valid history on an empty period (more complex)" $
-- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
-- ( -- (
-- [ -- [
-- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})
-- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})
-- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amt0 {aquantity=(-2)}]) -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",mixedAmount amt0 {aquantity=(-2)})
-- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)})
-- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)})
-- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})
-- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})
-- ], -- ],
-- Mixed [usd0]) -- mixedAmount usd0)
] ]
] ]

View File

@ -406,10 +406,10 @@ tests_PostingsReport = tests "PostingsReport" [
-- (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`) -- (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`)
-- let ps = -- let ps =
-- [ -- [
-- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)}
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 2]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 2)}
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [usd 4]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=mixedAmount (usd 4)}
-- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 8]} -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 8)}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives` -- ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`
-- [] -- []
@ -419,21 +419,21 @@ tests_PostingsReport = tests "PostingsReport" [
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=Mixed [usd 4]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food", lpamount=mixedAmount (usd 4)}
-- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=Mixed [usd 10]} -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 10)}
-- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} -- ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,2,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,2,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=mixedAmount (usd 15)}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,1,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,1,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=mixedAmount (usd 15)}
-- ] -- ]
-- ("2008/01/01","2009/01/01",0,0,False,ts) `gives` -- ("2008/01/01","2009/01/01",0,0,False,ts) `gives`
-- [ -- [
-- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]} -- nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=mixedAmount (usd 15)}
-- ] -- ]
] ]

View File

@ -103,8 +103,7 @@ asInit d reset ui@UIState{
,asItemRenderedAmounts = map showAmountWithoutPrice amts ,asItemRenderedAmounts = map showAmountWithoutPrice amts
} }
where where
Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal amts = amounts . normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices bal
stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}
displayitems = map displayitem items displayitems = map displayitem items
-- blanks added for scrolling control, cf RegisterScreen. -- blanks added for scrolling control, cf RegisterScreen.
-- XXX Ugly. Changing to 0 helps when debugging. -- XXX Ugly. Changing to 0 helps when debugging.

View File

@ -329,7 +329,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
(mhistoricalp,followedhistoricalsofar) = (mhistoricalp,followedhistoricalsofar) =
case esSimilarTransaction of case esSimilarTransaction of
Nothing -> (Nothing,False) Nothing -> (Nothing,False)
Just Transaction{tpostings=ps} -> Just Transaction{tpostings=ps} ->
( if length ps >= pnum then Just (ps !! (pnum-1)) else Nothing ( if length ps >= pnum then Just (ps !! (pnum-1)) else Nothing
, all sameamount $ zip esPostings ps , all sameamount $ zip esPostings ps
) )
@ -343,7 +343,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $ retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $
parser parseAmountAndComment $ parser parseAmountAndComment $
withCompletion (amountCompleter def) $ withCompletion (amountCompleter def) $
defaultTo' def $ defaultTo' def $
nonEmpty $ nonEmpty $
linePrewritten (green $ printf "Amount %d%s: " pnum (showDefault def)) (fromMaybe "" $ prevAmountAndCmnt `atMay` length esPostings) "" linePrewritten (green $ printf "Amount %d%s: " pnum (showDefault def)) (fromMaybe "" $ prevAmountAndCmnt `atMay` length esPostings) ""
where where
@ -361,7 +361,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
-- eof -- eof
return (a,c) return (a,c)
balancingamt = maNegate . sumPostings $ filter isReal esPostings balancingamt = maNegate . sumPostings $ filter isReal esPostings
balancingamtfirstcommodity = Mixed . take 1 $ amounts balancingamt balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt
showamt = showamt =
showMixedAmount . mixedAmountSetPrecision showMixedAmount . mixedAmountSetPrecision
-- what should this be ? -- what should this be ?

View File

@ -181,9 +181,8 @@ postingToCSV p =
let credit = if q < 0 then showamt $ negate a_ else "" in let credit = if q < 0 then showamt $ negate a_ else "" in
let debit = if q >= 0 then showamt a_ else "" in let debit = if q >= 0 then showamt a_ else "" in
[account, amount, c, credit, debit, status, comment]) [account, amount, c, credit, debit, status, comment])
amounts . amounts $ pamount p
where where
Mixed amounts = pamount p
status = T.pack . show $ pstatus p status = T.pack . show $ pstatus p
account = showAccountName Nothing (ptype p) (paccount p) account = showAccountName Nothing (ptype p) (paccount p)
comment = T.strip $ pcomment p comment = T.strip $ pcomment p