From dbe7015502654ebb257ba7982251b5ce24df4ebf Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 27 Oct 2020 20:15:24 +1100 Subject: [PATCH] cli: Refactor compoundBalanceCommand. --- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 135 +++++++++--------- 1 file changed, 68 insertions(+), 67 deletions(-) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 3160707cf..f49284537 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -13,19 +13,19 @@ module Hledger.Cli.CompoundBalanceCommand ( ) where import Data.List (foldl') -import Data.Maybe -import qualified Data.Text as TS +import Data.Maybe (fromMaybe, mapMaybe) +import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Data.Time.Calendar +import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C import Hledger.Read.CsvReader (CSV, printCSV) import Lucid as L hiding (value_) -import Text.Tabular as T +import Text.Tabular as Tab import Hledger import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions -import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutput) +import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText) -- | Description of a compound balance report command, -- from which we generate the command's cmdargs mode and IO action. @@ -89,71 +89,72 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = -- | Generate a runnable command from a compound balance command specification. compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=rspec, rawopts_=rawopts} j = do - let - ropts@ReportOpts{..} = rsOpts rspec - -- use the default balance type for this report, unless the user overrides - mBalanceTypeOverride = - choiceopt parse rawopts where - parse = \case - "historical" -> Just HistoricalBalance - "cumulative" -> Just CumulativeChange - "change" -> Just PeriodChange - _ -> Nothing - balancetype = fromMaybe cbctype mBalanceTypeOverride - -- Set balance type in the report options. - ropts' = ropts{balancetype_=balancetype} + writeOutputLazyText opts $ render cbr + where + ropts@ReportOpts{..} = rsOpts rspec + -- use the default balance type for this report, unless the user overrides + mBalanceTypeOverride = + choiceopt parse rawopts where + parse = \case + "historical" -> Just HistoricalBalance + "cumulative" -> Just CumulativeChange + "change" -> Just PeriodChange + _ -> Nothing + balancetype = fromMaybe cbctype mBalanceTypeOverride + -- Set balance type in the report options. + ropts' = ropts{balancetype_=balancetype} - title = - cbctitle - ++ " " - ++ titledatestr - ++ maybe "" (' ':) mtitleclarification - ++ valuationdesc - where + title = + cbctitle + ++ " " + ++ titledatestr + ++ maybe "" (' ':) mtitleclarification + ++ valuationdesc + where - -- XXX #1078 the title of ending balance reports - -- (HistoricalBalance) should mention the end date(s) shown as - -- column heading(s) (not the date span of the transactions). - -- Also the dates should not be simplified (it should show - -- "2008/01/01-2008/12/31", not "2008"). - titledatestr = case balancetype of - HistoricalBalance -> showEndDates enddates - _ -> showDateSpan requestedspan - where - enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date - requestedspan = queryDateSpan date2_ (rsQuery rspec) - `spanDefaultsFrom` journalDateSpan date2_ j + -- XXX #1078 the title of ending balance reports + -- (HistoricalBalance) should mention the end date(s) shown as + -- column heading(s) (not the date span of the transactions). + -- Also the dates should not be simplified (it should show + -- "2008/01/01-2008/12/31", not "2008"). + titledatestr = case balancetype of + HistoricalBalance -> showEndDates enddates + _ -> showDateSpan requestedspan + where + enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date + requestedspan = queryDateSpan date2_ (rsQuery rspec) + `spanDefaultsFrom` journalDateSpan date2_ j - -- when user overrides, add an indication to the report title - mtitleclarification = flip fmap mBalanceTypeOverride $ \case - PeriodChange | changingValuation -> "(Period-End Value Changes)" - PeriodChange -> "(Balance Changes)" - CumulativeChange -> "(Cumulative Ending Balances)" - HistoricalBalance -> "(Historical Ending Balances)" + -- when user overrides, add an indication to the report title + mtitleclarification = flip fmap mBalanceTypeOverride $ \case + PeriodChange | changingValuation -> "(Period-End Value Changes)" + PeriodChange -> "(Balance Changes)" + CumulativeChange -> "(Cumulative Ending Balances)" + HistoricalBalance -> "(Historical Ending Balances)" - valuationdesc = case value_ of - Just (AtCost _mc) -> ", valued at cost" - Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO - Just (AtEnd _mc) | changingValuation -> "" - Just (AtEnd _mc) -> ", valued at period ends" - Just (AtNow _mc) -> ", current value" - Just (AtDate today _mc) -> ", valued at "++showDate today - Nothing -> "" + valuationdesc = case value_ of + Just (AtCost _mc) -> ", valued at cost" + Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO + Just (AtEnd _mc) | changingValuation -> "" + Just (AtEnd _mc) -> ", valued at period ends" + Just (AtNow _mc) -> ", current value" + Just (AtDate today _mc) -> ", valued at "++showDate today + Nothing -> "" - changingValuation = case (balancetype_, value_) of - (PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval - _ -> False + changingValuation = case (balancetype_, value_) of + (PeriodChange, Just (AtEnd _)) -> interval_ /= NoInterval + _ -> False - -- make a CompoundBalanceReport. - cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries - cbr = cbr'{cbrTitle=title} + -- make a CompoundBalanceReport. + cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries + cbr = cbr'{cbrTitle=title} -- render appropriately - writeOutput opts $ case outputFormatFromOpts opts of - "txt" -> compoundBalanceReportAsText ropts' cbr - "csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n" - "html" -> (++"\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr - "json" -> (++"\n") $ TL.unpack $ toJsonText cbr + render = case outputFormatFromOpts opts of + "txt" -> TL.pack . compoundBalanceReportAsText ropts' + "csv" -> TL.pack . printCSV . compoundBalanceReportAsCsv ropts' + "html" -> L.renderText . compoundBalanceReportAsHtml ropts' + "json" -> toJsonText x -> error' $ unsupportedOutputFormatError x -- | Summarise one or more (inclusive) end dates, in a way that's @@ -196,7 +197,7 @@ compoundBalanceReportAsText ropts where bigtable = case map (subreportAsTable ropts) subreports of - [] -> T.empty + [] -> Tab.empty r:rs -> foldl' concatTables r rs bigtable' | no_total_ ropts || length subreports == 1 = @@ -217,11 +218,11 @@ compoundBalanceReportAsText ropts -- convert to table Table lefthdrs tophdrs cells = balanceReportAsTable ropts r -- tweak the layout - t = Table (T.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells) + t = Table (Tab.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells) -- | Add the second table below the first, discarding its column headings. concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') = - Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat') + Table (Tab.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat') -- | Render a compound balance report as CSV. -- Subreports' CSV is concatenated, with the headings rows replaced by a @@ -268,7 +269,7 @@ compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName compoundBalanceReportAsHtml ropts cbr = let CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg) = cbr - colspanattr = colspan_ $ TS.pack $ show $ + colspanattr = colspan_ $ T.pack $ show $ 1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0) leftattr = style_ "text-align:left" blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw (" "::String) @@ -309,7 +310,7 @@ compoundBalanceReportAsHtml ropts cbr = ] in do - style_ (TS.unlines ["" + style_ (T.unlines ["" ,"td { padding:0 0.5em; }" ,"td:nth-child(1) { white-space:nowrap; }" ,"tr:nth-child(even) td { background-color:#eee; }"