Multicolumn reports for bs/cf/is, and -T/-A support (#518)
* factored out multi-column balance reporting into table creation and string rendering * preliminary multicolumn balance reporting for BalanceView * added -T and -A options for balance views * support for overriding balanceview defaults * fixed unecessary whitespace stripping to make tree view work * no need for ViewPatterns in BalanceView * fixed regression where balancesheet didn't ignore the start date when in single column mode * removed trailing whitespace to pass tests * handling warnings in Balance.hs * force -E to line up lines for bs/is/cf
This commit is contained in:
Justin Le
Simon Michael
parent
88111b61a1
commit
abfa0a6e01
@ -239,16 +239,15 @@ module Hledger.Cli.Balance (
|
||||
,balance
|
||||
,balanceReportAsText
|
||||
,balanceReportItemAsText
|
||||
,periodChangeReportAsText
|
||||
,cumulativeChangeReportAsText
|
||||
,historicalBalanceReportAsText
|
||||
,multiBalanceReportAsText
|
||||
,renderBalanceReportTable
|
||||
,balanceReportAsTable
|
||||
,tests_Hledger_Cli_Balance
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
-- import Data.Text (Text)
|
||||
-- import Data.Monoid
|
||||
import qualified Data.Text as T
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
import Text.CSV
|
||||
@ -298,7 +297,6 @@ balance opts@CliOpts{reportopts_=ropts} j = do
|
||||
Right _ -> do
|
||||
let format = outputFormatFromOpts opts
|
||||
interval = interval_ ropts
|
||||
baltype = balancetype_ ropts
|
||||
-- shenanigans: use single/multiBalanceReport when we must,
|
||||
-- ie when there's a report interval, or --historical or -- cumulative.
|
||||
-- Otherwise prefer the older balanceReport since it can elide boring parents.
|
||||
@ -320,10 +318,7 @@ balance opts@CliOpts{reportopts_=ropts} j = do
|
||||
let report = multiBalanceReport ropts (queryFromOpts d ropts) j
|
||||
render = case format of
|
||||
"csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r
|
||||
_ -> case baltype of
|
||||
PeriodChange -> periodChangeReportAsText
|
||||
CumulativeChange -> cumulativeChangeReportAsText
|
||||
HistoricalBalance -> historicalBalanceReportAsText
|
||||
_ -> multiBalanceReportAsText
|
||||
writeOutput opts $ render ropts report
|
||||
|
||||
-- single-column balance reports
|
||||
@ -475,94 +470,52 @@ multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,to
|
||||
++ (if average_ opts then [avg] else [])
|
||||
)]
|
||||
|
||||
-- | Render a multi-column period balance report as plain text suitable for console output.
|
||||
periodChangeReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
||||
periodChangeReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
|
||||
unlines $
|
||||
([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
|
||||
trimborder $ lines $
|
||||
render id (" "++) showMixedAmountOneLineWithoutPrice $
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map (Header . padRightWide acctswidth . T.unpack) accts)
|
||||
-- | Render a multi-column balance report as plain text suitable for console output.
|
||||
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
||||
multiBalanceReportAsText opts r =
|
||||
printf "%s in %s:" typeStr (showDateSpan $ multiBalanceReportSpan r)
|
||||
++ "\n"
|
||||
++ renderBalanceReportTable tabl
|
||||
where
|
||||
tabl = balanceReportAsTable opts r
|
||||
typeStr :: String
|
||||
typeStr = case balancetype_ opts of
|
||||
PeriodChange -> "Balance changes"
|
||||
CumulativeChange -> "Ending balances (cumulative)"
|
||||
HistoricalBalance -> "Ending balances (historical)"
|
||||
|
||||
-- | Given a table representing a multi-column balance report (for example,
|
||||
-- made using 'balanceReportAsTable'), render it in a format suitable for
|
||||
-- console output.
|
||||
renderBalanceReportTable :: Table String String MixedAmount -> String
|
||||
renderBalanceReportTable = unlines . trimborder . lines
|
||||
. render id (" " ++) showMixedAmountOneLineWithoutPrice
|
||||
. align
|
||||
where
|
||||
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
|
||||
align (Table l t d) = Table l' t d
|
||||
where
|
||||
acctswidth = maximum' $ map strWidth (headerContents l)
|
||||
l' = padRightWide acctswidth <$> l
|
||||
|
||||
-- | Build a 'Table' from a multi-column balance report.
|
||||
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
|
||||
balanceReportAsTable opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
|
||||
addtotalrow $ Table
|
||||
(T.Group NoLine $ map Header accts)
|
||||
(T.Group NoLine $ map Header colheadings)
|
||||
(map rowvals items')
|
||||
(map rowvals items)
|
||||
where
|
||||
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
|
||||
colheadings = map showDateSpan colspans
|
||||
++ (if row_total_ opts then [" Total"] else [])
|
||||
++ (if average_ opts then ["Average"] else [])
|
||||
items' | empty_ opts = items
|
||||
| otherwise = items -- dbg1 "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg1 "1" items
|
||||
accts = map renderacct items'
|
||||
renderacct (a,a',i,_,_,_)
|
||||
| tree_ opts = T.replicate ((i-1)*2) " " <> a'
|
||||
| otherwise = maybeAccountNameDrop opts a
|
||||
acctswidth = maximum' $ map textWidth accts
|
||||
rowvals (_,_,_,as,rowtot,rowavg) = as
|
||||
++ (if row_total_ opts then [rowtot] else [])
|
||||
++ (if average_ opts then [rowavg] else [])
|
||||
addtotalrow | no_total_ opts = id
|
||||
| otherwise = (+----+ (row "" $
|
||||
coltotals
|
||||
++ (if row_total_ opts then [tot] else [])
|
||||
++ (if average_ opts then [avg] else [])
|
||||
))
|
||||
|
||||
-- | Render a multi-column cumulative balance report as plain text suitable for console output.
|
||||
cumulativeChangeReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
||||
cumulativeChangeReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
|
||||
unlines $
|
||||
([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
|
||||
trimborder $ lines $
|
||||
render id (" "++) showMixedAmountOneLineWithoutPrice $
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
|
||||
(T.Group NoLine $ map Header colheadings)
|
||||
(map rowvals items)
|
||||
where
|
||||
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
|
||||
colheadings = map (maybe "" (showDate . prevday) . spanEnd) colspans
|
||||
mkDate = case balancetype_ opts of
|
||||
PeriodChange -> showDateSpan
|
||||
_ -> maybe "" (showDate . prevday) . spanEnd
|
||||
colheadings = map mkDate colspans
|
||||
++ (if row_total_ opts then [" Total"] else [])
|
||||
++ (if average_ opts then ["Average"] else [])
|
||||
accts = map renderacct items
|
||||
renderacct (a,a',i,_,_,_)
|
||||
| tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a'
|
||||
| otherwise = T.unpack $ maybeAccountNameDrop opts a
|
||||
acctswidth = maximum' $ map strWidth accts
|
||||
rowvals (_,_,_,as,rowtot,rowavg) = as
|
||||
++ (if row_total_ opts then [rowtot] else [])
|
||||
++ (if average_ opts then [rowavg] else [])
|
||||
addtotalrow | no_total_ opts = id
|
||||
| otherwise = (+----+ (row "" $
|
||||
coltotals
|
||||
++ (if row_total_ opts then [tot] else [])
|
||||
++ (if average_ opts then [avg] else [])
|
||||
))
|
||||
|
||||
-- | Render a multi-column historical balance report as plain text suitable for console output.
|
||||
historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
|
||||
historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
|
||||
unlines $
|
||||
([printf "Ending balances (historical) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
|
||||
trimborder $ lines $
|
||||
render id (" "++) showMixedAmountOneLineWithoutPrice $
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
|
||||
(T.Group NoLine $ map Header colheadings)
|
||||
(map rowvals items)
|
||||
where
|
||||
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
|
||||
colheadings = map (maybe "" (showDate . prevday) . spanEnd) colspans
|
||||
++ (if row_total_ opts then [" Total"] else [])
|
||||
++ (if average_ opts then ["Average"] else [])
|
||||
accts = map renderacct items
|
||||
renderacct (a,a',i,_,_,_)
|
||||
| tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack a'
|
||||
| otherwise = T.unpack $ maybeAccountNameDrop opts a
|
||||
acctswidth = maximum' $ map strWidth accts
|
||||
rowvals (_,_,_,as,rowtot,rowavg) = as
|
||||
++ (if row_total_ opts then [rowtot] else [])
|
||||
++ (if average_ opts then [rowavg] else [])
|
||||
|
||||
@ -15,9 +15,10 @@ module Hledger.Cli.BalanceView (
|
||||
) where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.List (intercalate)
|
||||
import Data.List (intercalate, foldl')
|
||||
import Data.Monoid (Sum(..), (<>))
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
import Text.Tabular as T
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.Balance
|
||||
@ -31,18 +32,31 @@ data BalanceView = BalanceView {
|
||||
bvhelp :: String, -- ^ command line help message
|
||||
bvtitle :: String, -- ^ title of the view
|
||||
bvqueries :: [(String, Journal -> Query)], -- ^ named queries that make up the view
|
||||
bvsnapshot :: Bool -- ^ whether or not the view is a snapshot,
|
||||
-- ignoring begin date in reporting period
|
||||
bvtype :: BalanceType -- ^ the type of balance this view shows.
|
||||
-- This overrides user input.
|
||||
}
|
||||
|
||||
balanceviewmode :: BalanceView -> Mode RawOpts
|
||||
balanceviewmode BalanceView{..} = (defCommandMode $ bvmode : bvaliases) {
|
||||
modeHelp = bvhelp `withAliases` bvaliases
|
||||
,modeGroupFlags = Group {
|
||||
,modeGroupFlags = C.Group {
|
||||
groupUnnamed = [
|
||||
flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list"
|
||||
flagNone ["change"] (\opts -> setboolopt "change" opts)
|
||||
("show balance change in each period" ++ defType PeriodChange)
|
||||
,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts)
|
||||
("show balance change accumulated across periods (in multicolumn reports)"
|
||||
++ defType CumulativeChange
|
||||
)
|
||||
,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts)
|
||||
("show historical ending balance in each period (includes postings before report start date)"
|
||||
++ defType HistoricalBalance
|
||||
)
|
||||
,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list"
|
||||
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"
|
||||
,flagNone ["no-total","N"] (\opts -> setboolopt "no-total" opts) "omit the final total row"
|
||||
,flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree; amounts include subaccounts (default in simple reports)"
|
||||
,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a row average column (in multicolumn reports)"
|
||||
,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "show a row total column (in multicolumn reports)"
|
||||
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't squash boring parent accounts (in tree mode)"
|
||||
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)"
|
||||
]
|
||||
@ -50,6 +64,10 @@ balanceviewmode BalanceView{..} = (defCommandMode $ bvmode : bvaliases) {
|
||||
,groupNamed = [generalflagsgroup1]
|
||||
}
|
||||
}
|
||||
where
|
||||
defType :: BalanceType -> String
|
||||
defType bt | bt == bvtype = " (default)"
|
||||
| otherwise = ""
|
||||
|
||||
balanceviewQueryReport
|
||||
:: ReportOpts
|
||||
@ -64,22 +82,73 @@ balanceviewQueryReport ropts q0 j t q = ([view], Sum amt)
|
||||
rep@(_ , amt) = 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
|
||||
ropts' = ropts { no_total_ = False }
|
||||
q' = And [q0, q j]
|
||||
r@(MultiBalanceReport (_, _, (coltotals,tot,_))) =
|
||||
multiBalanceReport ropts' q' j
|
||||
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{reportopts_=ropts} j = do
|
||||
currDay <- getCurrentDay
|
||||
let q0 | bvsnapshot = queryFromOpts currDay (withoutBeginDate ropts)
|
||||
| otherwise = queryFromOpts currDay ropts
|
||||
(views, amt) =
|
||||
foldMap (uncurry (balanceviewQueryReport ropts q0 j))
|
||||
bvqueries
|
||||
mapM_ putStrLn (bvtitle : "" : views)
|
||||
balanceviewReport BalanceView{..} CliOpts{reportopts_=ropts, rawopts_=raw} j = do
|
||||
currDay <- getCurrentDay
|
||||
let q0 = queryFromOpts currDay ropts'
|
||||
case interval_ ropts' of
|
||||
NoInterval -> do
|
||||
let (views, amt) =
|
||||
foldMap (uncurry (balanceviewQueryReport ropts' q0 j))
|
||||
bvqueries
|
||||
mapM_ putStrLn (bvtitle : "" : views)
|
||||
|
||||
unless (no_total_ ropts') . mapM_ putStrLn $
|
||||
[ "Total:"
|
||||
, "--------------------"
|
||||
, padleft 20 $ showMixedAmountWithoutPrice (getSum amt)
|
||||
]
|
||||
_ -> do
|
||||
let (tabls, amts, Sum totsum)
|
||||
= foldMap (uncurry (multiBalanceviewQueryReport ropts' q0 j)) bvqueries
|
||||
sumAmts = case amts of
|
||||
a1:as -> foldl' (zipWith (+)) a1 as
|
||||
[] -> []
|
||||
mergedTabl = case tabls of
|
||||
t1:ts -> foldl' merging t1 ts
|
||||
[] -> T.empty
|
||||
totTabl | no_total_ ropts' = mergedTabl
|
||||
| otherwise =
|
||||
mergedTabl
|
||||
+====+
|
||||
row "Total"
|
||||
(sumAmts ++ if row_total_ ropts' then [totsum] else [])
|
||||
putStrLn bvtitle
|
||||
putStrLn $ renderBalanceReportTable totTabl
|
||||
where
|
||||
balancetype =
|
||||
case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst raw of
|
||||
"historical":_ -> HistoricalBalance
|
||||
"cumulative":_ -> CumulativeChange
|
||||
"change":_ -> PeriodChange
|
||||
_ -> bvtype
|
||||
ropts' = emptyMulti . stripBeginDate $ ropts { balancetype_ = balancetype }
|
||||
stripBeginDate = case (balancetype, interval_ ropts) of
|
||||
(HistoricalBalance, NoInterval) -> withoutBeginDate
|
||||
_ -> id
|
||||
emptyMulti = case interval_ ropts of
|
||||
NoInterval -> id
|
||||
_ -> \o -> o { empty_ = True }
|
||||
merging (Table hLeft hTop dat) (Table hLeft' _ dat') =
|
||||
Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat')
|
||||
|
||||
unless (no_total_ ropts) . mapM_ putStrLn $
|
||||
[ "Total:"
|
||||
, "--------------------"
|
||||
, padleft 20 $ showMixedAmountWithoutPrice (getSum amt)
|
||||
]
|
||||
|
||||
withoutBeginDate :: ReportOpts -> ReportOpts
|
||||
withoutBeginDate ropts@ReportOpts{..} = ropts{period_=p}
|
||||
|
||||
@ -26,7 +26,7 @@ bsBV = BalanceView {
|
||||
bvqueries = [ ("Assets" , journalAssetAccountQuery),
|
||||
("Liabilities", journalLiabilityAccountQuery)
|
||||
],
|
||||
bvsnapshot = True
|
||||
bvtype = HistoricalBalance
|
||||
}
|
||||
|
||||
balancesheetmode :: Mode RawOpts
|
||||
|
||||
@ -27,7 +27,7 @@ cfBV = BalanceView {
|
||||
bvhelp = "show a cashflow statement",
|
||||
bvtitle = "Cashflow Statement",
|
||||
bvqueries = [("Cash flows", journalCashAccountQuery)],
|
||||
bvsnapshot = False
|
||||
bvtype = PeriodChange
|
||||
}
|
||||
|
||||
cashflowmode :: Mode RawOpts
|
||||
|
||||
@ -26,7 +26,7 @@ isBV = BalanceView {
|
||||
bvqueries = [ ("Revenues", journalIncomeAccountQuery),
|
||||
("Expenses", journalExpenseAccountQuery)
|
||||
],
|
||||
bvsnapshot = False
|
||||
bvtype = PeriodChange
|
||||
}
|
||||
|
||||
incomestatementmode :: Mode RawOpts
|
||||
|
||||
Loading…
Reference in New Issue
Block a user