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.
This commit is contained in:
		
							parent
							
								
									e2d3ab0002
								
							
						
					
					
						commit
						aa85e786b9
					
				| @ -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 | ||||
|  | ||||
| @ -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) | ||||
| 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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
| 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 | ||||
| 2014/01                 before                                   1             1 | ||||
| 2014/02                 after                                    1             2 | ||||
|                         within                                   1             3 | ||||
| >>>=0 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user