From d82416b7b9a97f82c8b3ddecf9810cfce2347010 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Mon, 15 Nov 2021 13:18:48 +1100 Subject: [PATCH] imp: balance: Add single-line display with elision back in, this time with a separate option --layout=wide,WIDTH. --- hledger-lib/Hledger/Reports/BudgetReport.hs | 23 +++++------ .../Hledger/Reports/MultiBalanceReport.hs | 4 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 36 +++++++++++------ hledger/Hledger/Cli/Commands/Balance.hs | 40 +++++++++---------- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 16 ++++---- hledger/test/balance/multicommodity.test | 34 ++++++++++------ 6 files changed, 87 insertions(+), 66 deletions(-) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 692bf109c..0095eedce 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -241,7 +241,7 @@ budgetReportAsTable (Tab.Group Tab.NoLine $ map Tab.Header colheadings) rows where - colheadings = ["Commodity" | commodity_layout_ == CommodityColumn] + colheadings = ["Commodity" | commodity_layout_ == CommodityBare] ++ map (reportPeriodName balanceaccum_ spans) spans ++ [" Total" | row_total_] ++ ["Average" | average_] @@ -283,9 +283,9 @@ budgetReportAsTable padcells = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip widths) . maybetranspose padtr = maybetranspose . fmap (fmap (uncurry paddisplaycell) . zip trwidths) . maybetranspose - -- commodities are shown with the amounts without `commodity-layout_ == CommodityColumn` + -- commodities are shown with the amounts without `commodity_layout_ == CommodityBare` prependcs cs - | commodity_layout_ /= CommodityColumn = id + | commodity_layout_ /= CommodityBare = id | otherwise = zipWith (:) cs rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as @@ -294,13 +294,12 @@ budgetReportAsTable -- functions for displaying budget cells depending on `commodity-layout_` option rowfuncs :: [CommoditySymbol] -> (BudgetShowMixed, BudgetPercBudget) - rowfuncs cs - | commodity_layout_ == CommodityOneLine = - ( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32} - , \a -> pure . percentage a) - | otherwise = - ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_} - , \a b -> fmap (percentage' a b) cs) + rowfuncs cs = case commodity_layout_ of + CommodityWide width -> + ( pure . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=width} + , \a -> pure . percentage a) + _ -> ( showMixedAmountLinesB noPrice{displayOrder=Just cs, displayMinWidth=Nothing, displayColour=color_} + , \a b -> fmap (percentage' a b) cs) showrow :: [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)] showrow row = @@ -408,7 +407,7 @@ budgetReportAsCsv -- heading row ("Account" : - ["Commodity" | commodity_layout_ == CommodityColumn ] + ["Commodity" | commodity_layout_ == CommodityBare ] ++ concatMap (\span -> [showDateSpan span, "budget"]) colspans ++ concat [["Total" ,"budget"] | row_total_] ++ concat [["Average","budget"] | average_] @@ -428,7 +427,7 @@ budgetReportAsCsv -> PeriodicReportRow a BudgetCell -> [[Text]] rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) - | commodity_layout_ /= CommodityColumn = [render row : fmap showNorm all] + | commodity_layout_ /= CommodityBare = [render row : fmap showNorm all] | otherwise = joinNames . zipWith (:) cs -- add symbols and names . transpose -- each row becomes a list of Text quantities diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 050951778..14b43b1e7 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -568,11 +568,11 @@ balanceReportTableAsText ReportOpts{..} = Tab.renderTableByRowsB def{Tab.tableBorders=False, Tab.prettyTable=pretty_} renderCh renderRow where renderCh - | commodity_layout_ /= CommodityColumn || transpose_ = fmap (Tab.textCell Tab.TopRight) + | commodity_layout_ /= CommodityBare || transpose_ = fmap (Tab.textCell Tab.TopRight) | otherwise = zipWith ($) (Tab.textCell Tab.TopLeft : repeat (Tab.textCell Tab.TopRight)) renderRow (rh, row) - | commodity_layout_ /= CommodityColumn || transpose_ = + | commodity_layout_ /= CommodityBare || transpose_ = (Tab.textCell Tab.TopLeft rh, fmap (Tab.Cell Tab.TopRight . pure) row) | otherwise = (Tab.textCell Tab.TopLeft rh, zipWith ($) (Tab.Cell Tab.TopLeft : repeat (Tab.Cell Tab.TopRight)) (fmap pure row)) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 4a82949c1..4ac2a8470 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -68,12 +68,12 @@ import Data.Char (toLower) import Data.Either (fromRight) import Data.Either.Extra (eitherToMaybe) import Data.Functor.Identity (Identity(..)) -import Data.List.Extra (nubSort) +import Data.List.Extra (find, isPrefixOf, nubSort) import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) -import Safe (headDef, headMay, lastDef, lastMay, maximumMay) +import Safe (headMay, lastDef, lastMay, maximumMay, readMay) import Text.Megaparsec.Custom @@ -109,7 +109,10 @@ data AccountListMode = ALFlat | ALTree deriving (Eq, Show) instance Default AccountListMode where def = ALFlat -data CommodityLayout = CommodityOneLine | CommodityMultiLine | CommodityColumn deriving (Eq, Show) +data CommodityLayout = CommodityWide (Maybe Int) + | CommodityTall + | CommodityBare + deriving (Eq, Show) -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options @@ -203,7 +206,7 @@ defreportopts = ReportOpts , normalbalance_ = Nothing , color_ = False , transpose_ = False - , commodity_layout_ = CommodityOneLine + , commodity_layout_ = CommodityWide Nothing } -- | Generate a ReportOpts from raw command-line input, given a day. @@ -332,16 +335,25 @@ balanceAccumulationOverride rawopts = choiceopt parse rawopts <|> reportbal _ -> Nothing commoditylayoutopt :: RawOpts -> CommodityLayout -commoditylayoutopt rawopts = fromMaybe CommodityOneLine $ layout <|> column +commoditylayoutopt rawopts = fromMaybe (CommodityWide Nothing) $ layout <|> column where - layout = parse <$> maybestringopt "commodity-layout" rawopts - column = CommodityColumn <$ guard (boolopt "commodity-column" rawopts) + layout = parse <$> maybestringopt "layout" rawopts + column = CommodityBare <$ guard (boolopt "commodity-column" rawopts) - parse opt = case toLower $ headDef 'x' opt of - 'o' -> CommodityOneLine -- "oneline" and abbreviations - 'm' -> CommodityMultiLine -- "multiline" and abbreviations - 'c' -> CommodityColumn -- "column" and abbreviations - _ -> usageError "--commodity-layout's argument should be \"oneline\", \"multiline\", or \"column\"" + parse opt = maybe err snd $ guard (not $ null s) *> find (isPrefixOf s . fst) checkNames + where + checkNames = [ ("wide", CommodityWide w) + , ("tall", CommodityTall) + , ("bare", CommodityBare) + ] + -- For `--layout=elided,n`, elide to the given width + (s,n) = break (==',') $ map toLower opt + w = case drop 1 n of + "" -> Nothing + c | Just w <- readMay c -> Just w + _ -> usageError "width in --layout=wide,WIDTH must be an integer" + + err = usageError "--layout's argument should be \"wide[,WIDTH]\", \"tall\", or \"bare\"" -- Get the period specified by any -b/--begin, -e/--end and/or -p/--period -- options appearing in the command line. diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index aed98cbfb..1089066bc 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -318,12 +318,12 @@ balancemode = hledgerCommandMode ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total" ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign" ,flagNone ["transpose"] (setboolopt "transpose") "transpose rows and columns" - ,flagReq ["commodity-layout"] (\s opts -> Right $ setopt "commodity-layout" s opts) "ARG" + ,flagReq ["layout"] (\s opts -> Right $ setopt "layout" s opts) "ARG" (unlines - ["show multicommodity amounts in the given ARG. ARG can be:" - ,"'oneline': show all commodities on a single line" - ,"'multiline': show each commodity on a new line" - ,"'column': show commodity symbols in a separate column and amounts as bare numbers" + ["how to show multi-commodity amounts:" + ,"'wide[,WIDTH]': all commodities on one line [elided at WIDTH]" + ,"'tall' : each commodity on a new line" + ,"'bare' : bare numbers, symbols in a column" ]) ,outputFormatFlag ["txt","html","csv","json"] ,outputFileFlag @@ -407,13 +407,13 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of -- | Render a single-column balance report as CSV. balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv opts (items, total) = - ("account" : ((if commodity_layout_ opts == CommodityColumn then (:) "commodity" else id) $ ["balance"])) + ("account" : ((if commodity_layout_ opts == CommodityBare then (:) "commodity" else id) $ ["balance"])) : (concatMap (\(a, _, _, b) -> rows a b) items) ++ if no_total_ opts then [] else rows "total" total where rows :: AccountName -> MixedAmount -> [[T.Text]] rows name ma = case commodity_layout_ opts of - CommodityColumn -> + CommodityBare -> fmap (\(k, a) -> [showName name, k, renderAmount . mixedAmount . amountStripPrices $ a]) . M.toList . foldl' sumAmounts mempty . amounts $ ma _ -> [[showName name, renderAmount ma]] @@ -421,14 +421,14 @@ balanceReportAsCsv opts (items, total) = showName = accountNameDrop (drop_ opts) renderAmount amt = wbToText $ showMixedAmountB bopts amt where bopts = (balanceOpts False opts){displayOrder = order} - order = if commodity_layout_ opts == CommodityColumn then Just (S.toList $ maCommodities amt) else Nothing + order = if commodity_layout_ opts == CommodityBare then Just (S.toList $ maCommodities amt) else Nothing sumAmounts mp am = M.insertWith (+) (acommodity am) am mp -- | Render a single-column balance report as plain text. balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText opts ((items, total)) = case commodity_layout_ opts of - CommodityColumn | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL: - CommodityColumn -> balanceReportAsText' opts ((items, total)) + CommodityBare | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL: + CommodityBare -> balanceReportAsText' opts ((items, total)) _ -> unlinesB lines <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) where (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items @@ -524,7 +524,7 @@ multiBalanceReportAsCsv opts@ReportOpts{..} = multiBalanceReportAsCsv' :: ReportOpts -> MultiBalanceReport -> (CSV, CSV) multiBalanceReportAsCsv' opts@ReportOpts{..} (PeriodicReport colspans items tr) = - ( ("account" : ["commodity" | commodity_layout_ == CommodityColumn] ++ map showDateSpan colspans + ( ("account" : ["commodity" | commodity_layout_ == CommodityBare] ++ map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_] ) : concatMap (fullRowAsTexts (accountNameDrop drop_ . prrFullName)) items @@ -671,7 +671,7 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} (concat rows) where totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] - colheadings = ["Commodity" | commodity_layout_ opts == CommodityColumn] + colheadings = ["Commodity" | commodity_layout_ opts == CommodityBare] ++ map (reportPeriodName balanceaccum_ spans) spans ++ [" Total" | totalscolumn] ++ ["Average" | average_] @@ -694,14 +694,14 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} multiBalanceRowAsWbs :: AmountDisplayOpts -> ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] multiBalanceRowAsWbs bopts ReportOpts{..} (PeriodicReportRow _ as rowtot rowavg) = case commodity_layout_ of - CommodityOneLine -> [fmap (showMixedAmountB bopts) all] - CommodityMultiLine -> paddedTranspose mempty - . fmap (showMixedAmountLinesB bopts{displayMaxWidth=Nothing}) - $ all - CommodityColumn -> zipWith (:) (fmap wbFromText cs) -- add symbols - . transpose -- each row becomes a list of Text quantities - . fmap (showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing}) - $ all + CommodityWide width -> [fmap (showMixedAmountB bopts{displayMaxWidth=width}) all] + CommodityTall -> paddedTranspose mempty + . fmap (showMixedAmountLinesB bopts{displayMaxWidth=Nothing}) + $ all + CommodityBare -> zipWith (:) (fmap wbFromText cs) -- add symbols + . transpose -- each row becomes a list of Text quantities + . fmap (showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing}) + $ all where totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = S.toList . foldl' S.union mempty $ fmap maCommodities all diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index d6517d257..fdc0cbdcf 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -84,12 +84,12 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)" ,flagNone ["sort-amount","S"] (setboolopt "sort-amount") "sort by amount instead of account code/name" ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total" - ,flagReq ["commodity-layout"] (\s opts -> Right $ setopt "commodity-layout" s opts) "ARG" + ,flagReq ["layout"] (\s opts -> Right $ setopt "layout" s opts) "ARG" (unlines - ["show multicommodity amounts in the given ARG. ARG can be:" - ,"'oneline': show all commodities on a single line" - ,"'multiline': show each commodity on a new line" - ,"'column': show commodity symbols in a separate column and amounts as bare numbers" + ["how to show multi-commodity amounts:" + ,"'wide[,WIDTH]': all commodities on one line [elided at WIDTH]" + ,"'tall' : each commodity on a new line" + ,"'bare' : bare numbers, symbols in a column" ]) ,outputFormatFlag ["txt","html","csv","json"] ,outputFileFlag @@ -247,7 +247,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor addtotals $ padRow title : ( "Account" - : ["Commodity" | commodity_layout_ ropts == CommodityColumn] + : ["Commodity" | commodity_layout_ ropts == CommodityBare] ++ map (reportPeriodName (balanceaccum_ ropts) colspans) colspans ++ (if row_total_ ropts then ["Total"] else []) ++ (if average_ ropts then ["Average"] else []) @@ -264,7 +264,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor | null subreports = 1 | otherwise = (1 +) $ -- account name column - (if commodity_layout_ ropts == CommodityColumn then (1+) else id) $ + (if commodity_layout_ ropts == CommodityBare then (1+) else id) $ (if row_total_ ropts then (1+) else id) $ (if average_ ropts then (1+) else id) $ maximum $ -- depends on non-null subreports @@ -286,7 +286,7 @@ compoundBalanceReportAsHtml ropts cbr = titlerows = (tr_ $ th_ [colspanattr, leftattr] $ h2_ $ toHtml title) : [thRow $ - "" : ["Commodity" | commodity_layout_ ropts == CommodityColumn] ++ + "" : ["Commodity" | commodity_layout_ ropts == CommodityBare] ++ map (reportPeriodName (balanceaccum_ ropts) colspans) colspans ++ (if row_total_ ropts then ["Total"] else []) ++ (if average_ ropts then ["Average"] else []) diff --git a/hledger/test/balance/multicommodity.test b/hledger/test/balance/multicommodity.test index d665320b4..585e203d1 100644 --- a/hledger/test/balance/multicommodity.test +++ b/hledger/test/balance/multicommodity.test @@ -21,7 +21,7 @@ Balance changes in 2020-01-01..2021-12-31: || 1.00A, 1.00B, 1.00C, 1.00D 1.00D, 1.00E, 1.00F # 2. Display multiline if requested -$ hledger -f- bal -Y --commodity-layout=multiline +$ hledger -f- bal -Y --layout=tall Balance changes in 2020-01-01..2021-12-31: || 2020 2021 @@ -37,7 +37,7 @@ Balance changes in 2020-01-01..2021-12-31: || 1.00D # 3. Display a commodity column if requested -$ hledger -f- bal -Y --commodity-layout=column +$ hledger -f- bal -Y --layout=bare Balance changes in 2020-01-01..2021-12-31: || Commodity 2020 2021 @@ -56,6 +56,16 @@ Balance changes in 2020-01-01..2021-12-31: || E 0 1.00 || F 0 1.00 +# 4. Display elided to a specific width if requested +$ hledger -f- bal -Y --layout=wide,22 +Balance changes in 2020-01-01..2021-12-31: + + || 2020 2021 +===++============================================= + a || 1.00A, 1.00B, 2 more.. 1.00D, 1.00E, 1.00F +---++--------------------------------------------- + || 1.00A, 1.00B, 2 more.. 1.00D, 1.00E, 1.00F + < 2020-02-22 26018c6e:ced6cffd:c3c182f1:7b433efb $ 9.41 @@ -77,16 +87,16 @@ Balance changes in 2020-01-01..2021-12-31: ea50865f:3bfb86b7:bf72f75a:a7cad1ac C$ -26.00 ea50865f:325566ed:216fec7e:7b433efb C$ 1.44 -# 4. Make sure all amounts up to the largest fit -$ hledger -f- bal -Y --color=yes +# 5. Make sure all amounts up to the largest fit when eliding +$ hledger -f- bal -Y --color=yes --layout=wide,32 Balance changes in 2020: - || 2020 -=====================================++==================================== - 26018c6e:ced6cffd:c3c182f1:7b433efb || $ 9.41, C$ 24.56, £ -19.16, € 9.21 - ea50865f:325566ed:216fec7e:7b433efb || $ 0.59, C$ 1.44, £ 0.91, € 0.79 - ea50865f:325566ed:47134948 || £ 18.25 - ea50865f:3bfb86b7:bf72f75a:a7cad1ac || $ -10.00, C$ -26.00, € -10.00 --------------------------------------++------------------------------------ - || 0 + || 2020 +=====================================++================================= + 26018c6e:ced6cffd:c3c182f1:7b433efb || $ 9.41, C$ 24.56, 2 more.. + ea50865f:325566ed:216fec7e:7b433efb || $ 0.59, C$ 1.44, £ 0.91, € 0.79 + ea50865f:325566ed:47134948 || £ 18.25 + ea50865f:3bfb86b7:bf72f75a:a7cad1ac || $ -10.00, C$ -26.00, € -10.00 +-------------------------------------++--------------------------------- + || 0 >=0