balance: basic multi-column balance (change) reports

MANUAL.md

@@ -753,6 +753,13 @@ In this mode you can also use `--drop N` to elide the first few account
 name components. Note `--depth` doesn't work too well with `--flat` currently;
 it hides deeper accounts rather than aggregating them.
 
+With a [reporting interval](#reporting-interval), multiple columns
+will be shown.  Note the values in each cell are the sum of postings
+in that period, equivalent to change of balance.  This is good for a
+multi-column cashflow report or income statement. Eg:
+
+    $ hledger balance ^income ^expense --monthly --depth 3
+
 #### incomestatement
 
 This command displays a simple

NEWS.md

@@ -22,10 +22,12 @@ title: hledger news
         hledger-print-unique.hs - print only journal entries unique descriptions
         hledger-register-csv.hs - print a register report as CSV
 
-
 - csv: don't break when there are non-ascii characters in CSV files
 - csv: rules files can now `include` other rules files, useful for factoring out common rules
 
+- balance: with a reporting interval (monthly, yearly etc.), the
+  balance report will now show multiple columns
+
 - balancesheet: equity is no longer shown, just assets and liabilities
 
 - print: comment positions (same line or next line) are now preserved

hledger-lib/Hledger/Data/Account.hs

@@ -49,8 +49,8 @@ nullacct = Account
   , aboring = False
   }
 
--- | Derive an account tree with balances from a set of postings.
+-- | Derive 1. an account tree and 2. their balances from a list of postings.
--- (*ledger's core feature.) The accounts are returned in a list, but
+-- (ledger's core feature). The accounts are returned in a list, but
 -- retain their tree structure; the first one is the root of the tree.
 accountsFromPostings :: [Posting] -> [Account]
 accountsFromPostings ps =
@@ -58,10 +58,9 @@ accountsFromPostings ps =
     acctamts = [(paccount p,pamount p) | p <- ps]
     grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts
     summed = map (\as@((aname,_):_) -> (aname, sum $ map snd as)) grouped -- always non-empty
-    setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}
     nametree = treeFromPaths $ map (expandAccountName . fst) summed
     acctswithnames = nameTreeToAccount "root" nametree
-    acctswithebals = mapAccounts setebalance acctswithnames
+    acctswithebals = mapAccounts setebalance acctswithnames where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}
     acctswithibals = sumAccounts acctswithebals
     acctswithparents = tieAccountParents acctswithibals
     acctsflattened = flattenAccounts acctswithparents
@@ -101,9 +100,6 @@ anyAccounts p a
     | otherwise = any (anyAccounts p) $ asubs a
 
 -- | Add subaccount-inclusive balances to an account tree.
--- -- , also noting
--- -- whether it has an interesting balance or interesting subs to help
--- -- with eliding later.
 sumAccounts :: Account -> Account
 sumAccounts a
   | null $ asubs a = a{aibalance=aebalance a}

hledger-lib/Hledger/Data/Dates.hs

@@ -31,6 +31,7 @@ module Hledger.Data.Dates (
   parsedateM,
   parsedate,
   showDate,
+  showDateSpan,
   elapsedSeconds,
   prevday,
   parsePeriodExpr,
@@ -77,6 +78,15 @@ import Hledger.Utils
 showDate :: Day -> String
 showDate = formatTime defaultTimeLocale "%C%y/%m/%d"
 
+showDateSpan (DateSpan from to) =
+  concat
+    [maybe "" showdate from
+    ,"-"
+    ,maybe "" (showdate . prevday) to
+    ]
+  where
+    showdate = formatTime defaultTimeLocale "%C%y/%m/%d"
+
 -- | Get the current local date.
 getCurrentDay :: IO Day
 getCurrentDay = do
@@ -598,19 +608,27 @@ doubledatespan rdate = do
   optional (string "from" >> many spacenonewline)
   b <- smartdate
   many spacenonewline
-  optional (string "to" >> many spacenonewline)
+  optional (choice [string "to", string "-"] >> many spacenonewline)
   e <- smartdate
   return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)
 
 fromdatespan :: Day -> GenParser Char st DateSpan
 fromdatespan rdate = do
