From d6a4310d8fec1241ef3582d9ed220aec511f2e3c Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sun, 31 Jan 2021 15:23:46 +1100 Subject: [PATCH] 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. --- bin/_hledger-chart.hs | 2 +- bin/hledger-check-fancyassertions.hs | 8 ++--- hledger-lib/Hledger/Data/Amount.hs | 30 ++++++++--------- hledger-lib/Hledger/Data/Journal.hs | 32 ++++++++----------- hledger-lib/Hledger/Data/Posting.hs | 3 +- hledger-lib/Hledger/Data/Timeclock.hs | 2 +- hledger-lib/Hledger/Data/Transaction.hs | 2 +- .../Hledger/Data/TransactionModifier.hs | 6 ++-- hledger-lib/Hledger/Read/Common.hs | 6 ++-- hledger-lib/Hledger/Read/CsvReader.hs | 2 +- hledger-lib/Hledger/Read/JournalReader.hs | 2 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 16 +++++----- hledger-lib/Hledger/Reports/BudgetReport.hs | 10 +++--- .../Hledger/Reports/MultiBalanceReport.hs | 26 +++++++-------- hledger-lib/Hledger/Reports/PostingsReport.hs | 20 ++++++------ hledger-ui/Hledger/UI/AccountsScreen.hs | 3 +- hledger/Hledger/Cli/Commands/Add.hs | 6 ++-- hledger/Hledger/Cli/Commands/Print.hs | 3 +- 18 files changed, 85 insertions(+), 94 deletions(-) diff --git a/bin/_hledger-chart.hs b/bin/_hledger-chart.hs index c8ced0c8d..f0601c32d 100755 --- a/bin/_hledger-chart.hs +++ b/bin/_hledger-chart.hs @@ -162,7 +162,7 @@ sameSignNonZero is | otherwise = (map pos $ filter (test.fourth4) nzs, sign) where 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) test = if sign > 0 then (>0) else (<0) diff --git a/bin/hledger-check-fancyassertions.hs b/bin/hledger-check-fancyassertions.hs index d0f111218..2f8ea1baa 100755 --- a/bin/hledger-check-fancyassertions.hs +++ b/bin/hledger-check-fancyassertions.hs @@ -223,10 +223,10 @@ checkAssertion accounts = checkAssertion' -- Add missing amounts (with 0 value), normalise, throw away style -- information, and sort by commodity name. - fixup (H.Mixed m1) (H.Mixed m2) = H.Mixed $ - let m = H.Mixed (m1 ++ [m_ { H.aquantity = 0 } | m_ <- m2]) - (H.Mixed as) = H.normaliseMixedAmount m - in sortOn H.acommodity . map (\a -> a { H.astyle = H.amountstyle }) $ as + fixup m1 m2 = + let m = H.mixed $ amounts m1 ++ [m_ { H.aquantity = 0 } | m_ <- amounts m2] + as = amounts $ H.normaliseMixedAmount m + in H.mixed $ sortOn H.acommodity . map (\a -> a { H.astyle = H.amountstyle }) $ as -- | Check if an account name is mentioned in an assertion. inAssertion :: H.AccountName -> Predicate -> Bool diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index a01330369..2633522b8 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -530,7 +530,7 @@ nullmixedamt = Mixed [] -- | A temporary value for parsed transactions which had no amount specified. missingmixedamt :: MixedAmount -missingmixedamt = Mixed [missingamt] +missingmixedamt = mixedAmount missingamt -- | Convert amounts in various commodities into a normalised MixedAmount. mixed :: [Amount] -> MixedAmount @@ -964,37 +964,37 @@ tests_Amount = tests "Amount" [ @?= Mixed [usd (-1) @@ eur 2 ] ,test "showMixedAmount" $ do - showMixedAmount (Mixed [usd 1]) @?= "$1.00" - showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00" - showMixedAmount (Mixed [usd 0]) @?= "0" - showMixedAmount (Mixed []) @?= "0" + showMixedAmount (mixedAmount (usd 1)) @?= "$1.00" + showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00" + showMixedAmount (mixedAmount (usd 0)) @?= "0" + showMixedAmount nullmixedamt @?= "0" showMixedAmount missingmixedamt @?= "" ,test "showMixedAmountWithoutPrice" $ do let a = usd 1 `at` eur 2 - showMixedAmountWithoutPrice False (Mixed [a]) @?= "$1.00" - showMixedAmountWithoutPrice False (Mixed [a, -a]) @?= "0" + showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00" + showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0" ,tests "normaliseMixedAmount" [ 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" $ - 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" $ - 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" $ - 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" $ - 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 - normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt] + amounts (normaliseMixedAmountSquashPricesForDisplay nullmixedamt) @?= [nullamt] assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay - (Mixed [usd 10 + (mixed [usd 10 ,usd 10 @@ eur 7 ,usd (-10) - ,usd (-10) @@ eur 7 + ,usd (-10) @@ eur (-7) ]) ] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 867140e42..78f23103a 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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. 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 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 -- 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 - (diff,newbal) <- case batotal of - -- a total balance assignment (==, all commodities) - True -> do - let newbal = Mixed [baamount] - diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal - return (diff,newbal) - -- a partial balance assignment (=, one commodity) - False -> do - 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) + newbal <- if batotal + -- a total balance assignment (==, all commodities) + then return $ mixedAmount baamount + -- a partial balance assignment (=, one commodity) + else do + oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc + return $ maAddAmount oldbalothercommodities baamount + diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal let p' = p{pamount=diff, poriginal=Just $ originalPosting p} whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal 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} -- where -- fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a} --- fixmixedamount (Mixed as) = Mixed $ map fixamount as +-- fixmixedamount = mapMixedAmount fixamount -- fixamount = fixprice -- fixprice a@Amount{price=Just _} = a -- 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 p@Posting{pamount} = -- convert any total prices to unit prices - case mixedAmountTotalPriceToUnitPrice pamount of - Mixed ( Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})} : _) -> + case amounts $ mixedAmountTotalPriceToUnitPrice pamount of + Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ -> Just MarketPrice { mpdate = postingDate p ,mpfrom = fromcomm @@ -1561,7 +1555,7 @@ tests_Journal = tests "Journal" [ ]} assertRight 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 assertRight $ journalBalanceTransactions True $ diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 866fb6698..c06bbbf16 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -202,8 +202,7 @@ sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt -- | Remove all prices of a posting removePrices :: Posting -> Posting -removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) } - where remove a = a { aprice = Nothing } +removePrices = postingTransformAmount (mapMixedAmount $ \a -> a{aprice=Nothing}) -- | 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 diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 2d5f1fea2..8e121d6f7 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -121,7 +121,7 @@ entryFromTimeclockInOut i o showtime = take 5 . show hours = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc acctname = tlaccount i - amount = Mixed [hrs hours] + amount = mixedAmount $ hrs hours ps = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 290344741..45c0c8f7a 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -551,7 +551,7 @@ priceInferrerFor t pt = inferprice inferprice p@Posting{pamount=Mixed [a]} | 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 fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe totalpricesign = if aquantity a < 0 then negate else id diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 3a09b03a3..2a493a4a1 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -120,14 +120,14 @@ tmPostingRuleToFunction querytxt pr = -- Approach 1: convert to a unit price and increase the display precision slightly -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- 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 case acommodity pramount of - "" -> Mixed as + "" -> as -- TODO multipliers with commodity symbols are not yet a documented feature. -- 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. - 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 p = diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 3d6731493..fee9e7824 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -729,7 +729,7 @@ spaceandamountormissingp :: JournalParser m MixedAmount spaceandamountormissingp = option missingmixedamt $ try $ do lift $ skipNonNewlineSpaces1 - Mixed . (:[]) <$> amountp + mixedAmount <$> amountp -- | Parse a single-commodity amount, with optional symbol on the left -- 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. mamountp' :: String -> MixedAmount -mamountp' = Mixed . (:[]) . amountp' +mamountp' = mixedAmount . amountp' -- | Parse a minus or plus sign followed by zero or more spaces, -- or nothing, returning a function that negates or does nothing. @@ -1560,7 +1560,7 @@ tests_Common = tests "Common" [ assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" "" ,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 "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 2a9fdbb7c..d5f224bc9 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -1048,7 +1048,7 @@ getBalance rules record currency n = do -- The whole CSV record is provided for the error message. parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount rules record currency s = - either mkerror (Mixed . (:[])) $ -- PARTIAL: + either mkerror mixedAmount $ -- PARTIAL: runParser (evalStateT (amountp <* eof) journalparsestate) "" $ currency <> simplifySign s where diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 027df37d7..1b5810ccb 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -711,7 +711,7 @@ postingp mTransactionYear = do return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift skipNonNewlineSpaces - amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp + amount <- option missingmixedamt $ mixedAmount <$> amountp lift skipNonNewlineSpaces massertion <- optional balanceassertionp lift skipNonNewlineSpaces diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 71ba82802..6cf73520b 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -125,7 +125,7 @@ tests_BalanceReport = tests "BalanceReport" [ ,("income:gifts","income:gifts",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with --tree" $ (defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives` @@ -142,7 +142,7 @@ tests_BalanceReport = tests "BalanceReport" [ ,("income:gifts","gifts",1, mamountp' "$-1.00") ,("income:salary","salary",1, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with --depth=N" $ (defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives` @@ -150,7 +150,7 @@ tests_BalanceReport = tests "BalanceReport" [ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with depth:N" $ (defreportspec{rsQuery=Depth 1}, samplejournal) `gives` @@ -158,7 +158,7 @@ tests_BalanceReport = tests "BalanceReport" [ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with date:" $ (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") ,("income:salary","income:salary",0,mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with desc:" $ (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") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with not:desc:" $ (defreportspec{rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives` @@ -189,7 +189,7 @@ tests_BalanceReport = tests "BalanceReport" [ ,("expenses:supplies","expenses:supplies",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" $ (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") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd 0]) + mixedAmount (usd 0)) ,test "with period on an unpopulated period" $ (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives` diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index eab7b8ab7..26aa97e82 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -280,15 +280,15 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ -- - the goal is zero percentage :: Change -> BudgetGoal -> Maybe Percentage percentage actual budget = - case (maybecost $ normaliseMixedAmount actual, maybecost $ normaliseMixedAmount budget) of - (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b) + case (costedAmounts actual, costedAmounts budget) of + ([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b) -> Just $ 100 * aquantity a / aquantity b _ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage Nothing where - maybecost = case cost_ of - Cost -> mixedAmountCost - NoCost -> id + costedAmounts = case cost_ of + Cost -> amounts . mixedAmountCost . normaliseMixedAmount + NoCost -> amounts . normaliseMixedAmount maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index bcf72b866..5c7ed4a51 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -591,8 +591,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [ ,test "with -H on a populated period" $ (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 "income:salary") [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") (mixedAmount amt0{aquantity=(-1)}) ], 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` -- ( -- [ - -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) - -- ,("income:salary","salary",2, [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",mixedAmount amt0 {aquantity=(-1)}) -- ], - -- Mixed [usd0]) + -- mixedAmount usd0) -- ,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` -- ( -- [ - -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) - -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) - -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amt0 {aquantity=(-2)}]) - -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) - -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) - -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) - -- ,("income:salary","salary",2, [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",mixedAmount amt0 {aquantity=1}) + -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",mixedAmount amt0 {aquantity=(-2)}) + -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount 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",mixedAmount amt0 {aquantity=(-1)}) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)}) -- ], - -- Mixed [usd0]) + -- mixedAmount usd0) ] ] diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 4346dff32..a51db0f7b 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -406,10 +406,10 @@ tests_PostingsReport = tests "PostingsReport" [ -- (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`) -- let ps = -- [ - -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 2]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=Mixed [usd 4]} - -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=Mixed [usd 8]} + -- nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 2)} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food", lpamount=mixedAmount (usd 4)} + -- ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining", lpamount=mixedAmount (usd 8)} -- ] -- ("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` -- [ - -- 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:dining", lpamount=Mixed [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", lpamount=mixedAmount (usd 4)} + -- ,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=mixedAmount (usd 1)} -- ] -- ("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` -- [ - -- 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` -- [ - -- 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)} -- ] ] diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index d1b958eea..122673d48 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -103,8 +103,7 @@ asInit d reset ui@UIState{ ,asItemRenderedAmounts = map showAmountWithoutPrice amts } where - Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal - stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing} + amts = amounts . normaliseMixedAmountSquashPricesForDisplay $ mixedAmountStripPrices bal displayitems = map displayitem items -- blanks added for scrolling control, cf RegisterScreen. -- XXX Ugly. Changing to 0 helps when debugging. diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 5b9802e56..20a9c5f17 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -329,7 +329,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do (mhistoricalp,followedhistoricalsofar) = case esSimilarTransaction of Nothing -> (Nothing,False) - Just Transaction{tpostings=ps} -> + Just Transaction{tpostings=ps} -> ( if length ps >= pnum then Just (ps !! (pnum-1)) else Nothing , 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\"." $ parser parseAmountAndComment $ withCompletion (amountCompleter def) $ - defaultTo' def $ + defaultTo' def $ nonEmpty $ linePrewritten (green $ printf "Amount %d%s: " pnum (showDefault def)) (fromMaybe "" $ prevAmountAndCmnt `atMay` length esPostings) "" where @@ -361,7 +361,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do -- eof return (a,c) balancingamt = maNegate . sumPostings $ filter isReal esPostings - balancingamtfirstcommodity = Mixed . take 1 $ amounts balancingamt + balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt showamt = showMixedAmount . mixedAmountSetPrecision -- what should this be ? diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 58248b293..78c8319e2 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -181,9 +181,8 @@ postingToCSV p = let credit = if q < 0 then showamt $ negate a_ else "" in let debit = if q >= 0 then showamt a_ else "" in [account, amount, c, credit, debit, status, comment]) - amounts + . amounts $ pamount p where - Mixed amounts = pamount p status = T.pack . show $ pstatus p account = showAccountName Nothing (ptype p) (paccount p) comment = T.strip $ pcomment p