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