register: support --date2 with a report interval (fixes #174)

This commit is contained in:
Simon Michael 2014-04-13 14:57:40 -07:00
parent 2af04ec2fc
commit 424db9a09e
2 changed files with 18 additions and 11 deletions

View File

@ -26,6 +26,7 @@ module Hledger.Data.Posting (
postingDate, postingDate,
postingDate2, postingDate2,
isPostingInDateSpan, isPostingInDateSpan,
isPostingInDateSpan',
postingsDateSpan, postingsDateSpan,
-- * account name operations -- * account name operations
accountNamesFromPostings, accountNamesFromPostings,
@ -160,6 +161,11 @@ relatedPostings _ = []
isPostingInDateSpan :: DateSpan -> Posting -> Bool isPostingInDateSpan :: DateSpan -> Posting -> Bool
isPostingInDateSpan s = spanContainsDate s . postingDate isPostingInDateSpan s = spanContainsDate s . postingDate
-- --date2-sensitive version, separate for now to avoid disturbing multiBalanceReport.
isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool
isPostingInDateSpan' PrimaryDate s = spanContainsDate s . postingDate
isPostingInDateSpan' SecondaryDate s = spanContainsDate s . postingDate2
isEmptyPosting :: Posting -> Bool isEmptyPosting :: Posting -> Bool
isEmptyPosting = isZeroMixedAmount . pamount isEmptyPosting = isZeroMixedAmount . pamount

View File

@ -51,7 +51,7 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
(totallabel, postingsReportItems ps nullposting wd depth startbal runningcalcfn 1) (totallabel, postingsReportItems ps nullposting wd depth startbal runningcalcfn 1)
where where
ps | interval == NoInterval = displayableps ps | interval == NoInterval = displayableps
| otherwise = summarisePostingsByInterval interval depth empty reportspan displayableps | otherwise = summarisePostingsByInterval interval wd depth empty reportspan displayableps
j' = journalSelectingAmountFromOpts opts j j' = journalSelectingAmountFromOpts opts j
wd = whichDateFromOpts opts wd = whichDateFromOpts opts
-- delay depth filtering until the end -- delay depth filtering until the end
@ -81,7 +81,7 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
-- The latter is not easily available, fake it for now. -- The latter is not easily available, fake it for now.
requestedspan = periodspan `spanIntersect` displayspan requestedspan = periodspan `spanIntersect` displayspan
periodspan = queryDateSpan secondarydate q periodspan = queryDateSpan secondarydate q
secondarydate = whichDateFromOpts opts == SecondaryDate secondarydate = wd == SecondaryDate
displayspan = postingsDateSpan ps displayspan = postingsDateSpan ps
where (_,ps,_) = postingsMatchingDisplayExpr displayexpr opts $ journalPostings j' where (_,ps,_) = postingsMatchingDisplayExpr displayexpr opts $ journalPostings j'
matchedspan = postingsDateSpan displayableps matchedspan = postingsDateSpan displayableps
@ -169,15 +169,15 @@ datedisplayexpr = do
-- | Convert a list of postings into summary postings. Summary postings -- | Convert a list of postings into summary postings. Summary postings
-- are one per account per interval and aggregated to the specified depth -- are one per account per interval and aggregated to the specified depth
-- if any. -- if any.
summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting] summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]
summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan summarisePostingsByInterval interval wd depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
where where
summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s) summarisespan s = summarisePostingsInDateSpan s wd depth empty (postingsinspan s)
postingsinspan s = filter (isPostingInDateSpan s) ps postingsinspan s = filter (isPostingInDateSpan' wd s) ps
tests_summarisePostingsByInterval = [ tests_summarisePostingsByInterval = [
"summarisePostingsByInterval" ~: do "summarisePostingsByInterval" ~: do
summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= [] summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] ~?= []
] ]
-- | Given a date span (representing a reporting interval) and a list of -- | Given a date span (representing a reporting interval) and a list of
@ -193,15 +193,16 @@ tests_summarisePostingsByInterval = [
-- --
-- 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 -> Int -> Bool -> [Posting] -> [Posting] summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [Posting]
summarisePostingsInDateSpan (DateSpan b e) 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]
| otherwise = summaryps' | otherwise = summaryps'
where where
summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e')) summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))
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
summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}} summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}
summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames] summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]