+  b <- choice [
+    do
       string "from" >> many spacenonewline
-  b <- smartdate
+      smartdate
+    ,
+    do
+      d <- smartdate
+      string "-"
+      return d
+    ]
   return $ DateSpan (Just $ fixSmartDate rdate b) Nothing
 
 todatespan :: Day -> GenParser Char st DateSpan
 todatespan rdate = do
-  string "to" >> many spacenonewline
+  choice [string "to", string "-"] >> many spacenonewline
   e <- smartdate
   return $ DateSpan Nothing (Just $ fixSmartDate rdate e)
 

hledger-lib/Hledger/Reports.hs

@@ -43,6 +43,10 @@ module Hledger.Reports (
   AccountsReport,
   AccountsReportItem,
   accountsReport,
+  -- * Accounts report
+  FlowReport,
+  FlowReportItem,
+  flowReport,
   -- * Other "reports"
   accountBalanceHistory,
   -- * Tests
@@ -55,6 +59,7 @@ import Data.List
 import Data.Maybe
 -- import qualified Data.Map as M
 import Data.Ord
+import Data.PPrint
 import Data.Time.Calendar
 -- import Data.Tree
 import Safe (headMay, lastMay)
@@ -594,7 +599,7 @@ type AccountsReport = ([AccountsReportItem] -- line items, one per account
 type AccountsReportItem = (AccountName  -- full account name
                           ,AccountName  -- short account name for display (the leaf name, prefixed by any boring parents immediately above)
                           ,Int          -- how many steps to indent this account (0 with --flat, otherwise the 0-based account depth excluding boring parents)
-                          ,MixedAmount) -- account balance, includes subs unless --flat is present
+                          ,MixedAmount) -- account balance, includes subs  -- XXX unless --flat is present
 
 -- | Select accounts, and get their balances at the end of the selected
 -- period, and misc. display information, for an accounts report.
@@ -636,6 +641,114 @@ accountsReportItem opts a@Account{aname=name, aibalance=ibal}
     parents = init $ parentAccounts a
 
 
+-------------------------------------------------------------------------------
+
+-- There are two kinds of report we want here. A "periodic flow"
+-- report shows the change of account balance in each period, or
+-- equivalently (assuming accurate postings) the sum of postings in
+-- each period. Eg below, 20 is the sum of income postings in
+-- Jan. This is like a periodic income statement or (with cash
+-- accounts) cashflow statement.
+--
+-- Account   Jan   Feb   Mar
+-- income     20    10    -5
+--
+-- A "periodic balance" report shows the final account balance in each
+-- period, equivalent to the sum of all postings before the end of the
+-- period. Eg below, 120 is the sum of all asset postings before the
+-- end of Jan, including postings before january (or perhaps an
+-- "opening balance" posting). This is like a periodic balance sheet.
+--
+-- Acct      Jan   Feb   Mar
+-- asset     120   130   125
+--
+-- If the columns are consecutive periods, balances can be calculated
+-- from flows by beginning with the start-of-period balance (above,
+-- 100) and summing the flows rightward.
+    
+-- | A flow report is a list of account names (and associated
+-- rendering info), plus their change in balance during one or more
+-- periods (date spans). The periods are included, and also an overall
+-- total for each one.
+--
+type FlowReport =
+  ([DateSpan]               -- ^ the date span for each report column
+  ,[FlowReportItem]         -- ^ line items, one per account
+  ,[MixedAmount]            -- ^ the final total for each report column
+  )
+
+type FlowReportItem =
+--  (RenderableAccountName    -- ^ the account name and rendering hints
+  (AccountName
+  ,[MixedAmount]            -- ^ the account's change of (inclusive) balance in each of the report's periods
+  )
+
+type RenderableAccountName =
+  (AccountName              -- ^ full account name
+  ,AccountName              -- ^ ledger-style short account name (the leaf name, prefixed by any boring parents immediately above)
+  ,Int                      -- ^ indentation (in steps) to use when rendering a ledger-style account tree
+                            --   (the 0-based depth of this account excluding boring parents; or with --flat, 0)
+  )
+
+-- | Select accounts and get their flows (change of balance) in each
+-- period, plus misc. display information, for a flow report.
+flowReport :: ReportOpts -> Query -> Journal -> FlowReport
+flowReport opts q j = (spans, items, totals)
+    where
+      (q',depthq)  = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)
+      clip = filter (depthq `matchesAccount`)
+      j' = filterJournalPostings q' $ journalSelectingAmountFromOpts opts j
+      ps = journalPostings j'
+
+      -- the requested span is the span of the query (which is
+      -- based on -b/-e/-p opts and query args IIRC).
+      requestedspan = queryDateSpan (date2_ opts) q
+
+      -- the report's span will be the requested span intersected with
+      -- the selected data's span; or with -E, the requested span
+      -- limited by the journal's overall span.
+      reportspan | empty_ opts = requestedspan `orDatesFrom` journalspan
+                 | otherwise   = requestedspan `spanIntersect` matchedspan
+        where
+          journalspan = journalDateSpan j'
+          matchedspan = postingsDateSpan ps
+
+      -- first implementation, probably inefficient
+      spans               = dbg "1 " $ splitSpan (intervalFromOpts opts) reportspan
+      psPerSpan           = dbg "3"  $ [filter (isPostingInDateSpan s) ps | s <- spans]
+      acctnames           = dbg "4"  $ sort $ clip $ expandAccountNames $ accountNamesFromPostings ps
+      allAcctsZeros       = dbg "5"  $ [(a, nullmixedamt) | a <- acctnames]
+      someAcctBalsPerSpan = dbg "6"  $ [[(aname a, aibalance a) | a <- drop 1 $ accountsFromPostings ps, depthq `matchesAccount` aname a] | ps <- psPerSpan]
+      balsPerSpan         = dbg "7"  $ [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') acctbals allAcctsZeros | acctbals <- someAcctBalsPerSpan]
+      balsPerAcct         = dbg "8"  $ transpose balsPerSpan
+      items               = dbg "9"  $ zip acctnames $ map (map snd) balsPerAcct
+      totals              = dbg "10" $ [sum [b | (a,b) <- bals, accountNameLevel a == 1] | bals <- balsPerSpan]
+
+      dbg,dbg' :: Show a => String -> a -> a
+      dbg  = flip const
+      dbg' = lstrace
+        
+      -- accts'
+      --     | flat_ opts = filterzeros $ tail $ flattenAccounts accts
+      --     | otherwise  = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts
+      --     where
+      --       filterzeros | empty_ opts = id
+      --                   | otherwise = filter (not . isZeroMixedAmount . aebalance)
+      --       prunezeros | empty_ opts = id
+      --                  | otherwise   = fromMaybe nullacct . pruneAccounts (isZeroMixedAmount.aibalance)
+      --       markboring | no_elide_ opts = id
+      --                  | otherwise      = markBoringParentAccounts
+
+-- flowReportItem :: ReportOpts -> Account -> FlowReportItem
+-- flowReportItem opts a@Account{aname=name, aibalance=ibal}
+--   | flat_ opts = (name, name,       0,      ibal)
+--   | otherwise  = (name, elidedname, indent, ibal)
+--   where
+--     elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])
+--     adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring $ parents
+--     indent = length $ filter (not.aboring) parents
+--     parents = init $ parentAccounts a
+
 -------------------------------------------------------------------------------
 
 -- | Get the historical running inclusive balance of a particular account,

hledger-lib/hledger-lib.cabal

@@ -54,12 +54,13 @@ library
                   Hledger.Reports
                   Hledger.Utils
                   Hledger.Utils.UTF8IOCompat
-  Build-Depends:
+  build-depends:
                   base >= 4.3 && < 5
                  ,bytestring
                  ,cmdargs >= 0.10 && < 0.11
                  ,containers
                  ,csv
+                 ,data-pprint
                  ,directory
                  ,filepath
                  ,mtl
@@ -90,6 +91,7 @@ test-suite tests
                , cmdargs
                , containers
                , csv
+               , data-pprint
                , directory
                , filepath
                , HUnit

hledger/Hledger/Cli/Balance.hs

@@ -102,6 +102,8 @@ module Hledger.Cli.Balance (
 import Data.List
 import Data.Maybe
 import Test.HUnit
+import Text.Tabular
+import Text.Tabular.AsciiArt
 
 import Hledger
 import Prelude hiding (putStr)
@@ -116,12 +118,14 @@ balance CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
   let lines = case formatFromOpts ropts of
             Left err -> [err]
-            Right _ -> accountsReportAsText ropts $ accountsReport ropts (queryFromOpts d ropts) j
+            Right _ -> case intervalFromOpts ropts of
+                         NoInterval -> accountsReportAsText ropts $ accountsReport ropts (queryFromOpts d ropts) j
+                         _          -> flowReportAsText ropts     $ flowReport     ropts (queryFromOpts d ropts) j
   putStr $ unlines lines
 
--- | Render a balance report as plain text suitable for console output.
+-- | Render an old-style balance report (single-column balance/balance change report) as plain text.
 accountsReportAsText :: ReportOpts -> AccountsReport -> [String]
-accountsReportAsText opts (items, total) = concat lines ++ t
+accountsReportAsText opts ((items, total)) = concat lines ++ t
   where
       lines = case formatFromOpts opts of
                 Right f -> map (accountsReportItemAsText opts f) items
@@ -157,7 +161,7 @@ This implementation turned out to be a bit convoluted but implements the followi
               EUR -1
     b         USD -1  ; Account 'b' has two amounts. The account name is printed on the last line.
 -}
--- | Render one balance report line item as plain text.
+-- | Render one balance report line item as plain text suitable for console output.
 accountsReportItemAsText :: ReportOpts -> [FormatString] -> AccountsReportItem -> [String]
 accountsReportItemAsText opts format (_, accountName, depth, Mixed amounts) =
     -- 'amounts' could contain several quantities of the same commodity with different price.
@@ -192,5 +196,24 @@ formatField opts accountName depth total ljust min max field = case field of
         TotalField       -> formatValue ljust min max $ showAmountWithoutPrice total
         _                  -> ""
 
+-- | Render a flow report (multi-column balance change report) as plain text suitable for console output.
+flowReportAsText :: ReportOpts -> FlowReport -> [String]
+flowReportAsText opts (colspans, items, coltotals) =
+  trimborder $ lines $
+   render id ((" "++) . showDateSpan) showMixedAmountWithoutPrice $
+    Table
+      (Group NoLine $ map (Header . padright acctswidth) accts)
+      (Group NoLine $ map Header colspans)
+      (map snd items)
+    +----+
+    totalrow
+  where
+    trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
+    accts = map fst items
+    acctswidth = maximum $ map length $ accts
+    totalrow | no_total_ opts = row "" []
+             | otherwise      = row "" coltotals
+
+
 tests_Hledger_Cli_Balance = TestList
   tests_accountsReportAsText

hledger/Hledger/Cli/Main.hs

@@ -117,13 +117,15 @@ main = do
   when (debug_ opts) $ do
     putStrLn $ "processed opts:\n" ++ show opts
     putStrLn . show =<< pprint opts
-    d <- getCurrentDay
-    putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)
     putStrLn $ "command matched: " ++ show cmd
     putStrLn $ "isNullCommand: " ++ show isNullCommand
     putStrLn $ "isInternalCommand: " ++ show isInternalCommand
     putStrLn $ "isExternalCommand: " ++ show isExternalCommand
     putStrLn $ "isBadCommand: " ++ show isBadCommand
+    d <- getCurrentDay
+    putStrLn $ "date span from opts: " ++ (show $ dateSpanFromOpts d $ reportopts_ opts)
+    putStrLn $ "interval from opts: " ++ (show $ intervalFromOpts $ reportopts_ opts)
+    putStrLn $ "query from opts & args: " ++ (show $ queryFromOpts d $ reportopts_ opts)
   let
     dbg s = if debug_ opts then trace s else id
     runHledgerCommand

hledger/hledger.cabal

@@ -82,6 +82,7 @@ library
                  ,shakespeare-text == 1.0.*
                  ,split >= 0.1 && < 0.3
                  ,text == 0.11.*
+                 ,tabular >= 0.2 && < 0.3
                  ,time
                  ,utf8-string >= 0.3.5 && < 0.4
   default-language: Haskell2010
@@ -136,6 +137,7 @@ executable hledger
                  ,safe >= 0.2
                  ,shakespeare-text == 1.0.*
                  ,split >= 0.1 && < 0.3
+                 ,tabular >= 0.2 && < 0.3
                  ,text == 0.11.*
                  ,time
                  ,utf8-string >= 0.3.5 && < 0.4
@@ -167,6 +169,7 @@ test-suite tests
                , safe
                , shakespeare-text
                , split
+               ,tabular >= 0.2 && < 0.3
                , test-framework
                , test-framework-hunit
                , text