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

hledger/Hledger/Cli/Balance.hs

@@ -239,16 +239,15 @@ module Hledger.Cli.Balance (
  ,balance
  ,balanceReportAsText
  ,balanceReportItemAsText
- ,periodChangeReportAsText
+ ,multiBalanceReportAsText
- ,cumulativeChangeReportAsText
+ ,renderBalanceReportTable
- ,historicalBalanceReportAsText
+ ,balanceReportAsTable
  ,tests_Hledger_Cli_Balance
 ) where
 
 import Data.List (intercalate)
 import Data.Maybe
-import Data.Monoid
+-- import Data.Monoid
--- import Data.Text (Text)
 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
+                _     -> multiBalanceReportAsText
-                  PeriodChange     -> periodChangeReportAsText
-                  CumulativeChange -> cumulativeChangeReportAsText
-                  HistoricalBalance -> historicalBalanceReportAsText
           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.
+-- | Render a multi-column balance report as plain text suitable for console output.
-periodChangeReportAsText :: ReportOpts -> MultiBalanceReport -> String
+multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
-periodChangeReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
+multiBalanceReportAsText opts r =
-  unlines $
+    printf "%s in %s:" typeStr (showDateSpan $ multiBalanceReportSpan r)
-  ([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
+      ++ "\n"
-  trimborder $ lines $
+      ++ renderBalanceReportTable tabl
-   render id (" "++) showMixedAmountOneLineWithoutPrice $
+  where
-    addtotalrow $
+    tabl = balanceReportAsTable opts r
-     Table
+    typeStr :: String
-     (T.Group NoLine $ map (Header . padRightWide acctswidth . T.unpack) accts)
+    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)
+    mkDate = case balancetype_ opts of
-    colheadings = map showDateSpan colspans
+       PeriodChange -> showDateSpan
-                  ++ (if row_total_ opts then ["  Total"] else [])
+       _            -> maybe "" (showDate . prevday) . spanEnd
-                  ++ (if average_ opts then ["Average"] else [])
+    colheadings = map mkDate colspans
-    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
                   ++ (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 [])

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,
+      bvtype     :: BalanceType                    -- ^ the type of balance this view shows.
-                                                   --   ignoring begin date in reporting period
+                                                   --   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
+balanceviewReport BalanceView{..} CliOpts{reportopts_=ropts, rawopts_=raw} j = do
-  currDay   <- getCurrentDay
+    currDay   <- getCurrentDay
-  let q0 | bvsnapshot = queryFromOpts currDay (withoutBeginDate ropts)
+    let q0 = queryFromOpts currDay ropts'
-         | otherwise  = queryFromOpts currDay ropts
+    case interval_ ropts' of
-      (views, amt) =
+      NoInterval -> do
-        foldMap (uncurry (balanceviewQueryReport ropts q0 j))
+        let (views, amt) =
-           bvqueries
+              foldMap (uncurry (balanceviewQueryReport ropts' q0 j))
-  mapM_ putStrLn (bvtitle : "" : views)
+                 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}

hledger/Hledger/Cli/Balancesheet.hs

@@ -26,7 +26,7 @@ bsBV = BalanceView {
          bvqueries  = [ ("Assets"     , journalAssetAccountQuery),
                         ("Liabilities", journalLiabilityAccountQuery)
                       ],
-         bvsnapshot = True
+         bvtype     = HistoricalBalance
       }
 
 balancesheetmode :: Mode RawOpts

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

hledger/Hledger/Cli/Incomestatement.hs

@@ -26,7 +26,7 @@ isBV = BalanceView {
          bvqueries  = [ ("Revenues", journalIncomeAccountQuery),
                         ("Expenses", journalExpenseAccountQuery)
                       ],
-         bvsnapshot = False
+         bvtype     = PeriodChange
       }
 
 incomestatementmode :: Mode RawOpts