diff --git a/MANUAL.md b/MANUAL.md index c128a8881..1357b682b 100644 --- a/MANUAL.md +++ b/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 diff --git a/NEWS.md b/NEWS.md index ec54a3c57..b74218b77 100644 --- a/NEWS.md +++ b/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 diff --git a/hledger-lib/Hledger/Data/Account.hs b/hledger-lib/Hledger/Data/Account.hs index 8cb56ea87..f67372853 100644 --- a/hledger-lib/Hledger/Data/Account.hs +++ b/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. --- (*ledger's core feature.) The accounts are returned in a list, but +-- | 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 -- 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} diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 998ad1782..ab1cb74f7 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/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 - string "from" >> many spacenonewline - b <- smartdate + b <- choice [ + do + string "from" >> many spacenonewline + 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) diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index b56a8b6ea..e04edb398 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/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) @@ -83,7 +88,7 @@ data ReportOpts = ReportOpts { ,cost_ :: Bool ,depth_ :: Maybe Int ,display_ :: Maybe DisplayExp - ,date2_ :: Bool + ,date2_ :: Bool ,empty_ :: Bool ,no_elide_ :: Bool ,real_ :: Bool @@ -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, diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 5a1b198fa..5fa0263aa 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/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 diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index b1e699e60..7ef864921 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/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,13 +118,15 @@ 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 - where +accountsReportAsText opts ((items, total)) = concat lines ++ t + where lines = case formatFromOpts opts of Right f -> map (accountsReportItemAsText opts f) items Left err -> [[err]] @@ -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 diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index e934d1e0b..7bf95da22 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/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 diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 68f572218..d235ffaca 100644 --- a/hledger/hledger.cabal +++ b/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