diff --git a/bin/hledger-move.hs b/bin/hledger-move.hs index d7ae40c41..b961dea8b 100755 --- a/bin/hledger-move.hs +++ b/bin/hledger-move.hs @@ -183,7 +183,7 @@ main = do availablebal = headDef zero $ amounts $ filterMixedAmountByCommodity comm $ - mixedAmountStripPrices $ sum $ map fourth4 acctbals + mixedAmountStripCosts $ sum $ map fourth4 acctbals -- Take just enough of these account balances, in the order given, -- to cover the requested AMT. Or if there is not enough, take what is there. diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index 644468490..a9b1ff4d5 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -243,7 +243,7 @@ sortAccountTreeByAmount normalsign = mapAccounts $ \a -> a{asubs=sortSubs $ asub sortSubs = case normalsign of NormallyPositive -> sortOn (\a -> (Down $ amt a, aname a)) NormallyNegative -> sortOn (\a -> (amt a, aname a)) - amt = mixedAmountStripPrices . aibalance + amt = mixedAmountStripCosts . aibalance -- | Add extra info for this account derived from the Journal's -- account directives, if any (comment, tags, declaration order..). diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 26e8c48d6..95c3d0cdd 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -88,7 +88,7 @@ module Hledger.Data.Amount ( cshowAmount, showAmountWithZeroCommodity, showAmountDebug, - showAmountWithoutPrice, + showAmountWithoutCost, amountSetPrecision, amountSetPrecisionMin, amountSetPrecisionMax, @@ -120,7 +120,7 @@ module Hledger.Data.Amount ( filterMixedAmountByCommodity, mapMixedAmount, unifyMixedAmount, - mixedAmountStripPrices, + mixedAmountStripCosts, -- ** arithmetic mixedAmountCost, maNegate, @@ -145,8 +145,8 @@ module Hledger.Data.Amount ( showMixedAmount, showMixedAmountOneLine, showMixedAmountDebug, - showMixedAmountWithoutPrice, - showMixedAmountOneLineWithoutPrice, + showMixedAmountWithoutCost, + showMixedAmountOneLineWithoutCost, showMixedAmountElided, showMixedAmountWithZeroCommodity, showMixedAmountB, @@ -319,14 +319,15 @@ similarAmountsOp op Amount{acommodity=_, aquantity=q1, astyle=AmountStyle{aspre amountWithCommodity :: CommoditySymbol -> Amount -> Amount amountWithCommodity c a = a{acommodity=c, acost=Nothing} --- | Convert a amount to its "cost" or "selling price" in another commodity, --- using its attached cost if it has one. Notes: +-- | Convert a amount to its total cost in another commodity, +-- using its attached cost amount if it has one. Notes: -- -- - cost amounts must be MixedAmounts with exactly one component Amount -- (or there will be a runtime error XXX) -- -- - cost amounts should be positive in the Journal -- (though this is currently not enforced) +-- amountCost :: Amount -> Amount amountCost a@Amount{aquantity=q, acost=mp} = case mp of @@ -677,9 +678,9 @@ cshowAmount = wbUnpack . showAmountB def{displayColour=True} -- | Get the string representation of an amount, without any \@ cost. -- --- > showAmountWithoutPrice = wbUnpack . showAmountB noCost -showAmountWithoutPrice :: Amount -> String -showAmountWithoutPrice = wbUnpack . showAmountB noCost +-- > showAmountWithoutCost = wbUnpack . showAmountB noCost +showAmountWithoutCost :: Amount -> String +showAmountWithoutCost = wbUnpack . showAmountB noCost -- | Like showAmount, but show a zero amount's commodity if it has one. -- @@ -790,7 +791,7 @@ mixedAmount a = Mixed $ M.singleton (amountKey a) a -- | Add an Amount to a MixedAmount, normalising the result. -- Amounts with different costs are kept separate. maAddAmount :: MixedAmount -> Amount -> MixedAmount -maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstPrice (amountKey a) a ma +maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstCost (amountKey a) a ma -- | Add a collection of Amounts to a MixedAmount, normalising the result. -- Amounts with different costs are kept separate. @@ -804,7 +805,7 @@ maNegate = transformMixedAmount negate -- | Sum two MixedAmount, keeping the cost of the first if any. -- Amounts with different costs are kept separate (since 2021). maPlus :: MixedAmount -> MixedAmount -> MixedAmount -maPlus (Mixed as) (Mixed bs) = Mixed $ M.unionWith sumSimilarAmountsUsingFirstPrice as bs +maPlus (Mixed as) (Mixed bs) = Mixed $ M.unionWith sumSimilarAmountsUsingFirstCost as bs -- | Subtract a MixedAmount from another. -- Amounts with different costs are kept separate. @@ -836,7 +837,7 @@ averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` maSum as -- Ie when normalised, are all individual commodity amounts negative ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool isNegativeMixedAmount m = - case amounts $ mixedAmountStripPrices m of + case amounts $ mixedAmountStripCosts m of [] -> Just False [a] -> Just $ isNegativeAmount a as | all isNegativeAmount as -> Just True @@ -941,21 +942,14 @@ unifyMixedAmount = foldM combine 0 . amounts -- | Sum same-commodity amounts in a lossy way, applying the first -- cost to the result and discarding any other costs. Only used as a -- rendering helper. -sumSimilarAmountsUsingFirstPrice :: Amount -> Amount -> Amount -sumSimilarAmountsUsingFirstPrice a b = (a + b){acost=p} +sumSimilarAmountsUsingFirstCost :: Amount -> Amount -> Amount +sumSimilarAmountsUsingFirstCost a b = (a + b){acost=p} where p = case (acost a, acost b) of (Just (TotalCost ap), Just (TotalCost bp)) -> Just . TotalCost $ ap{aquantity = aquantity ap + aquantity bp } _ -> acost a --- -- | Sum same-commodity amounts. If there were different costs, set --- -- the cost to a special marker indicating "various". Only used as a --- -- rendering helper. --- sumSimilarAmountsNotingPriceDifference :: [Amount] -> Amount --- sumSimilarAmountsNotingPriceDifference [] = nullamt --- sumSimilarAmountsNotingPriceDifference as = undefined - -- | Filter a mixed amount's component amounts by a predicate. filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount filterMixedAmount p (Mixed ma) = Mixed $ M.filter p ma @@ -980,8 +974,7 @@ mapMixedAmount f (Mixed ma) = mixed . map f $ toList ma mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma -- Use M.map instead of fmap to maintain strictness --- | Convert all component amounts to cost/selling price where --- possible (see amountCost). +-- | Convert all component amounts to cost where possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount mixedAmountCost (Mixed ma) = foldl' (\m a -> maAddAmount m (amountCost a)) (Mixed noCosts) withCosts @@ -992,8 +985,8 @@ mixedAmountCost (Mixed ma) = -- -- For now, use this when cross-commodity zero equality is important. -- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool -- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b') --- where a' = mixedAmountStripPrices a --- b' = mixedAmountStripPrices b +-- where a' = mixedAmountStripCosts a +-- b' = mixedAmountStripCosts b -- Mixed amount styles @@ -1052,19 +1045,19 @@ showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZ -- | Get the string representation of a mixed amount, without showing any costs. -- With a True argument, adds ANSI codes to show negative amounts in red. -- --- > showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noCost{displayColour=c} -showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String -showMixedAmountWithoutPrice c = wbUnpack . showMixedAmountB noCost{displayColour=c} +-- > showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCost{displayColour=c} +showMixedAmountWithoutCost :: Bool -> MixedAmount -> String +showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCost{displayColour=c} -- | Get the one-line string representation of a mixed amount, but without -- any \@ costs. -- With a True argument, adds ANSI codes to show negative amounts in red. -- --- > showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c} -showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String -showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixedAmountB oneLine{displayColour=c} +-- > showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLine{displayColour=c} +showMixedAmountOneLineWithoutCost :: Bool -> MixedAmount -> String +showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLine{displayColour=c} --- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width, +-- | Like showMixedAmountOneLineWithoutCost, but show at most the given width, -- with an elision indicator if there are more. -- With a True argument, adds ANSI codes to show negative amounts in red. -- @@ -1107,7 +1100,7 @@ showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidt map (adBuilder . pad) elided where astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ - if displayCost opts then ma else mixedAmountStripPrices ma + if displayCost opts then ma else mixedAmountStripCosts ma sep = WideBuilder (TB.singleton '\n') 0 width = maximum $ map (wbWidth . adBuilder) elided @@ -1133,7 +1126,7 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi where width = maybe 0 adTotal $ lastMay elided astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ - if displayCost opts then ma else mixedAmountStripPrices ma + if displayCost opts then ma else mixedAmountStripCosts ma sep = WideBuilder (TB.fromString ", ") 2 n = length astrs @@ -1225,10 +1218,10 @@ mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount mixedAmountSetPrecisionMax p = mapMixedAmountUnsafe (amountSetPrecisionMax p) -- | Remove all costs from a MixedAmount. -mixedAmountStripPrices :: MixedAmount -> MixedAmount -mixedAmountStripPrices (Mixed ma) = - foldl' (\m a -> maAddAmount m a{acost=Nothing}) (Mixed noPrices) withPrices - where (noPrices, withPrices) = M.partition (isNothing . acost) ma +mixedAmountStripCosts :: MixedAmount -> MixedAmount +mixedAmountStripCosts (Mixed ma) = + foldl' (\m a -> maAddAmount m a{acost=Nothing}) (Mixed noCosts) withCosts + where (noCosts, withCosts) = M.partition (isNothing . acost) ma ------------------------------------------------------------------------------- @@ -1298,10 +1291,10 @@ tests_Amount = testGroup "Amount" [ showMixedAmount nullmixedamt @?= "0" showMixedAmount missingmixedamt @?= "" - ,testCase "showMixedAmountWithoutPrice" $ do + ,testCase "showMixedAmountWithoutCost" $ do let a = usd 1 `at` eur 2 - showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00" - showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0" + showMixedAmountWithoutCost False (mixedAmount (a)) @?= "$1.00" + showMixedAmountWithoutCost False (mixed [a, -a]) @?= "0" ,testGroup "amounts" [ testCase "a missing amount overrides any other amounts" $ @@ -1316,9 +1309,9 @@ tests_Amount = testGroup "Amount" [ amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2] ] - ,testCase "mixedAmountStripPrices" $ do - amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt] - assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices + ,testCase "mixedAmountStripCosts" $ do + amounts (mixedAmountStripCosts nullmixedamt) @?= [nullamt] + assertBool "" $ mixedAmountLooksZero $ mixedAmountStripCosts (mixed [usd 10 ,usd 10 @@ eur 7 ,usd (-10) diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index 1c4580394..4f0eb4bb5 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -105,7 +105,7 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs -- convert this posting's amount to cost, -- without getting confused by redundant costs/equity postings postingBalancingAmount p - | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p + | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripCosts $ pamount p | otherwise = mixedAmountCost $ pamount p -- transaction balancedness is checked at each commodity's display precision @@ -131,11 +131,11 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs rmsg | rsumok = "" | not rsignsok = "The real postings all have the same sign. Consider negating some of them." - | otherwise = "The real postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutPrice False rsumcost + | otherwise = "The real postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutCost False rsumcost bvmsg | bvsumok = "" | not bvsignsok = "The balanced virtual postings all have the same sign. Consider negating some of them." - | otherwise = "The balanced virtual postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutPrice False bvsumcost + | otherwise = "The balanced virtual postings' sum should be 0 but is: " ++ showMixedAmountOneLineWithoutCost False bvsumcost -- | Legacy form of transactionCheckBalanced. isTransactionBalanced :: BalancingOpts -> Transaction -> Bool @@ -541,7 +541,7 @@ balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing balanceTransactionAndCheckAssertionsB (Left p@Posting{}) = -- Update the account's running balance and check the balance assertion if any. -- Note, cost is ignored when checking balance assertions, currently. - void . addAmountAndCheckAssertionB $ postingStripPrices p + void $ addAmountAndCheckAssertionB $ postingStripCosts p balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do -- make sure we can handle the balance assignments mapM_ checkIllegalBalanceAssignmentB ps diff --git a/hledger-lib/Hledger/Data/Errors.hs b/hledger-lib/Hledger/Data/Errors.hs index 03cbae866..44920423a 100644 --- a/hledger-lib/Hledger/Data/Errors.hs +++ b/hledger-lib/Hledger/Data/Errors.hs @@ -21,7 +21,7 @@ import Data.Text (Text) import qualified Data.Text as T import Hledger.Data.Transaction (showTransaction) -import Hledger.Data.Posting (postingStripPrices) +import Hledger.Data.Posting (postingStripCosts) import Hledger.Data.Types import Hledger.Utils import Data.Maybe @@ -121,7 +121,7 @@ makePostingErrorExcerpt p findpostingerrorcolumns = (SourcePos f tl _) = fst $ tsourcepos t -- p had cost removed in balanceTransactionAndCheckAssertionsB, -- must remove them from t's postings too (#2083) - mpindex = transactionFindPostingIndex ((==p).postingStripPrices) t + mpindex = transactionFindPostingIndex ((==p).postingStripCosts) t errrelline = case mpindex of Nothing -> 0 Just pindex -> diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 4316f8311..3b64949f0 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -36,7 +36,7 @@ module Hledger.Data.Posting ( postingAllTags, transactionAllTags, relatedPostings, - postingStripPrices, + postingStripCosts, postingApplyAliases, postingApplyCommodityStyles, postingStyleAmounts, @@ -451,8 +451,8 @@ sumPostings :: [Posting] -> MixedAmount sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt -- | Strip all prices from a Posting. -postingStripPrices :: Posting -> Posting -postingStripPrices = postingTransformAmount mixedAmountStripPrices +postingStripCosts :: Posting -> Posting +postingStripCosts = postingTransformAmount mixedAmountStripCosts -- | 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/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 6c4226e43..080f55884 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -392,7 +392,7 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra | dbgamtmatch 2 a2 a (amountsMatch (-a2) a) && dbgcostmatch 1 a1 a (amountsMatch a1 (amountCost a)) -> Just costfulp | otherwise -> Nothing where - dbgamtmatch n a b = dbg7 ("conversion posting " <>show n<>" "<>showAmount a<>" balances amount "<>showAmountWithoutPrice b <>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?") + dbgamtmatch n a b = dbg7 ("conversion posting " <>show n<>" "<>showAmount a<>" balances amount "<>showAmountWithoutCost b <>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?") dbgcostmatch n a b = dbg7 ("and\nconversion posting "<>show n<>" "<>showAmount a<>" matches cost " <>showAmount (amountCost b)<>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?") -- Add a cost to a posting if it matches (negative) one of the diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 20a782c09..c3c78eb1f 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -124,7 +124,7 @@ accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = it -- speed improvement by stripping them early. In some cases, such as in hledger-ui, we still -- want to keep prices around, so we can toggle between cost and no cost quickly. We can use -- the show_costs_ flag to be efficient when we can, and detailed when we have to. - (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices) + (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripCosts) . traceOrLogAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns) -- maybe convert these transactions to cost or value . journalApplyValuationFromOpts rspec diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index e1fd468e3..b8fbc5c14 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -449,7 +449,7 @@ displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts balance = maybeStripPrices . case accountlistmode_ ropts of ALTree | d == qdepth -> aibalance _ -> aebalance - where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripPrices + where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripCosts -- Accounts interesting because they are a fork for interesting subaccounts interestingParents = dbg5 "interestingParents" $ case accountlistmode_ ropts of @@ -490,7 +490,7 @@ sortRows ropts j sortFlatMBRByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r)) NormallyNegative -> sortOn (\r -> (amt r, prrFullName r)) - where amt = mixedAmountStripPrices . prrTotal + where amt = mixedAmountStripCosts . prrTotal -- Sort the report rows by account declaration order then account name. sortMBRByAccountDeclaration :: [MultiBalanceReportRow] -> [MultiBalanceReportRow] diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 7f734e49a..1c71cc498 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -127,7 +127,7 @@ matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q} -- speed improvement by stripping them early. In some cases, such as in hledger-ui, we still -- want to keep prices around, so we can toggle between cost and no cost quickly. We can use -- the show_costs_ flag to be efficient when we can, and detailed when we have to. - . (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices) + . (if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripCosts) $ journalValueAndFilterPostings rspec{_rsQuery=beforeandduringq} j -- filter postings by the query, with no start date or depth limit diff --git a/hledger-web/Hledger/Web/Handler/RegisterR.hs b/hledger-web/Hledger/Web/Handler/RegisterR.hs index 8a5af27b0..b3bae6813 100644 --- a/hledger-web/Hledger/Web/Handler/RegisterR.hs +++ b/hledger-web/Hledger/Web/Handler/RegisterR.hs @@ -109,7 +109,7 @@ registerChartHtml q title percommoditytxnreports = $(hamletFile "templates/chart charttitle = if null title then "" else title ++ ":" colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)] - simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts . mixedAmountStripPrices + simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts . mixedAmountStripCosts showZeroCommodity = wbUnpack . showMixedAmountB oneLine{displayCost=False,displayZeroCommodity=True} shownull c = if null c then " " else c nodatelink = (RegisterR, [("q", T.unwords $ removeDates q)]) diff --git a/hledger-web/Hledger/Web/Widget/Common.hs b/hledger-web/Hledger/Web/Widget/Common.hs index 1ed40a19b..01ca30758 100644 --- a/hledger-web/Hledger/Web/Widget/Common.hs +++ b/hledger-web/Hledger/Web/Widget/Common.hs @@ -95,7 +95,7 @@ accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced mixedAmountAsHtml :: MixedAmount -> HtmlUrl a mixedAmountAsHtml b _ = - for_ (lines (showMixedAmountWithoutPrice False b)) $ \t -> do + for_ (lines (showMixedAmountWithoutCost False b)) $ \t -> do H.span ! A.class_ c $ toHtml t H.br where diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 006f6b038..852aa4a72 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -429,7 +429,7 @@ balanceReportAsCsv opts (items, total) = rows name ma = case layout_ opts of LayoutBare -> map (\a -> [showName name, acommodity a, renderAmount $ mixedAmount a]) - . amounts $ mixedAmountStripPrices ma + . amounts $ mixedAmountStripCosts ma _ -> [[showName name, renderAmount ma]] showName = accountNameDrop (drop_ opts) diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index d1f27e2c6..85c7ff81a 100644 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -130,7 +130,7 @@ close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec0} j = do -- the balances to close rspec3 = rspec1{_rsQuery=q3} (acctbals',_) = balanceReport rspec3 j - acctbals = map (\(a,_,_,b) -> (a, if show_costs_ ropts then b else mixedAmountStripPrices b)) acctbals' + acctbals = map (\(a,_,_,b) -> (a, if show_costs_ ropts then b else mixedAmountStripCosts b)) acctbals' totalamt = maSum $ map snd acctbals -- since balance assertion amounts are required to be exact, the