balance: basic multi-column balance (change) reports
This commit is contained in:
parent
d6c841d93b
commit
7e06a6a24c
@ -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
|
||||
|
||||
4
NEWS.md
4
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
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user