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

register: describe datespans briefly, like balance

Browse Source 
Eg instead of 2014/01/01 - 2014/01/31, show 2014/01, as in a multicolumn
balance report. The data model is not very elegant, but works for now.
This commit is contained in:
Simon Michael 2014-08-07 16:26:58 -07:00
parent e2d3ab0002
commit aa85e786b9
5 changed files with 85 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -112,6 +112,8 @@ showDateSpan ds@(DateSpan (Just from) (Just to)) =
-- YYYY/MM/DDwN ("week N, starting on YYYY/MM/DD") -- YYYY/MM/DDwN ("week N, starting on YYYY/MM/DD")
_ | let ((fy,fw,fd), (ty,tw,td)) = (toWeekDate from, toWeekDate to) in fy==ty && fw+1==tw && fd==1 && td==1 _ | let ((fy,fw,fd), (ty,tw,td)) = (toWeekDate from, toWeekDate to) in fy==ty && fw+1==tw && fd==1 && td==1
-> formatTime defaultTimeLocale "%0C%y/%m/%dw%V" from -> formatTime defaultTimeLocale "%0C%y/%m/%dw%V" from
-- a day, YYYY/MM/DDd (d suffix is to distinguish from a regular date in register)
((fy,fm,fd), (ty,tm,td)) | fy==ty && fm==tm && fd+1==td -> formatTime defaultTimeLocale "%0C%y/%m/%dd" from
-- otherwise, YYYY/MM/DD-YYYY/MM/DD -- otherwise, YYYY/MM/DD-YYYY/MM/DD
_ -> showDateSpan' ds _ -> showDateSpan' ds
showDateSpan ds = showDateSpan' ds showDateSpan ds = showDateSpan' ds

