From aa85e786b9b406e4dd0e8e7dcea4200f67964d36 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 7 Aug 2014 16:26:58 -0700 Subject: [PATCH] register: describe datespans briefly, like balance 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. --- hledger-lib/Hledger/Data/Dates.hs | 2 + hledger-lib/Hledger/Reports/PostingsReport.hs | 93 +++++++++++-------- hledger/Hledger/Cli/Register.hs | 20 ++-- tests/register/depth.test | 4 +- tests/register/intervals.test | 28 +++--- 5 files changed, 85 insertions(+), 62 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 486c12980..5d59f6847 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -112,6 +112,8 @@ showDateSpan ds@(DateSpan (Just from) (Just to)) = -- 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 -> 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 _ -> showDateSpan' ds showDateSpan ds = showDateSpan' ds diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 76fa42e69..d149859cf 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} +{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, TupleSections #-} {-| 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 ,[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 - ,Maybe String -- transaction description, if this is the first posting in a transaction - ,Posting -- the posting, possibly with account name depth-clipped - ,MixedAmount -- the running total after this posting (or with --average, the running average) +type PostingsReportItem = (Maybe Day -- The posting date, if this is the first posting in a + -- transaction or if it's different from the previous + -- posting's date. Or if this a summary posting, the + -- 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 @@ -76,9 +83,9 @@ postingsReport opts q j = (totallabel, items) interval = intervalFromOpts opts -- XXX whichdate = whichDateFromOpts opts - itemps | interval == NoInterval = reportps + itemps | interval == NoInterval = map (,Nothing) 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 startbal = if balancetype_ opts == HistoricalBalance then sumPostings precedingps else 0 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" --- | Generate postings report line items. -postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem] +-- | Generate postings report line items from a list of postings or (with +-- non-Nothing dates attached) summary postings. +postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem] 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 - i = mkpostingsReportItem showdate showdesc wd p' b' - showdate = isfirstintxn || isdifferentdate - showdesc = isfirstintxn + i = mkpostingsReportItem showdate showdesc wd menddate p' b' + (showdate, showdesc) | isJust menddate = (menddate /= menddateprev, False) + | otherwise = (isfirstintxn || isdifferentdate, isfirstintxn) isfirstintxn = ptransaction p /= ptransaction pprev isdifferentdate = case wd of PrimaryDate -> postingDate p /= postingDate 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, -- the current running balance, and optionally the posting date and/or -- the transaction description. -mkpostingsReportItem :: Bool -> Bool -> WhichDate -> 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) - where - date = case wd of PrimaryDate -> postingDate p - SecondaryDate -> postingDate2 p - desc = maybe "" tdescription $ ptransaction p +mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> MixedAmount -> PostingsReportItem +mkpostingsReportItem showdate showdesc wd menddate p b = + (if showdate then Just date else Nothing + ,menddate + ,if showdesc then Just desc else Nothing + ,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 --- are one per account per interval and aggregated to the specified depth --- if any. -summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [Posting] +-- | Convert a list of postings into summary postings, one per interval, +-- aggregated to the specified depth if any. +summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan where summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s) @@ -127,33 +140,35 @@ tests_summarisePostingsByInterval = [ 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 --- postings within it: aggregate the postings so there is only one per --- account, and adjust their date/description so that they will render --- as a summary for this interval. +-- postings within it, aggregate the postings into one summary posting per +-- account. -- --- As usual with date spans the end date is exclusive, but for display --- purposes we show the previous day as end date, like ledger. --- --- When a depth argument is present, postings to accounts of greater --- depth are aggregated where possible. +-- When a depth argument is present, postings to accounts of greater depth are +-- also aggregated where possible. -- -- The showempty flag includes spans with no postings and also postings -- 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 | null ps && (isNothing b || isNothing e) = [] - | null ps && showempty = [summaryp] - | otherwise = summaryps' + | null ps && showempty = [(summaryp, Just e')] + | otherwise = summarypes where - summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e')) + postingdate = if wd == PrimaryDate then postingDate else postingDate2 b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e - postingdate = if wd == PrimaryDate then postingDate else postingDate2 - 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] + summaryp = nullposting{pdate=Just b'} 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 -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping accts = accountsFromPostings ps diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index d4b4eca1f..471ae1986 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -69,7 +69,7 @@ tests_postingsReportAsText = [ -- date and description are shown for the first posting of a transaction only. -- @ postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String -postingsReportItemAsText opts (mdate, mdesc, p, b) = +postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) = intercalate "\n" $ [printf ("%-"++datew++"s %-"++descw++"s %-"++acctw++"s %"++amtw++"s %"++balw++"s") date desc acct amtfirstline balfirstline] @@ -82,17 +82,23 @@ postingsReportItemAsText opts (mdate, mdesc, p, b) = Right (TotalWidth (Width w)) -> w Right (TotalWidth Auto) -> defaultWidth -- XXX Right (FieldWidths _) -> defaultWidth -- XXX - datewidth = 10 amtwidth = 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) - (descwidth, acctwidth) | even r = (r', r') - | otherwise = (r', r'+1) - where r = remaining - 2 - r' = r `div` 2 + (descwidth, acctwidth) | isJust menddate = (0, remaining-2) + | even remaining = (r2, r2) + | otherwise = (r2, r2+1) + where + r2 = (remaining-2) `div` 2 [datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth] - date = maybe "" showDate mdate + + desc = maybe "" (take descwidth . elideRight descwidth) mdesc acct = parenthesise $ elideAccountName awidth $ paccount p where diff --git a/tests/register/depth.test b/tests/register/depth.test index 630385082..19ea80c51 100644 --- a/tests/register/depth.test +++ b/tests/register/depth.test @@ -43,8 +43,8 @@ hledgerdev -f - register aa --depth 1 --daily a:aa 1 b:bb:bbb >>> -2010/01/01 - 2010/01/01 a 2 2 -2010/01/02 - 2010/01/02 a 1 3 +2010/01/01d a 2 2 +2010/01/02d a 1 3 >>>=0 # 4. with --cleared diff --git a/tests/register/intervals.test b/tests/register/intervals.test index 65429355f..7fb8e9c32 100644 --- a/tests/register/intervals.test +++ b/tests/register/intervals.test @@ -4,7 +4,7 @@ hledgerdev -f- register --period 'monthly' 2011/2/1 (a) 1 >>> -2011/02/01 - 2011/02/28 a 1 1 +2011/02 a 1 1 >>>=0 # 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 (b) 1 >>> -2011/02/01 - 2011/02/28 b 1 1 +2011/02 b 1 1 >>>=0 # 3. with --empty, show all intervals spanned by the journal @@ -32,9 +32,9 @@ hledgerdev -f- register --period 'monthly' b --empty 2011/3/1 (c) 1 >>> -2011/01/01 - 2011/01/31 0 0 -2011/02/01 - 2011/02/28 b 1 1 -2011/03/01 - 2011/03/31 0 1 +2011/01 0 0 +2011/02 b 1 1 +2011/03 0 1 >>>=0 # 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 (c) 1 >>> -2011/01/01 - 2011/01/31 0 0 -2011/02/01 - 2011/02/28 b 1 1 +2011/01 0 0 +2011/02 b 1 1 >>>=0 -# 6. --date2 should work with intervals +# 5. --date2 should work with intervals hledgerdev -f- register --monthly --date2 <<< 2014/1/1 @@ -62,11 +62,11 @@ hledgerdev -f- register --monthly --date2 2014/2/1=2014/1/31 (b) 1 >>> -2014/01/01 - 2014/01/31 a 1 1 - b 1 2 +2014/01 a 1 1 + b 1 2 >>>=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' <<< 2014/1/5 @@ -79,7 +79,7 @@ hledgerdev -f- register -p 'monthly 2014/1/10-2014/2/20' (after) 1 >>> -2014/01/01 - 2014/01/31 before 1 1 -2014/02/01 - 2014/02/28 after 1 2 - within 1 3 +2014/01 before 1 1 +2014/02 after 1 2 + within 1 3 >>>=0