orDatesFrom -> spanDefaultsFrom

This commit is contained in:
Simon Michael 2014-04-19 08:38:03 -07:00
parent 7db02df56c
commit 1fca3e7472
4 changed files with 10 additions and 12 deletions

View File

@ -45,9 +45,9 @@ module Hledger.Data.Dates (
spansSpan, spansSpan,
spanIntersect, spanIntersect,
spansIntersect, spansIntersect,
spanDefaultsFrom,
spanUnion, spanUnion,
spansUnion, spansUnion,
orDatesFrom,
smartdate, smartdate,
splitSpan, splitSpan,
fixSmartDate, fixSmartDate,
@ -169,14 +169,6 @@ spanContainsDate (DateSpan Nothing (Just e)) d = d < e
spanContainsDate (DateSpan (Just b) Nothing) d = d >= b spanContainsDate (DateSpan (Just b) Nothing) d = d >= b
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
-- | Combine two datespans, filling any unspecified dates in the first
-- with dates from the second. Not a clip operation, just uses the
-- second's start/end dates as defaults when the first does not
-- specify them.
orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
where a = if isJust a1 then a1 else a2
b = if isJust b1 then b1 else b2
-- | Calculate the intersection of a number of datespans. -- | Calculate the intersection of a number of datespans.
spansIntersect [] = nulldatespan spansIntersect [] = nulldatespan
spansIntersect [d] = d spansIntersect [d] = d
@ -188,6 +180,12 @@ spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
b = latest b1 b2 b = latest b1 b2
e = earliest e1 e2 e = earliest e1 e2
-- | Fill any unspecified dates in the first span with the dates from
-- the second one. Sort of a one-way spanIntersect.
spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b
where a = if isJust a1 then a1 else a2
b = if isJust b1 then b1 else b2
-- | Calculate the union of a number of datespans. -- | Calculate the union of a number of datespans.
spansUnion [] = nulldatespan spansUnion [] = nulldatespan
spansUnion [d] = d spansUnion [d] = d

View File

@ -85,7 +85,7 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $
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
reportspan | empty = requestedspan `orDatesFrom` journalspan reportspan | empty = requestedspan `spanDefaultsFrom` journalspan
| otherwise = requestedspan `spanIntersect` matchedspan | otherwise = requestedspan `spanIntersect` matchedspan
startbal = sumPostings precedingps startbal = sumPostings precedingps
runningcalcfn | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) runningcalcfn | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i)

View File

@ -45,7 +45,7 @@ showHistogram opts q j = concatMap (printDayWith countBar) spanps
i = intervalFromOpts opts i = intervalFromOpts opts
interval | i == NoInterval = Days 1 interval | i == NoInterval = Days 1
| otherwise = i | otherwise = i
span = queryDateSpan (date2_ opts) q `orDatesFrom` journalDateSpan j span = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan j
spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span
spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
-- same as Register -- same as Register

View File

@ -41,7 +41,7 @@ stats CliOpts{reportopts_=reportopts_} j = do
d <- getCurrentDay d <- getCurrentDay
let q = queryFromOpts d reportopts_ let q = queryFromOpts d reportopts_
l = ledgerFromJournal q j l = ledgerFromJournal q j
reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q) reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan
showstats = showLedgerStats l d showstats = showLedgerStats l d
s = intercalate "\n" $ map showstats intervalspans s = intercalate "\n" $ map showstats intervalspans