slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

balance: basic multi-column balance (change) reports

Browse Source
This commit is contained in:
Simon Michael 2013-09-26 15:06:48 -07:00
parent d6c841d93b
commit 7e06a6a24c
9 changed files with 188 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
MANUAL.md
View File

@ -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
View File

@ -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

10
hledger-lib/Hledger/Data/Account.hs
View File

@ -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}

24
hledger-lib/Hledger/Data/Dates.hs
View File

@ -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)

115
hledger-lib/Hledger/Reports.hs
View File

@ -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,

4
hledger-lib/hledger-lib.cabal
View File

@ -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

31
hledger/Hledger/Cli/Balance.hs
View File

@ -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

6
hledger/Hledger/Cli/Main.hs
View File

@ -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

3
hledger/hledger.cabal
View File

@ -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