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
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; }"