93
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, TupleSections #-}
{-| {-|
Postings report, used by the register command. Postings report, used by the register command.
@ -35,10 +35,17 @@ import Hledger.Reports.ReportOptions
type PostingsReport = (String -- label for the running balance column XXX remove type PostingsReport = (String -- label for the running balance column XXX remove
,[PostingsReportItem] -- line items, one per posting ,[PostingsReportItem] -- line items, one per posting
) )
type PostingsReportItem = (Maybe Day -- posting date, if this is the first posting in a transaction or if it's different from the previous posting's date type PostingsReportItem = (Maybe Day -- The posting date, if this is the first posting in a
,Maybe String -- transaction description, if this is the first posting in a transaction -- transaction or if it's different from the previous
,Posting -- the posting, possibly with account name depth-clipped -- posting's date. Or if this a summary posting, the
,MixedAmount -- the running total after this posting (or with --average, the running average) -- report interval's start date if this is the first
-- summary posting in the interval.
,Maybe Day -- If this is a summary posting, the report interval's
-- end date if this is the first summary posting in
-- the interval.
,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction.
,Posting -- The posting, possibly with the account name depth-clipped.
,MixedAmount -- The running total after this posting (or with --average, the running average).
) )
-- | Select postings from the journal and add running balance and other -- | Select postings from the journal and add running balance and other
@ -76,9 +83,9 @@ postingsReport opts q j = (totallabel, items)
interval = intervalFromOpts opts -- XXX interval = intervalFromOpts opts -- XXX
whichdate = whichDateFromOpts opts whichdate = whichDateFromOpts opts
itemps | interval == NoInterval = reportps itemps | interval == NoInterval = map (,Nothing) reportps
| otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps | otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps
items = postingsReportItems itemps nullposting whichdate depth startbal runningcalc 1 items = postingsReportItems itemps (nullposting,Nothing) whichdate depth startbal runningcalc 1
where where
startbal = if balancetype_ opts == HistoricalBalance then sumPostings precedingps else 0 startbal = if balancetype_ opts == HistoricalBalance then sumPostings precedingps else 0
runningcalc | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) -- running average runningcalc | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) -- running average
@ -89,14 +96,15 @@ postingsReport opts q j = (totallabel, items)
totallabel = "Total" totallabel = "Total"
-- | Generate postings report line items. -- | Generate postings report line items from a list of postings or (with
postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem] -- non-Nothing dates attached) summary postings.
postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
postingsReportItems [] _ _ _ _ _ _ = [] postingsReportItems [] _ _ _ _ _ _ = []
postingsReportItems (p:ps) pprev wd d b runningcalcfn itemnum = i:(postingsReportItems ps p wd d b' runningcalcfn (itemnum+1)) postingsReportItems ((p,menddate):ps) (pprev,menddateprev) wd d b runningcalcfn itemnum = i:(postingsReportItems ps (p,menddate) wd d b' runningcalcfn (itemnum+1))
where where
i = mkpostingsReportItem showdate showdesc wd p' b' i = mkpostingsReportItem showdate showdesc wd menddate p' b'
showdate = isfirstintxn || isdifferentdate (showdate, showdesc) | isJust menddate = (menddate /= menddateprev, False)
showdesc = isfirstintxn | otherwise = (isfirstintxn || isdifferentdate, isfirstintxn)
isfirstintxn = ptransaction p /= ptransaction pprev isfirstintxn = ptransaction p /= ptransaction pprev
isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate pprev
SecondaryDate -> postingDate2 p /= postingDate2 pprev SecondaryDate -> postingDate2 p /= postingDate2 pprev
@ -106,17 +114,22 @@ postingsReportItems (p:ps) pprev wd d b runningcalcfn itemnum = i:(postingsRepor
-- | Generate one postings report line item, containing the posting, -- | Generate one postings report line item, containing the posting,
-- the current running balance, and optionally the posting date and/or -- the current running balance, and optionally the posting date and/or
-- the transaction description. -- the transaction description.
mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Posting -> MixedAmount -> PostingsReportItem mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> MixedAmount -> PostingsReportItem
mkpostingsReportItem showdate showdesc wd p b = (if showdate then Just date else Nothing, if showdesc then Just desc else Nothing, p, b) mkpostingsReportItem showdate showdesc wd menddate p b =
where (if showdate then Just date else Nothing
date = case wd of PrimaryDate -> postingDate p ,menddate
SecondaryDate -> postingDate2 p ,if showdesc then Just desc else Nothing
desc = maybe "" tdescription $ ptransaction p ,p
,b
)
where
date = case wd of PrimaryDate -> postingDate p
SecondaryDate -> postingDate2 p
desc = maybe "" tdescription $ ptransaction p
-- | Convert a list of postings into summary postings. Summary postings -- | Convert a list of postings into summary postings, one per interval,
-- are one per account per interval and aggregated to the specified depth -- aggregated to the specified depth if any.
-- if any. summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]
summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
where where
summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s) summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s)
@ -127,33 +140,35 @@ tests_summarisePostingsByInterval = [
summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] ~?= [] summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] ~?= []
] ]
-- | A summary posting summarises the activity in one account within a report
-- interval. It is currently kludgily represented by a regular Posting with no
-- description, the interval's start date stored as the posting date, and the
-- interval's end date attached with a tuple.
type SummaryPosting = (Posting, Maybe Day)
-- | Given a date span (representing a reporting interval) and a list of -- | Given a date span (representing a reporting interval) and a list of
-- postings within it: aggregate the postings so there is only one per -- postings within it, aggregate the postings into one summary posting per
-- account, and adjust their date/description so that they will render -- account.
-- as a summary for this interval.
-- --
-- As usual with date spans the end date is exclusive, but for display -- When a depth argument is present, postings to accounts of greater depth are
-- purposes we show the previous day as end date, like ledger. -- also aggregated where possible.
--
-- When a depth argument is present, postings to accounts of greater
-- depth are aggregated where possible.
-- --
-- The showempty flag includes spans with no postings and also postings -- The showempty flag includes spans with no postings and also postings
-- with 0 amount. -- with 0 amount.
summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [Posting] --
summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [SummaryPosting]
summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps
| null ps && (isNothing b || isNothing e) = [] | null ps && (isNothing b || isNothing e) = []
| null ps && showempty = [summaryp] | null ps && showempty = [(summaryp, Just e')]
| otherwise = summaryps' | otherwise = summarypes
where where
summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e')) postingdate = if wd == PrimaryDate then postingDate else postingDate2
b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b
e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e
postingdate = if wd == PrimaryDate then postingDate else postingDate2 summaryp = nullposting{pdate=Just b'}
summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
clippedanames = nub $ map (clipAccountName depth) anames clippedanames = nub $ map (clipAccountName depth) anames
summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]
summarypes = map (, Just e') $ (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
anames = sort $ nub $ map paccount ps anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like ledgerFromJournal, then do depth-clipping -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
accts = accountsFromPostings ps accts = accountsFromPostings ps

20
hledger/Hledger/Cli/Register.hs
View File

@ -69,7 +69,7 @@ tests_postingsReportAsText = [
-- date and description are shown for the first posting of a transaction only. -- date and description are shown for the first posting of a transaction only.
-- @ -- @
postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String
postingsReportItemAsText opts (mdate, mdesc, p, b) = postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =
intercalate "\n" $ intercalate "\n" $
[printf ("%-"++datew++"s %-"++descw++"s %-"++acctw++"s %"++amtw++"s %"++balw++"s") [printf ("%-"++datew++"s %-"++descw++"s %-"++acctw++"s %"++amtw++"s %"++balw++"s")
date desc acct amtfirstline balfirstline] date desc acct amtfirstline balfirstline]
@ -82,17 +82,23 @@ postingsReportItemAsText opts (mdate, mdesc, p, b) =
Right (TotalWidth (Width w)) -> w Right (TotalWidth (Width w)) -> w
Right (TotalWidth Auto) -> defaultWidth -- XXX Right (TotalWidth Auto) -> defaultWidth -- XXX
Right (FieldWidths _) -> defaultWidth -- XXX Right (FieldWidths _) -> defaultWidth -- XXX
datewidth = 10
amtwidth = 12 amtwidth = 12
balwidth = 12 balwidth = 12
(datewidth, date) = case (mdate,menddate) of
(Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate))
(Nothing, Just _) -> (21, "")
(Just d, Nothing) -> (10, showDate d)
_ -> (10, "")
remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth) remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)
(descwidth, acctwidth) | even r = (r', r') (descwidth, acctwidth) | isJust menddate = (0, remaining-2)
| otherwise = (r', r'+1) | even remaining = (r2, r2)
where r = remaining - 2 | otherwise = (r2, r2+1)
r' = r `div` 2 where
r2 = (remaining-2) `div` 2
[datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth] [datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth]
date = maybe "" showDate mdate
desc = maybe "" (take descwidth . elideRight descwidth) mdesc desc = maybe "" (take descwidth . elideRight descwidth) mdesc
acct = parenthesise $ elideAccountName awidth $ paccount p acct = parenthesise $ elideAccountName awidth $ paccount p
where where

4
tests/register/depth.test
View File

@ -43,8 +43,8 @@ hledgerdev -f - register aa --depth 1 --daily
a:aa 1 a:aa 1
b:bb:bbb b:bb:bbb
>>> >>>
2010/01/01 - 2010/01/01 a 2 2 2010/01/01d a 2 2
2010/01/02 - 2010/01/02 a 1 3 2010/01/02d a 1 3
>>>=0 >>>=0
# 4. with --cleared # 4. with --cleared

28
tests/register/intervals.test
View File

@ -4,7 +4,7 @@ hledgerdev -f- register --period 'monthly'
2011/2/1 2011/2/1
(a) 1 (a) 1
>>> >>>
2011/02/01 - 2011/02/28 a 1 1 2011/02 a 1 1
>>>=0 >>>=0
# 2. or with a query pattern, just the intervals with matched data: # 2. or with a query pattern, just the intervals with matched data:
@ -16,7 +16,7 @@ hledgerdev -f- register --period 'monthly' b
2011/2/1 2011/2/1
(b) 1 (b) 1
>>> >>>
2011/02/01 - 2011/02/28 b 1 1 2011/02 b 1 1
>>>=0 >>>=0
# 3. with --empty, show all intervals spanned by the journal # 3. with --empty, show all intervals spanned by the journal
@ -32,9 +32,9 @@ hledgerdev -f- register --period 'monthly' b --empty
2011/3/1 2011/3/1
(c) 1 (c) 1
>>> >>>
2011/01/01 - 2011/01/31 0 0 2011/01 0 0
2011/02/01 - 2011/02/28 b 1 1 2011/02 b 1 1
2011/03/01 - 2011/03/31 0 1 2011/03 0 1
>>>=0 >>>=0
# 4. any specified begin/end dates limit the intervals reported # 4. any specified begin/end dates limit the intervals reported
@ -49,11 +49,11 @@ hledgerdev -f- register --period 'monthly to 2011/3/1' b --empty
2011/3/1 2011/3/1
(c) 1 (c) 1
>>> >>>
2011/01/01 - 2011/01/31 0 0 2011/01 0 0
2011/02/01 - 2011/02/28 b 1 1 2011/02 b 1 1
>>>=0 >>>=0
# 6. --date2 should work with intervals # 5. --date2 should work with intervals
hledgerdev -f- register --monthly --date2 hledgerdev -f- register --monthly --date2
<<< <<<
2014/1/1 2014/1/1
@ -62,11 +62,11 @@ hledgerdev -f- register --monthly --date2
2014/2/1=2014/1/31 2014/2/1=2014/1/31
(b) 1 (b) 1
>>> >>>
2014/01/01 - 2014/01/31 a 1 1 2014/01 a 1 1
b 1 2 b 1 2
>>>=0 >>>=0
# 7. All matched postings in the displayed intervals should be reported on. # 6. All matched postings in the displayed intervals should be reported on.
hledgerdev -f- register -p 'monthly 2014/1/10-2014/2/20' hledgerdev -f- register -p 'monthly 2014/1/10-2014/2/20'
<<< <<<
2014/1/5 2014/1/5
@ -79,7 +79,7 @@ hledgerdev -f- register -p 'monthly 2014/1/10-2014/2/20'
(after) 1 (after) 1
>>> >>>
2014/01/01 - 2014/01/31 before 1 1 2014/01 before 1 1
2014/02/01 - 2014/02/28 after 1 2 2014/02 after 1 2
within 1 3 within 1 3
>>>=0 >>>=0