slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cli: Refactor compoundBalanceCommand.

Browse Source
This commit is contained in:
Stephen Morgan 2020-10-27 20:15:24 +11:00
parent 7e44b89bb4
commit dbe7015502
1 changed files with 68 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

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