diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index 4f4499f34..47a9f32ef 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -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 []) diff --git a/hledger/Hledger/Cli/BalanceView.hs b/hledger/Hledger/Cli/BalanceView.hs index e11ae5b63..c45e77e22 100644 --- a/hledger/Hledger/Cli/BalanceView.hs +++ b/hledger/Hledger/Cli/BalanceView.hs @@ -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} diff --git a/hledger/Hledger/Cli/Balancesheet.hs b/hledger/Hledger/Cli/Balancesheet.hs index 5689134c3..4b0557664 100644 --- a/hledger/Hledger/Cli/Balancesheet.hs +++ b/hledger/Hledger/Cli/Balancesheet.hs @@ -26,7 +26,7 @@ bsBV = BalanceView { bvqueries = [ ("Assets" , journalAssetAccountQuery), ("Liabilities", journalLiabilityAccountQuery) ], - bvsnapshot = True + bvtype = HistoricalBalance } balancesheetmode :: Mode RawOpts diff --git a/hledger/Hledger/Cli/Cashflow.hs b/hledger/Hledger/Cli/Cashflow.hs index 6d06f7165..7fd8fcdbb 100644 --- a/hledger/Hledger/Cli/Cashflow.hs +++ b/hledger/Hledger/Cli/Cashflow.hs @@ -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 diff --git a/hledger/Hledger/Cli/Incomestatement.hs b/hledger/Hledger/Cli/Incomestatement.hs index 3ffcc4e66..5eacfc7e9 100644 --- a/hledger/Hledger/Cli/Incomestatement.hs +++ b/hledger/Hledger/Cli/Incomestatement.hs @@ -26,7 +26,7 @@ isBV = BalanceView { bvqueries = [ ("Revenues", journalIncomeAccountQuery), ("Expenses", journalExpenseAccountQuery) ], - bvsnapshot = False + bvtype = PeriodChange } incomestatementmode :: Mode RawOpts