From 0cb382cf0e14c7dc1a2fbc7e55be3eed331b4d9d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 23 Jan 2024 11:28:19 -1000 Subject: [PATCH] dev: rename AmountDisplayOpts -> AmountFormat, and related constants noColour -> defaultFmt noCost -> noCostFmt oneLine -> oneLineFmt csvDisplay -> machineFmt --- hledger-lib/Hledger/Data/Account.hs | 8 +- hledger-lib/Hledger/Data/Amount.hs | 107 ++++++++++--------- hledger-lib/Hledger/Data/Posting.hs | 4 +- hledger-lib/Hledger/Data/Types.hs | 11 +- hledger-lib/Hledger/Read/RulesReader.hs | 2 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 8 +- hledger-ui/Hledger/UI/AccountsScreen.hs | 4 +- hledger-ui/Hledger/UI/UIScreens.hs | 2 +- hledger-web/Hledger/Web/Handler/RegisterR.hs | 2 +- hledger/Hledger/Cli/Commands/Add.hs | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 10 +- hledger/Hledger/Cli/Commands/Balance.hs | 12 +-- hledger/Hledger/Cli/Commands/Prices.hs | 2 +- hledger/Hledger/Cli/Commands/Print.hs | 2 +- hledger/Hledger/Cli/Commands/Register.hs | 4 +- hledger/Hledger/Cli/Utils.hs | 2 +- hledger/test/json.test | 8 +- 17 files changed, 98 insertions(+), 92 deletions(-) diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index a9b1ff4d5..0e7fadc14 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/hledger-lib/Hledger/Data/Account.hs @@ -52,8 +52,8 @@ instance Show Account where aname (if aboring then "y" else "n" :: String) anumpostings - (wbUnpack $ showMixedAmountB noColour aebalance) - (wbUnpack $ showMixedAmountB noColour aibalance) + (wbUnpack $ showMixedAmountB defaultFmt aebalance) + (wbUnpack $ showMixedAmountB defaultFmt aibalance) instance Eq Account where (==) a b = aname a == aname b -- quick equality test for speed @@ -303,6 +303,6 @@ showAccountsBoringFlag = unlines . map (show . aboring) . flattenAccounts showAccountDebug a = printf "%-25s %4s %4s %s" (aname a) - (wbUnpack . showMixedAmountB noColour $ aebalance a) - (wbUnpack . showMixedAmountB noColour $ aibalance a) + (wbUnpack . showMixedAmountB defaultFmt $ aebalance a) + (wbUnpack . showMixedAmountB defaultFmt $ aibalance a) (if aboring a then "b" else " " :: String) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 4edde6040..a45e42999 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -77,11 +77,11 @@ module Hledger.Data.Amount ( amountStylesSetRounding, amountUnstyled, -- ** rendering - AmountDisplayOpts(..), - noColour, - noCost, - oneLine, - csvDisplay, + AmountFormat(..), + defaultFmt, + noCostFmt, + oneLineFmt, + machineFmt, showAmountB, showAmount, showAmountsCostB, @@ -215,9 +215,10 @@ quoteCommoditySymbolIfNeeded s | otherwise = s --- | Options for the display of Amount and MixedAmount. --- (ee also Types.AmountStyle. -data AmountDisplayOpts = AmountDisplayOpts +-- | Options for displaying Amounts and MixedAmounts. +-- Similar to "AmountStyle" but lower level. +-- See also hledger manual > "Amount formatting, parseability", which speaks of human, hledger, and machine output. +data AmountFormat = AmountFormat { displayCommodity :: Bool -- ^ Whether to display commodity symbols. , displayZeroCommodity :: Bool -- ^ Whether to display commodity symbols for zero Amounts. , displayCommodityOrder :: Maybe [CommoditySymbol] @@ -234,17 +235,17 @@ data AmountDisplayOpts = AmountDisplayOpts , displayColour :: Bool -- ^ Whether to ansi-colourise negative Amounts. } deriving (Show) --- | By default, display Amount and MixedAmount using @noColour@ amount display options. -instance Default AmountDisplayOpts where def = noColour +-- | By default, display amounts using @defaultFmt@ amount display options. +instance Default AmountFormat where def = defaultFmt -- | Display amounts without colour, and with various other defaults. -noColour :: AmountDisplayOpts -noColour = AmountDisplayOpts { +defaultFmt :: AmountFormat +defaultFmt = AmountFormat { displayCommodity = True , displayZeroCommodity = False , displayCommodityOrder = Nothing , displayDigitGroups = True - , displayForceDecimalMark = False + , displayForceDecimalMark = False , displayOneLine = False , displayMinWidth = Just 0 , displayMaxWidth = Nothing @@ -252,17 +253,17 @@ noColour = AmountDisplayOpts { , displayColour = False } --- | Display Amount and MixedAmount with no costs. -noCost :: AmountDisplayOpts -noCost = def{displayCost=False} +-- | Like defaultFmt but don't show costs. +noCostFmt :: AmountFormat +noCostFmt = defaultFmt{displayCost=False} --- | Display Amount and MixedAmount on one line with no costs. -oneLine :: AmountDisplayOpts -oneLine = def{displayOneLine=True, displayCost=False} +-- | Like noCostFmt but display amounts on one line rather than several. +oneLineFmt :: AmountFormat +oneLineFmt = noCostFmt{displayOneLine=True} --- | Display Amount and MixedAmount in a form suitable for CSV output. -csvDisplay :: AmountDisplayOpts -csvDisplay = oneLine{displayDigitGroups=False} +-- | A (slightly more) machine-readable amount format; like oneLineFmt but don't show digit group marks. +machineFmt :: AmountFormat +machineFmt = oneLineFmt{displayDigitGroups=False} ------------------------------------------------------------------------------- -- Amount arithmetic @@ -621,8 +622,8 @@ withDecimalPoint = flip setAmountDecimalPoint showAmountsCostB :: Amount -> WideBuilder showAmountsCostB amt = case acost amt of Nothing -> mempty - Just (UnitCost pa) -> WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour{displayZeroCommodity=True} pa - Just (TotalCost pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour{displayZeroCommodity=True} (sign pa) + Just (UnitCost pa) -> WideBuilder (TB.fromString " @ ") 3 <> showAmountB defaultFmt{displayZeroCommodity=True} pa + Just (TotalCost pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB defaultFmt{displayZeroCommodity=True} (sign pa) where sign = if aquantity amt < 0 then negate else id showAmountCostDebug :: Maybe AmountCost -> String @@ -635,12 +636,12 @@ showAmountCostDebug (Just (TotalCost pa)) = " @@ " ++ showAmountDebug pa -- zero are converted to just \"0\". The special "missing" amount is -- displayed as the empty string. -- --- > showAmount = wbUnpack . showAmountB noColour +-- > showAmount = wbUnpack . showAmountB defaultFmt showAmount :: Amount -> String -showAmount = wbUnpack . showAmountB noColour +showAmount = wbUnpack . showAmountB defaultFmt -- | General function to generate a WideBuilder for an Amount, according the --- supplied AmountDisplayOpts. This is the main function to use for showing +-- supplied AmountFormat. This is the main function to use for showing -- Amounts, constructing a builder; it can then be converted to a Text with -- wbToText, or to a String with wbUnpack. -- Some special cases: @@ -651,10 +652,10 @@ showAmount = wbUnpack . showAmountB noColour -- we force showing a decimal mark (with nothing after it) to make -- it easier to parse correctly. -- -showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder +showAmountB :: AmountFormat -> Amount -> WideBuilder showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB - AmountDisplayOpts{displayCommodity, displayZeroCommodity, displayDigitGroups + AmountFormat{displayCommodity, displayZeroCommodity, displayDigitGroups ,displayForceDecimalMark, displayCost, displayColour} a@Amount{astyle=style} = color $ case ascommodityside style of @@ -679,15 +680,15 @@ cshowAmount = wbUnpack . showAmountB def{displayColour=True} -- | Get the string representation of an amount, without any \@ cost. -- --- > showAmountWithoutCost = wbUnpack . showAmountB noCost +-- > showAmountWithoutCost = wbUnpack . showAmountB noCostFmt showAmountWithoutCost :: Amount -> String -showAmountWithoutCost = wbUnpack . showAmountB noCost +showAmountWithoutCost = wbUnpack . showAmountB noCostFmt -- | Like showAmount, but show a zero amount's commodity if it has one. -- --- > showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeryCommodity=True} +-- > showAmountWithZeroCommodity = wbUnpack . showAmountB defaultFmt{displayZeryCommodity=True} showAmountWithZeroCommodity :: Amount -> String -showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeroCommodity=True} +showAmountWithZeroCommodity = wbUnpack . showAmountB defaultFmt{displayZeroCommodity=True} -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail. @@ -1026,45 +1027,45 @@ mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled -- normalising it to one amount per commodity. Assumes amounts have -- no or similar costs, otherwise this can show misleading costs. -- --- > showMixedAmount = wbUnpack . showMixedAmountB noColour +-- > showMixedAmount = wbUnpack . showMixedAmountB defaultFmt showMixedAmount :: MixedAmount -> String -showMixedAmount = wbUnpack . showMixedAmountB noColour +showMixedAmount = wbUnpack . showMixedAmountB defaultFmt -- | Get the one-line string representation of a mixed amount (also showing any costs). -- --- > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine +-- > showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLineFmt showMixedAmountOneLine :: MixedAmount -> String -showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLine{displayCost=True} +showMixedAmountOneLine = wbUnpack . showMixedAmountB oneLineFmt{displayCost=True} -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one. -- --- > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True} +-- > showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB defaultFmt{displayZeroCommodity=True} showMixedAmountWithZeroCommodity :: MixedAmount -> String -showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB noColour{displayZeroCommodity=True} +showMixedAmountWithZeroCommodity = wbUnpack . showMixedAmountB defaultFmt{displayZeroCommodity=True} -- | 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. -- --- > showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCost{displayColour=c} +-- > showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCostFmt{displayColour=c} showMixedAmountWithoutCost :: Bool -> MixedAmount -> String -showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCost{displayColour=c} +showMixedAmountWithoutCost c = wbUnpack . showMixedAmountB noCostFmt{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. -- --- > showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLine{displayColour=c} +-- > showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLineFmt{displayColour=c} showMixedAmountOneLineWithoutCost :: Bool -> MixedAmount -> String -showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLine{displayColour=c} +showMixedAmountOneLineWithoutCost c = wbUnpack . showMixedAmountB oneLineFmt{displayColour=c} -- | 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. -- --- > showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w} +-- > showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLineFmt{displayColour=c, displayMaxWidth=Just w} showMixedAmountElided :: Int -> Bool -> MixedAmount -> String -showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLine{displayColour=c, displayMaxWidth=Just w} +showMixedAmountElided w c = wbUnpack . showMixedAmountB oneLineFmt{displayColour=c, displayMaxWidth=Just w} -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String @@ -1073,7 +1074,7 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)" where as = intercalate "\n " $ map showAmountDebug $ amounts m -- | General function to generate a WideBuilder for a MixedAmount, according to the --- supplied AmountDisplayOpts. This is the main function to use for showing +-- supplied AmountFormat. This is the main function to use for showing -- MixedAmounts, constructing a builder; it can then be converted to a Text with -- wbToText, or to a String with wbUnpack. -- @@ -1084,7 +1085,7 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)" -- exceed the requested maximum width. -- - If displayed on multiple lines, any Amounts longer than the -- maximum width will be elided. -showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder +showMixedAmountB :: AmountFormat -> MixedAmount -> WideBuilder showMixedAmountB opts ma | displayOneLine opts = showMixedAmountOneLineB opts ma | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep ls) width @@ -1096,8 +1097,8 @@ showMixedAmountB opts ma -- | Helper for showMixedAmountB (and postingAsLines, ...) to show a list of Amounts on multiple lines. -- This returns the list of WideBuilders: one for each Amount, and padded/elided to the appropriate width. -- This does not honour displayOneLine; all amounts will be displayed as if displayOneLine were False. -showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder] -showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = +showMixedAmountLinesB :: AmountFormat -> MixedAmount -> [WideBuilder] +showMixedAmountLinesB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma = map (adBuilder . pad) elided where astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ @@ -1120,8 +1121,8 @@ showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidt -- | Helper for showMixedAmountB to deal with single line displays. This does not -- honour displayOneLine: all amounts will be displayed as if displayOneLine -- were True. -showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> WideBuilder -showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = +showMixedAmountOneLineB :: AmountFormat -> MixedAmount -> WideBuilder +showMixedAmountOneLineB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma = WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) . max width $ fromMaybe 0 mmin where @@ -1152,8 +1153,8 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi -- Get a mixed amount's component amounts with a bit of cleanup, -- optionally preserving multiple zeros in different commodities, -- optionally sorting them according to a commodity display order. -orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount] -orderedAmounts AmountDisplayOpts{displayZeroCommodity=preservezeros, displayCommodityOrder=mcommodityorder} = +orderedAmounts :: AmountFormat -> MixedAmount -> [Amount] +orderedAmounts AmountFormat{displayZeroCommodity=preservezeros, displayCommodityOrder=mcommodityorder} = if preservezeros then amountsPreservingZeros else amounts <&> maybe id (mapM findfirst) mcommodityorder -- maybe sort them (somehow..) where diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 3b64949f0..694d2afbd 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -292,7 +292,7 @@ postingAsLines elideamount onelineamounts acctwidth amtwidth p = shownAmounts | elideamount = [mempty] | otherwise = showMixedAmountLinesB displayopts $ pamount p - where displayopts = noColour{ + where displayopts = defaultFmt{ displayZeroCommodity=True, displayForceDecimalMark=True, displayOneLine=onelineamounts } thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts @@ -361,7 +361,7 @@ postingAsLinesBeancount elideamount acctwidth amtwidth p = | elideamount = [mempty] | otherwise = showMixedAmountLinesB displayopts a' where - displayopts = noColour{ displayZeroCommodity=True, displayForceDecimalMark=True } + displayopts = defaultFmt{ displayZeroCommodity=True, displayForceDecimalMark=True } a' = mapMixedAmount amountToBeancount $ pamount p thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index f3dac774e..f5f77657d 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -250,8 +250,13 @@ data AmountCost = UnitCost !Amount | TotalCost !Amount deriving (Eq,Ord,Generic,Show) -- | Every Amount has one of these, influencing how the amount is displayed. --- Also, each Commodity can have one, which can be applied to its amounts for consistent display. --- See also Amount.AmountDisplayOpts. +-- Also each Commodity has one, inferred from the corresponding amounts, directives and options, +-- then applied to all of its amounts for consistent display. +-- Similar to "AmountFormat" but higher level. +-- See also: +-- - hledger manual > Commodity styles +-- - hledger manual > Amounts +-- - hledger manual > Commodity display style data AmountStyle = AmountStyle { ascommodityside :: !Side, -- ^ show the symbol on the left or the right ? ascommodityspaced :: !Bool, -- ^ show a space between symbol and quantity ? @@ -261,7 +266,7 @@ data AmountStyle = AmountStyle { asrounding :: !Rounding -- ^ "rounding strategy" - kept here for convenience, for now: -- when displaying an amount, it is ignored, -- but when applying this style to another amount, it determines - -- how hard we should try to adjust the amount's display precision. + -- how hard we should try to adjust that amount's display precision. } deriving (Eq,Ord,Read,Generic) instance Show AmountStyle where diff --git a/hledger-lib/Hledger/Read/RulesReader.hs b/hledger-lib/Hledger/Read/RulesReader.hs index d08486ed6..dd8d81ef1 100644 --- a/hledger-lib/Hledger/Read/RulesReader.hs +++ b/hledger-lib/Hledger/Read/RulesReader.hs @@ -1747,7 +1747,7 @@ getAmount rules record currency p1IsVirtual n = ] ++ ["rule \"" <> f <> " " <> fromMaybe "" (hledgerField rules record f) <> - "\" assigned value \"" <> wbToText (showMixedAmountB noColour a) <> "\"" -- XXX not sure this is showing all the right info + "\" assigned value \"" <> wbToText (showMixedAmountB defaultFmt a) <> "\"" -- XXX not sure this is showing all the right info | (f,a) <- fs ] ++ ["" diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 3daeac9b7..251c45ab7 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -337,9 +337,9 @@ budgetReportAsTable rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget) rowfuncs cs = case layout_ of LayoutWide width -> - ( pure . showMixedAmountB oneLine{displayMaxWidth=width, displayColour=color_} + ( pure . showMixedAmountB oneLineFmt{displayMaxWidth=width, displayColour=color_} , \a -> pure . percentage a) - _ -> ( showMixedAmountLinesB noCost{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_} + _ -> ( showMixedAmountLinesB noCostFmt{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_} , \a b -> fmap (percentage' a b) cs) showrow :: [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)] @@ -466,7 +466,7 @@ budgetReportAsCsv where flattentuples tups = concat [[a,b] | (a,b) <- tups] - showNorm = maybe "" (wbToText . showMixedAmountB oneLine) + showNorm = maybe "" (wbToText . showMixedAmountB oneLineFmt) rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text) -> PeriodicReportRow a BudgetCell @@ -480,7 +480,7 @@ budgetReportAsCsv $ vals where cs = S.toList . foldl' S.union mempty . fmap maCommodities $ catMaybes vals - dopts = oneLine{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing} + dopts = oneLineFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing} vals = flattentuples as ++ concat [[rowtot, budgettot] | row_total_] ++ concat [[rowavg, budgetavg] | average_] diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index eb20037a4..10e7b731b 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -80,7 +80,7 @@ asDrawHelper UIState{aScreen=scr, aopts=uopts, ajournal=j, aMode=mode} ropts scr displayitems = ass ^. assList . listElementsL acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems - balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems + balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLineFmt) . asItemMixedAmount) displayitems preferredacctwidth = V.maximum acctwidths totalacctwidthseen = V.sum acctwidths preferredbalwidth = V.maximum balwidths @@ -169,7 +169,7 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = splitAmounts balBuilder where balBuilder = maybe mempty showamt asItemMixedAmount - showamt = showMixedAmountB oneLine{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth} + showamt = showMixedAmountB oneLineFmt{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth} balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " " splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText renderamt :: T.Text -> Widget Name diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index 081de69d7..67f12a5e4 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -291,7 +291,7 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = ,rsItemTransaction = t } where - showamt = showMixedAmountB oneLine{displayMaxWidth=Just 3} + showamt = showMixedAmountB oneLineFmt{displayMaxWidth=Just 3} wd = whichDate ropts' -- blank items are added to allow more control of scroll position; we won't allow movement over these. diff --git a/hledger-web/Hledger/Web/Handler/RegisterR.hs b/hledger-web/Hledger/Web/Handler/RegisterR.hs index b3bae6813..2bce45854 100644 --- a/hledger-web/Hledger/Web/Handler/RegisterR.hs +++ b/hledger-web/Hledger/Web/Handler/RegisterR.hs @@ -110,7 +110,7 @@ registerChartHtml q title percommoditytxnreports = $(hamletFile "templates/chart colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)] simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts . mixedAmountStripCosts - showZeroCommodity = wbUnpack . showMixedAmountB oneLine{displayCost=False,displayZeroCommodity=True} + showZeroCommodity = wbUnpack . showMixedAmountB oneLineFmt{displayCost=False,displayZeroCommodity=True} shownull c = if null c then " " else c nodatelink = (RegisterR, [("q", T.unwords $ removeDates q)]) diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 7a3fbb951..0c9663e69 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -361,7 +361,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do return (a,c) balancingamt = maNegate . sumPostings $ filter isReal esPostings balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt - showamt = wbUnpack . showMixedAmountB noColour . mixedAmountSetPrecision + showamt = wbUnpack . showMixedAmountB defaultFmt . mixedAmountSetPrecision -- what should this be ? -- 1 maxprecision (show all decimal places or none) ? -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ? diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 988745759..b4d571aee 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -128,8 +128,8 @@ accountTransactionsReportItemAsCsvRecord where idx = T.pack $ show tindex date = showDate $ transactionRegisterDate wd reportq thisacctq t - amt = wbToText $ showMixedAmountB csvDisplay change - bal = wbToText $ showMixedAmountB csvDisplay balance + amt = wbToText $ showMixedAmountB machineFmt change + bal = wbToText $ showMixedAmountB machineFmt balance -- | Render a register report as a HTML snippet. accountTransactionsReportAsHTML :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text @@ -148,9 +148,9 @@ htmlRow CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} reportq thisacctq L.tr_ (do (L.td_ . toHtml . show . transactionRegisterDate (whichDate ropts) reportq thisacctq) t (L.td_ . toHtml) tdescription (L.td_ . toHtml) otheracctsstr - -- piggy back on the oneLine display style for now. - (L.td_ . toHtml . wbUnpack . showMixedAmountB oneLine) amt - (L.td_ . toHtml . wbUnpack . showMixedAmountB oneLine) bal) + -- piggy back on the oneLineFmt display style for now. + (L.td_ . toHtml . wbUnpack . showMixedAmountB oneLineFmt) amt + (L.td_ . toHtml . wbUnpack . showMixedAmountB oneLineFmt) bal) -- | Render a register report as plain text suitable for console output. accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 852aa4a72..9adadb4f2 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -435,7 +435,7 @@ balanceReportAsCsv opts (items, total) = showName = accountNameDrop (drop_ opts) renderAmount amt = wbToText $ showMixedAmountB bopts amt where - bopts = csvDisplay{displayCommodity=showcomm, displayCommodityOrder = commorder} + bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder} (showcomm, commorder) | layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities amt) | otherwise = (True, Nothing) @@ -470,7 +470,7 @@ balanceReportAsText' opts ((items, total)) = [ Cell TopRight damts , Cell TopLeft (fmap wbFromText cs) , Cell TopLeft (replicate (length damts - 1) mempty ++ [wbFromText dispname]) ] - where dopts = oneLine{displayCommodity=layout_ opts /= LayoutBare, displayCommodityOrder=Just cs, displayColour=color_ opts} + where dopts = oneLineFmt{displayCommodity=layout_ opts /= LayoutBare, displayCommodityOrder=Just cs, displayColour=color_ opts} cs = if mixedAmountLooksZero amt then [""] else S.toList $ maCommodities amt dispname = T.replicate ((dep - 1) * 2) " " <> acctname damts = showMixedAmountLinesB dopts amt @@ -527,7 +527,7 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus | topaligned = TopRight | ljust = BottomLeft | otherwise = BottomRight - dopts = noCost{displayCommodity = layout_ opts /= LayoutBare + dopts = noCostFmt{displayCommodity = layout_ opts /= LayoutBare ,displayOneLine = oneline ,displayMinWidth = mmin ,displayMaxWidth = mmax @@ -736,7 +736,7 @@ balanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, balanc maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals) | otherwise = id -multiBalanceRowAsWbs :: AmountDisplayOpts -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] +multiBalanceRowAsWbs :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = case layout_ of LayoutWide width -> [fmap (showMixedAmountB bopts{displayMaxWidth=width}) allamts] @@ -778,10 +778,10 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto m [] = [n] multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] -multiBalanceRowAsCsvText opts colspans = fmap (fmap wbToText) . multiBalanceRowAsWbs csvDisplay opts colspans +multiBalanceRowAsCsvText opts colspans = fmap (fmap wbToText) . multiBalanceRowAsWbs machineFmt opts colspans multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] -multiBalanceRowAsTableText opts = multiBalanceRowAsWbs oneLine{displayColour=color_ opts} opts [] +multiBalanceRowAsTableText opts = multiBalanceRowAsWbs oneLineFmt{displayColour=color_ opts} opts [] tests_Balance = testGroup "Balance" [ diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index 1d9d90c65..0d46899d9 100644 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -89,7 +89,7 @@ showPriceDirective mp = T.unwords [ "P", T.pack . show $ pddate mp, quoteCommoditySymbolIfNeeded $ pdcommodity mp, - wbToText . showAmountB noColour{displayZeroCommodity=True} $ pdamount mp + wbToText . showAmountB defaultFmt{displayZeroCommodity=True} $ pdamount mp ] -- | Convert a market price directive to a corresponding one in the diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 69bece8f8..64b1d41f1 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -211,7 +211,7 @@ postingToCSV p = -- commodity goes into separate column, so we suppress it, along with digit group -- separators and prices let a_ = amountStripCost a{acommodity=""} in - let showamt = wbToText . showAmountB csvDisplay in + let showamt = wbToText . showAmountB machineFmt in let amt = showamt a_ in let credit = if q < 0 then showamt $ negate a_ else "" in let debit = if q >= 0 then showamt a_ else "" in diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 1466e9e1c..7295979d9 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -113,8 +113,8 @@ postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal VirtualPosting -> wrap "(" ")" _ -> id -- Since postingsReport strips prices from all Amounts when not used, we can display prices. - amt = wbToText . showMixedAmountB csvDisplay $ pamount p - bal = wbToText $ showMixedAmountB csvDisplay b + amt = wbToText . showMixedAmountB machineFmt $ pamount p + bal = wbToText $ showMixedAmountB machineFmt b -- | Render a register report as plain text suitable for console output. postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index ae6d1e116..c9b4f1c11 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -282,7 +282,7 @@ postingsOrTransactionsReportAsText alignAll opts itemAsText itemamt itembal repo startAlign = (if alignAll then id else take chunkSize) itemsWithAmounts itemsWithAmounts = map (\x -> (x, showAmt $ itemamt x, showAmt $ itembal x)) report - showAmt = showMixedAmountLinesB oneLine{displayColour=opts^.color__} + showAmt = showMixedAmountLinesB oneLineFmt{displayColour=opts^.color__} amt = second3 bal = third3 diff --git a/hledger/test/json.test b/hledger/test/json.test index a9e4578b1..da5388f73 100644 --- a/hledger/test/json.test +++ b/hledger/test/json.test @@ -16,7 +16,7 @@ $ hledger -f- reg --output-format=json "pamount": [ { "acommodity": "AAA", - "aprice": null, + "acost": null, "aquantity": { "decimalMantissa": 10, "decimalPlaces": 1, @@ -45,7 +45,7 @@ $ hledger -f- reg --output-format=json [ { "acommodity": "AAA", - "aprice": null, + "acost": null, "aquantity": { "decimalMantissa": 10, "decimalPlaces": 1, @@ -75,7 +75,7 @@ $ hledger -f- bal --output-format=json [ { "acommodity": "AAA", - "aprice": null, + "acost": null, "aquantity": { "decimalMantissa": 10, "decimalPlaces": 1, @@ -96,7 +96,7 @@ $ hledger -f- bal --output-format=json [ { "acommodity": "AAA", - "aprice": null, + "acost": null, "aquantity": { "decimalMantissa": 10, "decimalPlaces": 1,