refactor: BalanceCommand -> CompoundBalanceCommand
More verbose, but also more precise.
This commit is contained in:
parent
d4f09efc95
commit
083df72582
@ -17,29 +17,29 @@ import Test.HUnit
|
|||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Cli.BalanceCommand
|
import Hledger.Cli.CompoundBalanceCommand
|
||||||
|
|
||||||
balancesheetSpec = BalanceCommandSpec {
|
balancesheetSpec = CompoundBalanceCommandSpec {
|
||||||
bcname = "balancesheet",
|
cbcname = "balancesheet",
|
||||||
bcaliases = ["bs"],
|
cbcaliases = ["bs"],
|
||||||
bchelp = [here|
|
cbchelp = [here|
|
||||||
This command displays a simple balance sheet, showing historical ending
|
This command displays a simple balance sheet, showing historical ending
|
||||||
balances of asset and liability accounts (ignoring any report begin date).
|
balances of asset and liability accounts (ignoring any report begin date).
|
||||||
It assumes that these accounts are under a top-level `asset` or `liability`
|
It assumes that these accounts are under a top-level `asset` or `liability`
|
||||||
account (case insensitive, plural forms also allowed).
|
account (case insensitive, plural forms also allowed).
|
||||||
|],
|
|],
|
||||||
bctitle = "Balance Sheet",
|
cbctitle = "Balance Sheet",
|
||||||
bcqueries = [ ("Assets" , journalAssetAccountQuery),
|
cbcqueries = [ ("Assets" , journalAssetAccountQuery),
|
||||||
("Liabilities", journalLiabilityAccountQuery)
|
("Liabilities", journalLiabilityAccountQuery)
|
||||||
],
|
],
|
||||||
bctype = HistoricalBalance
|
cbctype = HistoricalBalance
|
||||||
}
|
}
|
||||||
|
|
||||||
balancesheetmode :: Mode RawOpts
|
balancesheetmode :: Mode RawOpts
|
||||||
balancesheetmode = balanceCommandMode balancesheetSpec
|
balancesheetmode = compoundBalanceCommandMode balancesheetSpec
|
||||||
|
|
||||||
balancesheet :: CliOpts -> Journal -> IO ()
|
balancesheet :: CliOpts -> Journal -> IO ()
|
||||||
balancesheet = balanceCommand balancesheetSpec
|
balancesheet = compoundBalanceCommand balancesheetSpec
|
||||||
|
|
||||||
tests_Hledger_Cli_Balancesheet :: Test
|
tests_Hledger_Cli_Balancesheet :: Test
|
||||||
tests_Hledger_Cli_Balancesheet = TestList
|
tests_Hledger_Cli_Balancesheet = TestList
|
||||||
|
|||||||
@ -20,27 +20,27 @@ import Test.HUnit
|
|||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Cli.BalanceCommand
|
import Hledger.Cli.CompoundBalanceCommand
|
||||||
|
|
||||||
cashflowSpec = BalanceCommandSpec {
|
cashflowSpec = CompoundBalanceCommandSpec {
|
||||||
bcname = "cashflow",
|
cbcname = "cashflow",
|
||||||
bcaliases = ["cf"],
|
cbcaliases = ["cf"],
|
||||||
bchelp = [here|
|
cbchelp = [here|
|
||||||
This command displays a simple cashflow statement, showing changes
|
This command displays a simple cashflow statement, showing changes
|
||||||
in "cash" accounts. It assumes that these accounts are under a top-level
|
in "cash" accounts. It assumes that these accounts are under a top-level
|
||||||
`asset` account (case insensitive, plural forms also allowed) and do not
|
`asset` account (case insensitive, plural forms also allowed) and do not
|
||||||
contain `receivable` or `A/R` in their name.
|
contain `receivable` or `A/R` in their name.
|
||||||
|],
|
|],
|
||||||
bctitle = "Cashflow Statement",
|
cbctitle = "Cashflow Statement",
|
||||||
bcqueries = [("Cash flows", journalCashAccountQuery)],
|
cbcqueries = [("Cash flows", journalCashAccountQuery)],
|
||||||
bctype = PeriodChange
|
cbctype = PeriodChange
|
||||||
}
|
}
|
||||||
|
|
||||||
cashflowmode :: Mode RawOpts
|
cashflowmode :: Mode RawOpts
|
||||||
cashflowmode = balanceCommandMode cashflowSpec
|
cashflowmode = compoundBalanceCommandMode cashflowSpec
|
||||||
|
|
||||||
cashflow :: CliOpts -> Journal -> IO ()
|
cashflow :: CliOpts -> Journal -> IO ()
|
||||||
cashflow = balanceCommand cashflowSpec
|
cashflow = compoundBalanceCommand cashflowSpec
|
||||||
|
|
||||||
tests_Hledger_Cli_Cashflow :: Test
|
tests_Hledger_Cli_Cashflow :: Test
|
||||||
tests_Hledger_Cli_Cashflow = TestList
|
tests_Hledger_Cli_Cashflow = TestList
|
||||||
|
|||||||
@ -1,15 +1,15 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
|
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
Common helpers for making compound balance-report-ish commands like
|
Common helpers for making multi-section balance report commands
|
||||||
balancesheet, cashflow, or incomestatement.
|
like balancesheet, cashflow, and incomestatement.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Cli.BalanceCommand (
|
module Hledger.Cli.CompoundBalanceCommand (
|
||||||
BalanceCommandSpec(..)
|
CompoundBalanceCommandSpec(..)
|
||||||
,balanceCommandMode
|
,compoundBalanceCommandMode
|
||||||
,balanceCommand
|
,compoundBalanceCommand
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
@ -23,22 +23,26 @@ import Hledger
|
|||||||
import Hledger.Cli.Balance
|
import Hledger.Cli.Balance
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
|
|
||||||
-- | Description of a compound balance-report-like command, consisting of
|
-- | Description of a compound balance report command,
|
||||||
-- multiple named subreports displayed in order and then totalled.
|
-- from which we generate the command's cmdargs mode and IO action.
|
||||||
data BalanceCommandSpec = BalanceCommandSpec {
|
-- A compound balance report shows one or more sections/subreports,
|
||||||
bcname :: String, -- ^ command name
|
-- each with its own title and subtotals row, in a certain order,
|
||||||
bcaliases :: [String], -- ^ command aliases
|
-- plus a grand totals row if there's more than one section.
|
||||||
bchelp :: String, -- ^ command line help
|
-- Examples are the balancesheet, cashflow and incomestatement commands.
|
||||||
bctitle :: String, -- ^ overall report title
|
data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
|
||||||
bcqueries :: [(String, Journal -> Query)], -- ^ title and (journal-parameterised) query for each subreport
|
cbcname :: String, -- ^ command name
|
||||||
bctype :: BalanceType -- ^ the type of "balance" this report shows (overrides command line flags)
|
cbcaliases :: [String], -- ^ command aliases
|
||||||
|
cbchelp :: String, -- ^ command line help
|
||||||
|
cbctitle :: String, -- ^ overall report title
|
||||||
|
cbcqueries :: [(String, Journal -> Query)], -- ^ title and (journal-parameterised) query for each subreport
|
||||||
|
cbctype :: BalanceType -- ^ the type of "balance" this report shows (overrides command line flags)
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Generate a cmdargs option-parsing mode from a compound balance command
|
-- | Generate a cmdargs option-parsing mode from a compound balance command
|
||||||
-- specification.
|
-- specification.
|
||||||
balanceCommandMode :: BalanceCommandSpec -> Mode RawOpts
|
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
|
||||||
balanceCommandMode BalanceCommandSpec{..} = (defCommandMode $ bcname : bcaliases) {
|
compoundBalanceCommandMode CompoundBalanceCommandSpec{..} = (defCommandMode $ cbcname : cbcaliases) {
|
||||||
modeHelp = bchelp `withAliases` bcaliases
|
modeHelp = cbchelp `withAliases` cbcaliases
|
||||||
,modeGroupFlags = C.Group {
|
,modeGroupFlags = C.Group {
|
||||||
groupUnnamed = [
|
groupUnnamed = [
|
||||||
flagNone ["change"] (\opts -> setboolopt "change" opts)
|
flagNone ["change"] (\opts -> setboolopt "change" opts)
|
||||||
@ -67,12 +71,12 @@ balanceCommandMode BalanceCommandSpec{..} = (defCommandMode $ bcname : bcaliases
|
|||||||
}
|
}
|
||||||
where
|
where
|
||||||
defType :: BalanceType -> String
|
defType :: BalanceType -> String
|
||||||
defType bt | bt == bctype = " (default)"
|
defType bt | bt == cbctype = " (default)"
|
||||||
| otherwise = ""
|
| otherwise = ""
|
||||||
|
|
||||||
-- | Generate a runnable command from a compound balance command specification.
|
-- | Generate a runnable command from a compound balance command specification.
|
||||||
balanceCommand :: BalanceCommandSpec -> (CliOpts -> Journal -> IO ())
|
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
|
||||||
balanceCommand BalanceCommandSpec{..} CliOpts{command_=cmd, reportopts_=ropts, rawopts_=rawopts} j = do
|
compoundBalanceCommand CompoundBalanceCommandSpec{..} CliOpts{command_=cmd, reportopts_=ropts, rawopts_=rawopts} j = do
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
let
|
let
|
||||||
-- use the default balance type for this report, unless the user overrides
|
-- use the default balance type for this report, unless the user overrides
|
||||||
@ -82,9 +86,9 @@ balanceCommand BalanceCommandSpec{..} CliOpts{command_=cmd, reportopts_=ropts, r
|
|||||||
"cumulative":_ -> Just CumulativeChange
|
"cumulative":_ -> Just CumulativeChange
|
||||||
"change":_ -> Just PeriodChange
|
"change":_ -> Just PeriodChange
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
balancetype = fromMaybe bctype mBalanceTypeOverride
|
balancetype = fromMaybe cbctype mBalanceTypeOverride
|
||||||
-- when user overrides, add an indication to the report title
|
-- when user overrides, add an indication to the report title
|
||||||
title = bctitle ++ maybe "" (' ':) mtitleclarification
|
title = cbctitle ++ maybe "" (' ':) mtitleclarification
|
||||||
where
|
where
|
||||||
mtitleclarification = flip fmap mBalanceTypeOverride $ \t ->
|
mtitleclarification = flip fmap mBalanceTypeOverride $ \t ->
|
||||||
case t of
|
case t of
|
||||||
@ -106,9 +110,9 @@ balanceCommand BalanceCommandSpec{..} CliOpts{command_=cmd, reportopts_=ropts, r
|
|||||||
|
|
||||||
case interval_ ropts' of
|
case interval_ ropts' of
|
||||||
|
|
||||||
NoInterval -> do
|
|
||||||
-- single-column report
|
-- single-column report
|
||||||
let (subreportstr, total) = foldMap (uncurry (balanceCommandSingleColumnReport ropts' userq j)) bcqueries
|
NoInterval -> do
|
||||||
|
let (subreportstr, total) = foldMap (uncurry (compoundBalanceCommandSingleColumnReport ropts' userq j)) cbcqueries
|
||||||
putStrLn $ title ++ "\n"
|
putStrLn $ title ++ "\n"
|
||||||
mapM_ putStrLn subreportstr
|
mapM_ putStrLn subreportstr
|
||||||
unless (no_total_ ropts' || cmd=="cashflow") . mapM_ putStrLn $ -- TODO temp
|
unless (no_total_ ropts' || cmd=="cashflow") . mapM_ putStrLn $ -- TODO temp
|
||||||
@ -120,27 +124,30 @@ balanceCommand BalanceCommandSpec{..} CliOpts{command_=cmd, reportopts_=ropts, r
|
|||||||
showamt | color_ ropts' = cshowMixedAmountWithoutPrice
|
showamt | color_ ropts' = cshowMixedAmountWithoutPrice
|
||||||
| otherwise = showMixedAmountWithoutPrice
|
| otherwise = showMixedAmountWithoutPrice
|
||||||
|
|
||||||
_ -> do
|
|
||||||
-- multi-column report
|
-- multi-column report
|
||||||
|
_ -> do
|
||||||
let
|
let
|
||||||
(subreporttables, subreporttotals, Sum overalltotal) = foldMap (uncurry (balanceCommandMultiColumnReports ropts' userq j)) bcqueries
|
(subreporttables, subreporttotals, Sum overalltotal) = foldMap (uncurry (compoundBalanceCommandMultiColumnReports ropts' userq j)) cbcqueries
|
||||||
overalltable = case subreporttables of
|
overalltable = case subreporttables of
|
||||||
t1:ts -> foldl' concatTables t1 ts
|
t1:ts -> foldl' concatTables t1 ts
|
||||||
[] -> T.empty
|
[] -> T.empty
|
||||||
overalltable'
|
overalltable'
|
||||||
| no_total_ ropts' || length bcqueries == 1 =
|
| no_total_ ropts' || length cbcqueries == 1 =
|
||||||
overalltable
|
overalltable
|
||||||
| otherwise =
|
| otherwise =
|
||||||
overalltable
|
overalltable
|
||||||
+====+
|
+====+
|
||||||
row "Total"
|
row "Total" overalltotals'
|
||||||
(overalltotals ++ (if row_total_ ropts' && not (null overalltotals) then [overalltotal] else [])
|
|
||||||
++ (if average_ ropts' && not (null overalltotals) then [overallaverage] else [])
|
|
||||||
)
|
|
||||||
where
|
where
|
||||||
overalltotals = case subreporttotals of
|
overalltotals = case subreporttotals of
|
||||||
a1:as -> foldl' (zipWith (+)) a1 as
|
a1:as -> foldl' (zipWith (+)) a1 as
|
||||||
[] -> []
|
[] -> []
|
||||||
|
overalltotals'
|
||||||
|
| null overalltotals = []
|
||||||
|
| otherwise = overalltotals
|
||||||
|
++ (if row_total_ ropts' then [overalltotal] else [])
|
||||||
|
++ (if average_ ropts' then [overallaverage] else [])
|
||||||
|
where
|
||||||
overallaverage = overalltotal `divideMixedAmount` fromIntegral (length overalltotals)
|
overallaverage = overalltotal `divideMixedAmount` fromIntegral (length overalltotals)
|
||||||
putStrLn title
|
putStrLn title
|
||||||
putStrLn $ renderBalanceReportTable ropts' overalltable'
|
putStrLn $ renderBalanceReportTable ropts' overalltable'
|
||||||
@ -152,14 +159,14 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
|
|||||||
-- | Run one subreport for a single-column compound balance command.
|
-- | Run one subreport for a single-column compound balance command.
|
||||||
-- Currently this returns the plain text rendering of the subreport,
|
-- Currently this returns the plain text rendering of the subreport,
|
||||||
-- and its total.
|
-- and its total.
|
||||||
balanceCommandSingleColumnReport
|
compoundBalanceCommandSingleColumnReport
|
||||||
:: ReportOpts
|
:: ReportOpts
|
||||||
-> Query
|
-> Query
|
||||||
-> Journal
|
-> Journal
|
||||||
-> String
|
-> String
|
||||||
-> (Journal -> Query)
|
-> (Journal -> Query)
|
||||||
-> ([String], Sum MixedAmount)
|
-> ([String], Sum MixedAmount)
|
||||||
balanceCommandSingleColumnReport ropts q0 j t q = ([view], Sum amt)
|
compoundBalanceCommandSingleColumnReport ropts q0 j t q = ([view], Sum amt)
|
||||||
where
|
where
|
||||||
q' = And [q0, q j]
|
q' = And [q0, q j]
|
||||||
rep@(_ , amt)
|
rep@(_ , amt)
|
||||||
@ -176,14 +183,14 @@ balanceCommandSingleColumnReport ropts q0 j t q = ([view], Sum amt)
|
|||||||
-- Currently this returns a table of rendered balance amounts for each
|
-- Currently this returns a table of rendered balance amounts for each
|
||||||
-- subreport (including a totals row), the totals row for each subreport
|
-- subreport (including a totals row), the totals row for each subreport
|
||||||
-- (again, as mixedamounts), and the grand total.
|
-- (again, as mixedamounts), and the grand total.
|
||||||
balanceCommandMultiColumnReports
|
compoundBalanceCommandMultiColumnReports
|
||||||
:: ReportOpts
|
:: ReportOpts
|
||||||
-> Query
|
-> Query
|
||||||
-> Journal
|
-> Journal
|
||||||
-> String
|
-> String
|
||||||
-> (Journal -> Query)
|
-> (Journal -> Query)
|
||||||
-> ([Table String String MixedAmount], [[MixedAmount]], Sum MixedAmount)
|
-> ([Table String String MixedAmount], [[MixedAmount]], Sum MixedAmount)
|
||||||
balanceCommandMultiColumnReports ropts q0 j t q = ([tabl], [coltotals], Sum tot)
|
compoundBalanceCommandMultiColumnReports ropts q0 j t q = ([tabl], [coltotals], Sum tot)
|
||||||
where
|
where
|
||||||
singlesection = "Cash" `isPrefixOf` t -- TODO temp
|
singlesection = "Cash" `isPrefixOf` t -- TODO temp
|
||||||
ropts' = ropts { no_total_ = singlesection && no_total_ ropts, empty_ = True }
|
ropts' = ropts { no_total_ = singlesection && no_total_ ropts, empty_ = True }
|
||||||
@ -17,29 +17,29 @@ import Test.HUnit
|
|||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Cli.BalanceCommand
|
import Hledger.Cli.CompoundBalanceCommand
|
||||||
|
|
||||||
incomestatementSpec = BalanceCommandSpec {
|
incomestatementSpec = CompoundBalanceCommandSpec {
|
||||||
bcname = "incomestatement",
|
cbcname = "incomestatement",
|
||||||
bcaliases = ["is"],
|
cbcaliases = ["is"],
|
||||||
bchelp = [here|
|
cbchelp = [here|
|
||||||
This command displays a simple income statement, showing revenues
|
This command displays a simple income statement, showing revenues
|
||||||
and expenses during a period. It assumes that these accounts are under a
|
and expenses during a period. It assumes that these accounts are under a
|
||||||
top-level `revenue` or `income` or `expense` account (case insensitive,
|
top-level `revenue` or `income` or `expense` account (case insensitive,
|
||||||
plural forms also allowed).
|
plural forms also allowed).
|
||||||
|],
|
|],
|
||||||
bctitle = "Income Statement",
|
cbctitle = "Income Statement",
|
||||||
bcqueries = [ ("Revenues", journalIncomeAccountQuery),
|
cbcqueries = [ ("Revenues", journalIncomeAccountQuery),
|
||||||
("Expenses", journalExpenseAccountQuery)
|
("Expenses", journalExpenseAccountQuery)
|
||||||
],
|
],
|
||||||
bctype = PeriodChange
|
cbctype = PeriodChange
|
||||||
}
|
}
|
||||||
|
|
||||||
incomestatementmode :: Mode RawOpts
|
incomestatementmode :: Mode RawOpts
|
||||||
incomestatementmode = balanceCommandMode incomestatementSpec
|
incomestatementmode = compoundBalanceCommandMode incomestatementSpec
|
||||||
|
|
||||||
incomestatement :: CliOpts -> Journal -> IO ()
|
incomestatement :: CliOpts -> Journal -> IO ()
|
||||||
incomestatement = balanceCommand incomestatementSpec
|
incomestatement = compoundBalanceCommand incomestatementSpec
|
||||||
|
|
||||||
tests_Hledger_Cli_Incomestatement :: Test
|
tests_Hledger_Cli_Incomestatement :: Test
|
||||||
tests_Hledger_Cli_Incomestatement = TestList
|
tests_Hledger_Cli_Incomestatement = TestList
|
||||||
|
|||||||
@ -146,7 +146,7 @@ library
|
|||||||
Hledger.Cli.Accounts
|
Hledger.Cli.Accounts
|
||||||
Hledger.Cli.Balance
|
Hledger.Cli.Balance
|
||||||
Hledger.Cli.Balancesheet
|
Hledger.Cli.Balancesheet
|
||||||
Hledger.Cli.BalanceCommand
|
Hledger.Cli.CompoundBalanceCommand
|
||||||
Hledger.Cli.Cashflow
|
Hledger.Cli.Cashflow
|
||||||
Hledger.Cli.Help
|
Hledger.Cli.Help
|
||||||
Hledger.Cli.Histogram
|
Hledger.Cli.Histogram
|
||||||
|
|||||||
@ -95,7 +95,7 @@ library:
|
|||||||
- Hledger.Cli.Accounts
|
- Hledger.Cli.Accounts
|
||||||
- Hledger.Cli.Balance
|
- Hledger.Cli.Balance
|
||||||
- Hledger.Cli.Balancesheet
|
- Hledger.Cli.Balancesheet
|
||||||
- Hledger.Cli.BalanceCommand
|
- Hledger.Cli.CompoundBalanceCommand
|
||||||
- Hledger.Cli.Cashflow
|
- Hledger.Cli.Cashflow
|
||||||
- Hledger.Cli.Help
|
- Hledger.Cli.Help
|
||||||
- Hledger.Cli.Histogram
|
- Hledger.Cli.Histogram
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user