mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-29 13:22:27 +03:00
refactor: BalanceView -> BalanceCommandSpec, cleanups
This commit is contained in:
parent
5fca083ad2
commit
117ab0ca4c
@ -1,17 +1,15 @@
|
|||||||
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
|
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
|
||||||
{-|
|
{-|
|
||||||
|
|
||||||
This module is used by the 'balancesheet', 'incomestatement', and
|
Common helpers for making compound balance-report-ish commands like
|
||||||
'cashflow' commands to print out account balances based on a specific
|
balancesheet, cashflow, or incomestatement.
|
||||||
"view", which consists of a title and multiple named queries that are
|
|
||||||
aggregated and totalled.
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Hledger.Cli.BalanceView (
|
module Hledger.Cli.BalanceCommand (
|
||||||
BalanceView(..)
|
BalanceCommandSpec(..)
|
||||||
,balanceviewmode
|
,balanceCommandMode
|
||||||
,balanceviewReport
|
,balanceCommand
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
@ -25,21 +23,22 @@ import Hledger
|
|||||||
import Hledger.Cli.Balance
|
import Hledger.Cli.Balance
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
|
|
||||||
-- | Describes a view for the balance, which can consist of multiple
|
-- | Description of a compound balance-report-like command, consisting of
|
||||||
-- separate named queries that are aggregated and totalled.
|
-- multiple named subreports displayed in order and then totalled.
|
||||||
data BalanceView = BalanceView {
|
data BalanceCommandSpec = BalanceCommandSpec {
|
||||||
bvmode :: String, -- ^ command line mode of the view
|
bcname :: String, -- ^ command name
|
||||||
bvaliases :: [String], -- ^ command line aliases
|
bcaliases :: [String], -- ^ command aliases
|
||||||
bvhelp :: String, -- ^ command line help message
|
bchelp :: String, -- ^ command line help
|
||||||
bvtitle :: String, -- ^ title of the view
|
bctitle :: String, -- ^ overall report title
|
||||||
bvqueries :: [(String, Journal -> Query)], -- ^ named queries that make up the view
|
bcqueries :: [(String, Journal -> Query)], -- ^ title and (journal-parameterised) query for each subreport
|
||||||
bvtype :: BalanceType -- ^ the type of balance this view shows.
|
bctype :: BalanceType -- ^ the type of "balance" this report shows (overrides command line flags)
|
||||||
-- This overrides user input.
|
|
||||||
}
|
}
|
||||||
|
|
||||||
balanceviewmode :: BalanceView -> Mode RawOpts
|
-- | Generate a cmdargs option-parsing mode from a compound balance command
|
||||||
balanceviewmode BalanceView{..} = (defCommandMode $ bvmode : bvaliases) {
|
-- specification.
|
||||||
modeHelp = bvhelp `withAliases` bvaliases
|
balanceCommandMode :: BalanceCommandSpec -> Mode RawOpts
|
||||||
|
balanceCommandMode BalanceCommandSpec{..} = (defCommandMode $ bcname : bcaliases) {
|
||||||
|
modeHelp = bchelp `withAliases` bcaliases
|
||||||
,modeGroupFlags = C.Group {
|
,modeGroupFlags = C.Group {
|
||||||
groupUnnamed = [
|
groupUnnamed = [
|
||||||
flagNone ["change"] (\opts -> setboolopt "change" opts)
|
flagNone ["change"] (\opts -> setboolopt "change" opts)
|
||||||
@ -68,63 +67,21 @@ balanceviewmode BalanceView{..} = (defCommandMode $ bvmode : bvaliases) {
|
|||||||
}
|
}
|
||||||
where
|
where
|
||||||
defType :: BalanceType -> String
|
defType :: BalanceType -> String
|
||||||
defType bt | bt == bvtype = " (default)"
|
defType bt | bt == bctype = " (default)"
|
||||||
| otherwise = ""
|
| otherwise = ""
|
||||||
|
|
||||||
balanceviewQueryReport
|
-- | Generate a runnable command from a compound balance command specification.
|
||||||
:: ReportOpts
|
balanceCommand :: BalanceCommandSpec -> (CliOpts -> Journal -> IO ())
|
||||||
-> Query
|
balanceCommand BalanceCommandSpec{..} CliOpts{command_=cmd, reportopts_=ropts, rawopts_=raw} j = do
|
||||||
-> Journal
|
|
||||||
-> String
|
|
||||||
-> (Journal -> Query)
|
|
||||||
-> ([String], Sum MixedAmount)
|
|
||||||
balanceviewQueryReport ropts q0 j t q = ([view], Sum amt)
|
|
||||||
where
|
|
||||||
q' = And [q0, q j]
|
|
||||||
rep@(_ , amt)
|
|
||||||
-- For --historical/--cumulative, we must use multiBalanceReport.
|
|
||||||
-- (This forces --no-elide.)
|
|
||||||
-- See Balance.hs's implementation of 'balance' for more information
|
|
||||||
| balancetype_ ropts `elem` [HistoricalBalance, CumulativeChange]
|
|
||||||
= singleBalanceReport ropts q' j
|
|
||||||
| otherwise
|
|
||||||
= balanceReport ropts q' j
|
|
||||||
view = intercalate "\n" [t <> ":", balanceReportAsText ropts rep]
|
|
||||||
|
|
||||||
multiBalanceviewQueryReport
|
|
||||||
:: ReportOpts
|
|
||||||
-> Query
|
|
||||||
-> Journal
|
|
||||||
-> String
|
|
||||||
-> (Journal -> Query)
|
|
||||||
-> ([Table String String MixedAmount], [[MixedAmount]], Sum MixedAmount)
|
|
||||||
multiBalanceviewQueryReport ropts q0 j t q = ([tabl], [coltotals], Sum tot)
|
|
||||||
where
|
|
||||||
singlesection = "Cash" `isPrefixOf` t -- TODO temp
|
|
||||||
ropts' = ropts { no_total_ = singlesection && no_total_ ropts, empty_ = True }
|
|
||||||
q' = And [q0, q j]
|
|
||||||
MultiBalanceReport (dates, rows, (coltotals,tot,avg)) =
|
|
||||||
multiBalanceReport ropts' q' j
|
|
||||||
rows' | empty_ ropts = rows
|
|
||||||
| otherwise = filter (not . emptyRow) rows
|
|
||||||
where
|
|
||||||
emptyRow (_,_,_,amts,_,_) = all isZeroMixedAmount amts
|
|
||||||
r = MultiBalanceReport (dates, rows', (coltotals, tot, avg))
|
|
||||||
Table hLeft hTop dat = balanceReportAsTable ropts' r
|
|
||||||
tabl = Table (T.Group SingleLine [Header t, hLeft]) hTop ([]:dat)
|
|
||||||
|
|
||||||
-- | Prints out a balance report according to a given view
|
|
||||||
balanceviewReport :: BalanceView -> CliOpts -> Journal -> IO ()
|
|
||||||
balanceviewReport BalanceView{..} CliOpts{command_=cmd, reportopts_=ropts, rawopts_=raw} j = do
|
|
||||||
currDay <- getCurrentDay
|
currDay <- getCurrentDay
|
||||||
let q0 = queryFromOpts currDay ropts'
|
let q0 = queryFromOpts currDay ropts'
|
||||||
let title = bvtitle ++ maybe "" (' ':) balanceclarification
|
let title = bctitle ++ maybe "" (' ':) balanceclarification
|
||||||
case interval_ ropts' of
|
case interval_ ropts' of
|
||||||
NoInterval -> do
|
NoInterval -> do
|
||||||
let (views, amt) =
|
let (subreportstrs, amt) =
|
||||||
foldMap (uncurry (balanceviewQueryReport ropts' q0 j))
|
foldMap (uncurry (balanceCommandSingleColumnReport ropts' q0 j))
|
||||||
bvqueries
|
bcqueries
|
||||||
mapM_ putStrLn (title : "" : views)
|
mapM_ putStrLn (title : "" : subreportstrs)
|
||||||
|
|
||||||
unless (no_total_ ropts' || cmd=="cashflow") . mapM_ putStrLn $ -- TODO temp
|
unless (no_total_ ropts' || cmd=="cashflow") . mapM_ putStrLn $ -- TODO temp
|
||||||
[ "Total:"
|
[ "Total:"
|
||||||
@ -133,7 +90,7 @@ balanceviewReport BalanceView{..} CliOpts{command_=cmd, reportopts_=ropts, rawop
|
|||||||
]
|
]
|
||||||
_ -> do
|
_ -> do
|
||||||
let (tabls, amts, Sum totsum)
|
let (tabls, amts, Sum totsum)
|
||||||
= foldMap (uncurry (multiBalanceviewQueryReport ropts' q0 j)) bvqueries
|
= foldMap (uncurry (balanceCommandMultiColumnReports ropts' q0 j)) bcqueries
|
||||||
sumAmts = case amts of
|
sumAmts = case amts of
|
||||||
a1:as -> foldl' (zipWith (+)) a1 as
|
a1:as -> foldl' (zipWith (+)) a1 as
|
||||||
[] -> []
|
[] -> []
|
||||||
@ -142,7 +99,7 @@ balanceviewReport BalanceView{..} CliOpts{command_=cmd, reportopts_=ropts, rawop
|
|||||||
t1:ts -> foldl' merging t1 ts
|
t1:ts -> foldl' merging t1 ts
|
||||||
[] -> T.empty
|
[] -> T.empty
|
||||||
totTabl
|
totTabl
|
||||||
| no_total_ ropts' || length bvqueries == 1 =
|
| no_total_ ropts' || length bcqueries == 1 =
|
||||||
mergedTabl
|
mergedTabl
|
||||||
| otherwise =
|
| otherwise =
|
||||||
mergedTabl
|
mergedTabl
|
||||||
@ -162,7 +119,7 @@ balanceviewReport BalanceView{..} CliOpts{command_=cmd, reportopts_=ropts, rawop
|
|||||||
"cumulative":_ -> Just CumulativeChange
|
"cumulative":_ -> Just CumulativeChange
|
||||||
"change":_ -> Just PeriodChange
|
"change":_ -> Just PeriodChange
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
balancetype = fromMaybe bvtype overwriteBalanceType
|
balancetype = fromMaybe bctype overwriteBalanceType
|
||||||
-- we must clarify that the statements aren't actual income statements,
|
-- we must clarify that the statements aren't actual income statements,
|
||||||
-- etc. if the user overrides the balance type
|
-- etc. if the user overrides the balance type
|
||||||
balanceclarification = flip fmap overwriteBalanceType $ \t ->
|
balanceclarification = flip fmap overwriteBalanceType $ \t ->
|
||||||
@ -186,3 +143,52 @@ balanceviewReport BalanceView{..} CliOpts{command_=cmd, reportopts_=ropts, rawop
|
|||||||
_ -> id
|
_ -> id
|
||||||
merging (Table hLeft hTop dat) (Table hLeft' _ dat') =
|
merging (Table hLeft hTop dat) (Table hLeft' _ dat') =
|
||||||
Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat')
|
Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat')
|
||||||
|
|
||||||
|
-- | Run one subreport for a single-column compound balance command.
|
||||||
|
-- Currently this returns the plain text rendering of the subreport,
|
||||||
|
-- and its total.
|
||||||
|
balanceCommandSingleColumnReport
|
||||||
|
:: ReportOpts
|
||||||
|
-> Query
|
||||||
|
-> Journal
|
||||||
|
-> String
|
||||||
|
-> (Journal -> Query)
|
||||||
|
-> ([String], Sum MixedAmount)
|
||||||
|
balanceCommandSingleColumnReport ropts q0 j t q = ([view], Sum amt)
|
||||||
|
where
|
||||||
|
q' = And [q0, q j]
|
||||||
|
rep@(_ , amt)
|
||||||
|
-- For --historical/--cumulative, we must use multiBalanceReport.
|
||||||
|
-- (This forces --no-elide.)
|
||||||
|
-- See Balance.hs's implementation of 'balance' for more information
|
||||||
|
| balancetype_ ropts `elem` [HistoricalBalance, CumulativeChange]
|
||||||
|
= singleBalanceReport ropts q' j
|
||||||
|
| otherwise
|
||||||
|
= balanceReport ropts q' j
|
||||||
|
view = intercalate "\n" [t <> ":", balanceReportAsText ropts rep]
|
||||||
|
|
||||||
|
-- | Run all the subreports for a multi-column compound balance command.
|
||||||
|
-- Currently this returns a table of rendered balance amounts for each
|
||||||
|
-- subreport, the totals row for each subreport, and the grand total.
|
||||||
|
balanceCommandMultiColumnReports
|
||||||
|
:: ReportOpts
|
||||||
|
-> Query
|
||||||
|
-> Journal
|
||||||
|
-> String
|
||||||
|
-> (Journal -> Query)
|
||||||
|
-> ([Table String String MixedAmount], [[MixedAmount]], Sum MixedAmount)
|
||||||
|
balanceCommandMultiColumnReports ropts q0 j t q = ([tabl], [coltotals], Sum tot)
|
||||||
|
where
|
||||||
|
singlesection = "Cash" `isPrefixOf` t -- TODO temp
|
||||||
|
ropts' = ropts { no_total_ = singlesection && no_total_ ropts, empty_ = True }
|
||||||
|
q' = And [q0, q j]
|
||||||
|
MultiBalanceReport (dates, rows, (coltotals,tot,avg)) =
|
||||||
|
multiBalanceReport ropts' q' j
|
||||||
|
rows' | empty_ ropts = rows
|
||||||
|
| otherwise = filter (not . emptyRow) rows
|
||||||
|
where
|
||||||
|
emptyRow (_,_,_,amts,_,_) = all isZeroMixedAmount amts
|
||||||
|
r = MultiBalanceReport (dates, rows', (coltotals, tot, avg))
|
||||||
|
Table hLeft hTop dat = balanceReportAsTable ropts' r
|
||||||
|
tabl = Table (T.Group SingleLine [Header t, hLeft]) hTop ([]:dat)
|
||||||
|
|
@ -17,29 +17,29 @@ import Test.HUnit
|
|||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Cli.BalanceView
|
import Hledger.Cli.BalanceCommand
|
||||||
|
|
||||||
balancesheetBV = BalanceView {
|
balancesheetSpec = BalanceCommandSpec {
|
||||||
bvmode = "balancesheet",
|
bcname = "balancesheet",
|
||||||
bvaliases = ["bs"],
|
bcaliases = ["bs"],
|
||||||
bvhelp = [here|
|
bchelp = [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).
|
||||||
|],
|
|],
|
||||||
bvtitle = "Balance Sheet",
|
bctitle = "Balance Sheet",
|
||||||
bvqueries = [ ("Assets" , journalAssetAccountQuery),
|
bcqueries = [ ("Assets" , journalAssetAccountQuery),
|
||||||
("Liabilities", journalLiabilityAccountQuery)
|
("Liabilities", journalLiabilityAccountQuery)
|
||||||
],
|
],
|
||||||
bvtype = HistoricalBalance
|
bctype = HistoricalBalance
|
||||||
}
|
}
|
||||||
|
|
||||||
balancesheetmode :: Mode RawOpts
|
balancesheetmode :: Mode RawOpts
|
||||||
balancesheetmode = balanceviewmode balancesheetBV
|
balancesheetmode = balanceCommandMode balancesheetSpec
|
||||||
|
|
||||||
balancesheet :: CliOpts -> Journal -> IO ()
|
balancesheet :: CliOpts -> Journal -> IO ()
|
||||||
balancesheet = balanceviewReport balancesheetBV
|
balancesheet = balanceCommand 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.BalanceView
|
import Hledger.Cli.BalanceCommand
|
||||||
|
|
||||||
cashflowBV = BalanceView {
|
cashflowSpec = BalanceCommandSpec {
|
||||||
bvmode = "cashflow",
|
bcname = "cashflow",
|
||||||
bvaliases = ["cf"],
|
bcaliases = ["cf"],
|
||||||
bvhelp = [here|
|
bchelp = [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.
|
||||||
|],
|
|],
|
||||||
bvtitle = "Cashflow Statement",
|
bctitle = "Cashflow Statement",
|
||||||
bvqueries = [("Cash flows", journalCashAccountQuery)],
|
bcqueries = [("Cash flows", journalCashAccountQuery)],
|
||||||
bvtype = PeriodChange
|
bctype = PeriodChange
|
||||||
}
|
}
|
||||||
|
|
||||||
cashflowmode :: Mode RawOpts
|
cashflowmode :: Mode RawOpts
|
||||||
cashflowmode = balanceviewmode cashflowBV
|
cashflowmode = balanceCommandMode cashflowSpec
|
||||||
|
|
||||||
cashflow :: CliOpts -> Journal -> IO ()
|
cashflow :: CliOpts -> Journal -> IO ()
|
||||||
cashflow = balanceviewReport cashflowBV
|
cashflow = balanceCommand cashflowSpec
|
||||||
|
|
||||||
tests_Hledger_Cli_Cashflow :: Test
|
tests_Hledger_Cli_Cashflow :: Test
|
||||||
tests_Hledger_Cli_Cashflow = TestList
|
tests_Hledger_Cli_Cashflow = TestList
|
||||||
|
@ -17,29 +17,29 @@ import Test.HUnit
|
|||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Cli.BalanceView
|
import Hledger.Cli.BalanceCommand
|
||||||
|
|
||||||
incomestatementBV = BalanceView {
|
incomestatementSpec = BalanceCommandSpec {
|
||||||
bvmode = "incomestatement",
|
bcname = "incomestatement",
|
||||||
bvaliases = ["is"],
|
bcaliases = ["is"],
|
||||||
bvhelp = [here|
|
bchelp = [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).
|
||||||
|],
|
|],
|
||||||
bvtitle = "Income Statement",
|
bctitle = "Income Statement",
|
||||||
bvqueries = [ ("Revenues", journalIncomeAccountQuery),
|
bcqueries = [ ("Revenues", journalIncomeAccountQuery),
|
||||||
("Expenses", journalExpenseAccountQuery)
|
("Expenses", journalExpenseAccountQuery)
|
||||||
],
|
],
|
||||||
bvtype = PeriodChange
|
bctype = PeriodChange
|
||||||
}
|
}
|
||||||
|
|
||||||
incomestatementmode :: Mode RawOpts
|
incomestatementmode :: Mode RawOpts
|
||||||
incomestatementmode = balanceviewmode incomestatementBV
|
incomestatementmode = balanceCommandMode incomestatementSpec
|
||||||
|
|
||||||
incomestatement :: CliOpts -> Journal -> IO ()
|
incomestatement :: CliOpts -> Journal -> IO ()
|
||||||
incomestatement = balanceviewReport incomestatementBV
|
incomestatement = balanceCommand 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.BalanceView
|
Hledger.Cli.BalanceCommand
|
||||||
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.BalanceView
|
- Hledger.Cli.BalanceCommand
|
||||||
- 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