imp: partial/inferred dates are flexible, full dates are not (#1982)

DateSpans are now now aware of exact/flexible dates.
This commit is contained in:
Simon Michael 2023-01-18 23:02:09 -10:00
parent 032ffd112b
commit fa70f160ae
25 changed files with 300 additions and 261 deletions

View File

@ -30,6 +30,8 @@ quarterly, etc.
module Hledger.Data.Dates ( module Hledger.Data.Dates (
-- * Misc date handling utilities -- * Misc date handling utilities
fromEFDay,
modifyEFDay,
getCurrentDay, getCurrentDay,
getCurrentMonth, getCurrentMonth,
getCurrentYear, getCurrentYear,
@ -38,7 +40,9 @@ module Hledger.Data.Dates (
periodContainsDate, periodContainsDate,
parsedateM, parsedateM,
showDate, showDate,
showEFDate,
showDateSpan, showDateSpan,
showDateSpanDebug,
showDateSpanMonthAbbrev, showDateSpanMonthAbbrev,
elapsedSeconds, elapsedSeconds,
prevday, prevday,
@ -118,11 +122,19 @@ instance Show DateSpan where
showDate :: Day -> Text showDate :: Day -> Text
showDate = T.pack . show showDate = T.pack . show
showEFDate :: EFDay -> Text
showEFDate = showDate . fromEFDay
-- | Render a datespan as a display string, abbreviating into a -- | Render a datespan as a display string, abbreviating into a
-- compact form if possible. -- compact form if possible.
-- Warning, hides whether dates are Exact or Flex.
showDateSpan :: DateSpan -> Text showDateSpan :: DateSpan -> Text
showDateSpan = showPeriod . dateSpanAsPeriod showDateSpan = showPeriod . dateSpanAsPeriod
-- | Show a DateSpan with its begin/end dates, exact or flex.
showDateSpanDebug :: DateSpan -> String
showDateSpanDebug (DateSpan b e)= "DateSpan (" <> show b <> ") (" <> show e <> ")"
-- | Like showDateSpan, but show month spans as just the abbreviated month name -- | Like showDateSpan, but show month spans as just the abbreviated month name
-- in the current locale. -- in the current locale.
showDateSpanMonthAbbrev :: DateSpan -> Text showDateSpanMonthAbbrev :: DateSpan -> Text
@ -144,28 +156,36 @@ elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
elapsedSeconds t1 = realToFrac . diffUTCTime t1 elapsedSeconds t1 = realToFrac . diffUTCTime t1
spanStart :: DateSpan -> Maybe Day spanStart :: DateSpan -> Maybe Day
spanStart (DateSpan d _) = d spanStart (DateSpan d _) = fromEFDay <$> d
spanEnd :: DateSpan -> Maybe Day spanEnd :: DateSpan -> Maybe Day
spanEnd (DateSpan _ d) = d spanEnd (DateSpan _ d) = fromEFDay <$> d
spanStartDate :: DateSpan -> Maybe EFDay
spanStartDate (DateSpan d _) = d
spanEndDate :: DateSpan -> Maybe EFDay
spanEndDate (DateSpan _ d) = d
spanStartYear :: DateSpan -> Maybe Year spanStartYear :: DateSpan -> Maybe Year
spanStartYear (DateSpan d _) = fmap (first3 . toGregorian) d spanStartYear (DateSpan d _) = fmap (first3 . toGregorian . fromEFDay) d
spanEndYear :: DateSpan -> Maybe Year spanEndYear :: DateSpan -> Maybe Year
spanEndYear (DateSpan d _) = fmap (first3 . toGregorian) d spanEndYear (DateSpan d _) = fmap (first3 . toGregorian. fromEFDay) d
-- | Get the 0-2 years mentioned explicitly in a DateSpan. -- | Get the 0-2 years mentioned explicitly in a DateSpan.
spanYears :: DateSpan -> [Year] spanYears :: DateSpan -> [Year]
spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian)) [ma,mb] spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian. fromEFDay)) [ma,mb]
-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra -- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra
-- | Get overall span enclosing multiple sequentially ordered spans. -- | Get overall span enclosing multiple sequentially ordered spans.
-- The start and end date will be exact or flexible depending on
-- the first span's start date and last span's end date.
spansSpan :: [DateSpan] -> DateSpan spansSpan :: [DateSpan] -> DateSpan
spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay spans) spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< lastMay spans)
-- | Split a DateSpan into consecutive spans of the specified Interval. -- | Split a DateSpan into consecutive exact spans of the specified Interval.
-- If the first argument is true and the interval is Weeks, Months, Quarters or Years, -- If the first argument is true and the interval is Weeks, Months, Quarters or Years,
-- the start date will be adjusted backward if needed to nearest natural interval boundary -- the start date will be adjusted backward if needed to nearest natural interval boundary
-- (a monday, first of month, first of quarter or first of year). -- (a monday, first of month, first of quarter or first of year).
@ -174,7 +194,7 @@ spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay sp
-- If the original span is empty, eg if the end date is <= the start date, no spans are returned. -- If the original span is empty, eg if the end date is <= the start date, no spans are returned.
-- --
-- ==== Examples: -- ==== Examples:
-- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ fromGregorian y1 m1 d1) (Just $ fromGregorian y2 m2 d2) -- >>> let t i y1 m1 d1 y2 m2 d2 = splitSpan True i $ DateSpan (Just $ Flex $ fromGregorian y1 m1 d1) (Just $ Flex $ fromGregorian y2 m2 d2)
-- >>> t NoInterval 2008 01 01 2009 01 01 -- >>> t NoInterval 2008 01 01 2009 01 01
-- [DateSpan 2008] -- [DateSpan 2008]
-- >>> t (Quarters 1) 2008 01 01 2009 01 01 -- >>> t (Quarters 1) 2008 01 01 2009 01 01
@ -228,29 +248,29 @@ splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
-- The first representative of each weekday -- The first representative of each weekday
starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days starts = map (\d -> addDays (toInteger $ d - n) $ nthdayofweekcontaining n s) days
-- Split the given span using the provided helper functions: -- Split the given span into exact spans using the provided helper functions:
-- start is applied to the span's start date to get the first sub-span's start date -- the start function is applied to the span's start date to get the first sub-span's start date
-- addInterval is applied to an integer n (multiplying it by mult) and the span's start date to get the nth sub-span's start date -- the addInterval function is applied to an integer n (multiplying it by mult) and the span's start date to get the nth sub-span's start date
splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan] splitspan :: (Day -> Day) -> (Integer -> Day -> Day) -> Int -> DateSpan -> [DateSpan]
splitspan start addInterval mult ds = spansFromBoundaries e bdrys splitspan start addInterval mult ds = spansFromBoundaries e bdrys
where where
(s, e) = dateSpanSplitLimits start (addInterval $ toInteger mult) ds (s, e) = dateSpanSplitLimits start (addInterval (toInteger mult)) ds
bdrys = mapM (addInterval . toInteger) [0,mult..] $ start s bdrys = mapM (addInterval . toInteger) [0,mult..] $ start s
-- | Fill in missing endpoints for calculating 'splitSpan'. -- | Fill in missing start/end dates for calculating 'splitSpan'.
dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day) dateSpanSplitLimits :: (Day -> Day) -> (Day -> Day) -> DateSpan -> (Day, Day)
dateSpanSplitLimits start _ (DateSpan (Just s) (Just e)) = (start s, e) dateSpanSplitLimits start _ (DateSpan (Just s) (Just e)) = (start $ fromEFDay s, fromEFDay e)
dateSpanSplitLimits start next (DateSpan (Just s) Nothing) = (start s, next $ start s) dateSpanSplitLimits start next (DateSpan (Just s) Nothing) = (start $ fromEFDay s, next $ start $ fromEFDay s)
dateSpanSplitLimits start next (DateSpan Nothing (Just e)) = (start e, next $ start e) dateSpanSplitLimits start next (DateSpan Nothing (Just e)) = (start $ fromEFDay e, next $ start $ fromEFDay e)
dateSpanSplitLimits _ _ (DateSpan Nothing Nothing) = error "dateSpanSplitLimits: Should not be nulldatespan" -- PARTIAL: This case should have been handled in splitSpan dateSpanSplitLimits _ _ (DateSpan Nothing Nothing) = error "dateSpanSplitLimits: should not be nulldatespan" -- PARTIAL: This case should have been handled in splitSpan
-- | Construct a list of 'DateSpan's from a list of boundaries, which fit within a given range. -- | Construct a list of exact 'DateSpan's from a list of boundaries, which fit within a given range.
spansFromBoundaries :: Day -> [Day] -> [DateSpan] spansFromBoundaries :: Day -> [Day] -> [DateSpan]
spansFromBoundaries e bdrys = zipWith (DateSpan `on` Just) (takeWhile (< e) bdrys) $ drop 1 bdrys spansFromBoundaries e bdrys = zipWith (DateSpan `on` (Just . Exact)) (takeWhile (< e) bdrys) $ drop 1 bdrys
-- | Count the days in a DateSpan, or if it is open-ended return Nothing. -- | Count the days in a DateSpan, or if it is open-ended return Nothing.
daysInSpan :: DateSpan -> Maybe Integer daysInSpan :: DateSpan -> Maybe Integer
daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays d2 d1 daysInSpan (DateSpan (Just d1) (Just d2)) = Just $ diffDays (fromEFDay d2) (fromEFDay d1)
daysInSpan _ = Nothing daysInSpan _ = Nothing
-- | Is this an empty span, ie closed with the end date on or before the start date ? -- | Is this an empty span, ie closed with the end date on or before the start date ?
@ -261,9 +281,9 @@ isEmptySpan _ = False
-- | Does the span include the given date ? -- | Does the span include the given date ?
spanContainsDate :: DateSpan -> Day -> Bool spanContainsDate :: DateSpan -> Day -> Bool
spanContainsDate (DateSpan Nothing Nothing) _ = True spanContainsDate (DateSpan Nothing Nothing) _ = True
spanContainsDate (DateSpan Nothing (Just e)) d = d < e spanContainsDate (DateSpan Nothing (Just e)) d = d < fromEFDay e
spanContainsDate (DateSpan (Just b) Nothing) d = d >= b spanContainsDate (DateSpan (Just b) Nothing) d = d >= fromEFDay b
spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e spanContainsDate (DateSpan (Just b) (Just e)) d = d >= fromEFDay b && d < fromEFDay e
-- | Does the period include the given date ? -- | Does the period include the given date ?
-- (Here to avoid import cycle). -- (Here to avoid import cycle).
@ -294,7 +314,7 @@ spansIntersect (d:ds) = d `spanIntersect` (spansIntersect ds)
-- | Calculate the intersection of two datespans. -- | Calculate the intersection of two datespans.
-- --
-- For non-intersecting spans, gives an empty span beginning on the second's start date: -- For non-intersecting spans, gives an empty span beginning on the second's start date:
-- >>> DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ fromGregorian 2018 01 03) (Just $ fromGregorian 2018 01 05) -- >>> DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03) `spanIntersect` DateSpan (Just $ Flex $ fromGregorian 2018 01 03) (Just $ Flex $ fromGregorian 2018 01 05)
-- DateSpan 2018-01-03..2018-01-02 -- DateSpan 2018-01-03..2018-01-02
spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e
where where
@ -330,7 +350,7 @@ earliest (Just d1) (Just d2) = Just $ min d1 d2
-- usual exclusive-end-date sense: beginning on the earliest, and ending on -- usual exclusive-end-date sense: beginning on the earliest, and ending on
-- the day after the latest). -- the day after the latest).
daysSpan :: [Day] -> DateSpan daysSpan :: [Day] -> DateSpan
daysSpan ds = DateSpan (minimumMay ds) (addDays 1 <$> maximumMay ds) daysSpan ds = DateSpan (Exact <$> minimumMay ds) (Exact . addDays 1 <$> maximumMay ds)
-- | Select the DateSpan containing a given Day, if any, from a given list of -- | Select the DateSpan containing a given Day, if any, from a given list of
-- DateSpans. -- DateSpans.
@ -352,7 +372,7 @@ latestSpanContaining datespans = go
return spn return spn
where where
-- The smallest DateSpan larger than any DateSpan containing day. -- The smallest DateSpan larger than any DateSpan containing day.
supSpan = DateSpan (Just $ addDays 1 day) Nothing supSpan = DateSpan (Just $ Exact $ addDays 1 day) Nothing
spanSet = Set.fromList $ filter (not . isEmptySpan) datespans spanSet = Set.fromList $ filter (not . isEmptySpan) datespans
@ -388,17 +408,17 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
(ry,rm,_) = toGregorian refdate (ry,rm,_) = toGregorian refdate
(b,e) = span' sdate (b,e) = span' sdate
where where
span' :: SmartDate -> (Day,Day) span' :: SmartDate -> (EFDay, EFDay)
span' (SmartCompleteDate day) = (day, nextday day) span' (SmartCompleteDate day) = (Exact day, Exact $ nextday day)
span' (SmartAssumeStart y Nothing) = (startofyear day, nextyear day) where day = fromGregorian y 1 1 span' (SmartAssumeStart y Nothing) = (Flex $ startofyear day, Flex $ nextyear day) where day = fromGregorian y 1 1
span' (SmartAssumeStart y (Just m)) = (startofmonth day, nextmonth day) where day = fromGregorian y m 1 span' (SmartAssumeStart y (Just m)) = (Flex $ startofmonth day, Flex $ nextmonth day) where day = fromGregorian y m 1
span' (SmartFromReference m d) = (day, nextday day) where day = fromGregorian ry (fromMaybe rm m) d span' (SmartFromReference m d) = (Exact day, Exact $ nextday day) where day = fromGregorian ry (fromMaybe rm m) d
span' (SmartMonth m) = (startofmonth day, nextmonth day) where day = fromGregorian ry m 1 span' (SmartMonth m) = (Flex $ startofmonth day, Flex $ nextmonth day) where day = fromGregorian ry m 1
span' (SmartRelative n Day) = (addDays n refdate, addDays (n+1) refdate) span' (SmartRelative n Day) = (Exact $ addDays n refdate, Exact $ addDays (n+1) refdate)
span' (SmartRelative n Week) = (addDays (7*n) d, addDays (7*n+7) d) where d = thisweek refdate span' (SmartRelative n Week) = (Flex $ addDays (7*n) d, Flex $ addDays (7*n+7) d) where d = thisweek refdate
span' (SmartRelative n Month) = (addGregorianMonthsClip n d, addGregorianMonthsClip (n+1) d) where d = thismonth refdate span' (SmartRelative n Month) = (Flex $ addGregorianMonthsClip n d, Flex $ addGregorianMonthsClip (n+1) d) where d = thismonth refdate
span' (SmartRelative n Quarter) = (addGregorianMonthsClip (3*n) d, addGregorianMonthsClip (3*n+3) d) where d = thisquarter refdate span' (SmartRelative n Quarter) = (Flex $ addGregorianMonthsClip (3*n) d, Flex $ addGregorianMonthsClip (3*n+3) d) where d = thisquarter refdate
span' (SmartRelative n Year) = (addGregorianYearsClip n d, addGregorianYearsClip (n+1) d) where d = thisyear refdate span' (SmartRelative n Year) = (Flex $ addGregorianYearsClip n d, Flex $ addGregorianYearsClip (n+1) d) where d = thisyear refdate
-- showDay :: Day -> String -- showDay :: Day -> String
-- showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day -- showDay day = printf "%04d/%02d/%02d" y m d where (y,m,d) = toGregorian day
@ -412,15 +432,17 @@ fixSmartDateStr d s =
-- | A safe version of fixSmartDateStr. -- | A safe version of fixSmartDateStr.
fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text
fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d fixSmartDateStrEither d = fmap showEFDate . fixSmartDateStrEither' d
fixSmartDateStrEither' fixSmartDateStrEither'
:: Day -> Text -> Either HledgerParseErrors Day :: Day -> Text -> Either HledgerParseErrors EFDay
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
Right sd -> Right $ fixSmartDate d sd Right sd -> Right $ fixSmartDate d sd
Left e -> Left e Left e -> Left e
-- | Convert a SmartDate to an absolute date using the provided reference date. -- | Convert a SmartDate to a specific date using the provided reference date.
-- This date will be exact or flexible depending on whether the day was
-- specified exactly. (Missing least-significant parts produces a flex date.)
-- --
-- ==== Examples: -- ==== Examples:
-- >>> :set -XOverloadedStrings -- >>> :set -XOverloadedStrings
@ -503,19 +525,19 @@ fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
-- "2008-07-01" -- "2008-07-01"
-- >>> t "1 week ahead" -- >>> t "1 week ahead"
-- "2008-12-01" -- "2008-12-01"
fixSmartDate :: Day -> SmartDate -> Day fixSmartDate :: Day -> SmartDate -> EFDay
fixSmartDate refdate = fix fixSmartDate refdate = fix
where where
fix :: SmartDate -> Day fix :: SmartDate -> EFDay
fix (SmartCompleteDate d) = d fix (SmartCompleteDate d) = Exact d
fix (SmartAssumeStart y m) = fromGregorian y (fromMaybe 1 m) 1 fix (SmartAssumeStart y m) = Flex $ fromGregorian y (fromMaybe 1 m) 1
fix (SmartFromReference m d) = fromGregorian ry (fromMaybe rm m) d fix (SmartFromReference m d) = Exact $ fromGregorian ry (fromMaybe rm m) d
fix (SmartMonth m) = fromGregorian ry m 1 fix (SmartMonth m) = Flex $ fromGregorian ry m 1
fix (SmartRelative n Day) = addDays n refdate fix (SmartRelative n Day) = Exact $ addDays n refdate
fix (SmartRelative n Week) = addDays (7*n) $ thisweek refdate fix (SmartRelative n Week) = Flex $ addDays (7*n) $ thisweek refdate
fix (SmartRelative n Month) = addGregorianMonthsClip n $ thismonth refdate fix (SmartRelative n Month) = Flex $ addGregorianMonthsClip n $ thismonth refdate
fix (SmartRelative n Quarter) = addGregorianMonthsClip (3*n) $ thisquarter refdate fix (SmartRelative n Quarter) = Flex $ addGregorianMonthsClip (3*n) $ thisquarter refdate
fix (SmartRelative n Year) = addGregorianYearsClip n $ thisyear refdate fix (SmartRelative n Year) = Flex $ addGregorianYearsClip n $ thisyear refdate
(ry, rm, _) = toGregorian refdate (ry, rm, _) = toGregorian refdate
prevday :: Day -> Day prevday :: Day -> Day
@ -551,8 +573,8 @@ startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
-- when applicable. Works for Weeks, Months, Quarters, Years, eg. -- when applicable. Works for Weeks, Months, Quarters, Years, eg.
intervalBoundaryBefore :: Interval -> Day -> Day intervalBoundaryBefore :: Interval -> Day -> Day
intervalBoundaryBefore i d = intervalBoundaryBefore i d =
case splitSpan True i (DateSpan (Just d) (Just $ addDays 1 d)) of case splitSpan True i (DateSpan (Just $ Exact d) (Just $ Exact $ addDays 1 d)) of
(DateSpan (Just start) _:_) -> start (DateSpan (Just start) _:_) -> fromEFDay start
_ -> d _ -> d
-- | For given date d find year-long interval that starts on given -- | For given date d find year-long interval that starts on given
@ -1050,9 +1072,9 @@ justdatespanp rdate =
nulldatespan :: DateSpan nulldatespan :: DateSpan
nulldatespan = DateSpan Nothing Nothing nulldatespan = DateSpan Nothing Nothing
-- | A datespan of zero length, that matches no date. -- | An exact datespan of zero length, that matches no date.
emptydatespan :: DateSpan emptydatespan :: DateSpan
emptydatespan = DateSpan (Just $ addDays 1 nulldate) (Just nulldate) emptydatespan = DateSpan (Just $ Exact $ addDays 1 nulldate) (Just $ Exact nulldate)
nulldate :: Day nulldate :: Day
nulldate = fromGregorian 0 1 1 nulldate = fromGregorian 0 1 1
@ -1062,23 +1084,23 @@ nulldate = fromGregorian 0 1 1
tests_Dates = testGroup "Dates" tests_Dates = testGroup "Dates"
[ testCase "weekday" $ do [ testCase "weekday" $ do
splitSpan False (DaysOfWeek [1..5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08)) splitSpan False (DaysOfWeek [1..5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08))
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 06 29)) @?= [ (DateSpan (Just $ Exact $ fromGregorian 2021 06 28) (Just $ Exact $ fromGregorian 2021 06 29))
, (DateSpan (Just $ fromGregorian 2021 06 29) (Just $ fromGregorian 2021 06 30)) , (DateSpan (Just $ Exact $ fromGregorian 2021 06 29) (Just $ Exact $ fromGregorian 2021 06 30))
, (DateSpan (Just $ fromGregorian 2021 06 30) (Just $ fromGregorian 2021 07 01)) , (DateSpan (Just $ Exact $ fromGregorian 2021 06 30) (Just $ Exact $ fromGregorian 2021 07 01))
, (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 02)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 02))
, (DateSpan (Just $ fromGregorian 2021 07 02) (Just $ fromGregorian 2021 07 05)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 02) (Just $ Exact $ fromGregorian 2021 07 05))
-- next week -- next week
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 06)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 05) (Just $ Exact $ fromGregorian 2021 07 06))
, (DateSpan (Just $ fromGregorian 2021 07 06) (Just $ fromGregorian 2021 07 07)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 06) (Just $ Exact $ fromGregorian 2021 07 07))
, (DateSpan (Just $ fromGregorian 2021 07 07) (Just $ fromGregorian 2021 07 08)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 07) (Just $ Exact $ fromGregorian 2021 07 08))
] ]
splitSpan False (DaysOfWeek [1, 5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08)) splitSpan False (DaysOfWeek [1, 5]) (DateSpan (Just $ Exact $ fromGregorian 2021 07 01) (Just $ Exact $ fromGregorian 2021 07 08))
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 07 02)) @?= [ (DateSpan (Just $ Exact $ fromGregorian 2021 06 28) (Just $ Exact $ fromGregorian 2021 07 02))
, (DateSpan (Just $ fromGregorian 2021 07 02) (Just $ fromGregorian 2021 07 05)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 02) (Just $ Exact $ fromGregorian 2021 07 05))
-- next week -- next week
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 09)) , (DateSpan (Just $ Exact $ fromGregorian 2021 07 05) (Just $ Exact $ fromGregorian 2021 07 09))
] ]
, testCase "match dayOfWeek" $ do , testCase "match dayOfWeek" $ do
@ -1087,14 +1109,14 @@ tests_Dates = testGroup "Dates"
ys2021 = fromGregorian 2021 01 01 ys2021 = fromGregorian 2021 01 01
ye2021 = fromGregorian 2021 12 31 ye2021 = fromGregorian 2021 12 31
ys2022 = fromGregorian 2022 01 01 ys2022 = fromGregorian 2022 01 01
mapM_ (matchdow (DateSpan (Just ys2021) (Just ye2021))) [1..7] mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ye2021))) [1..7]
mapM_ (matchdow (DateSpan (Just ys2021) (Just ys2022))) [1..7] mapM_ (matchdow (DateSpan (Just $ Exact ys2021) (Just $ Exact ys2022))) [1..7]
mapM_ (matchdow (DateSpan (Just ye2021) (Just ys2022))) [1..7] mapM_ (matchdow (DateSpan (Just $ Exact ye2021) (Just $ Exact ys2022))) [1..7]
mapM_ (matchdow (DateSpan (Just ye2021) Nothing)) [1..7] mapM_ (matchdow (DateSpan (Just $ Exact ye2021) Nothing)) [1..7]
mapM_ (matchdow (DateSpan (Just ys2022) Nothing)) [1..7] mapM_ (matchdow (DateSpan (Just $ Exact ys2022) Nothing)) [1..7]
mapM_ (matchdow (DateSpan Nothing (Just ye2021))) [1..7] mapM_ (matchdow (DateSpan Nothing (Just $ Exact ye2021))) [1..7]
mapM_ (matchdow (DateSpan Nothing (Just ys2022))) [1..7] mapM_ (matchdow (DateSpan Nothing (Just $ Exact ys2022))) [1..7]
] ]

View File

@ -1002,7 +1002,7 @@ journalStyleInfluencingAmounts j =
-- pamt g p = (\amt -> p {pamount =amt}) <$> g (pamount p) -- pamt g p = (\amt -> p {pamount =amt}) <$> g (pamount p)
-- amts g (Mixed as) = Mixed <$> g as -- amts g (Mixed as) = Mixed <$> g as
-- | The fully specified date span enclosing the dates (primary or secondary) -- | The fully specified exact date span enclosing the dates (primary or secondary)
-- of all this journal's transactions and postings, or DateSpan Nothing Nothing -- of all this journal's transactions and postings, or DateSpan Nothing Nothing
-- if there are none. -- if there are none.
journalDateSpan :: Bool -> Journal -> DateSpan journalDateSpan :: Bool -> Journal -> DateSpan
@ -1019,7 +1019,7 @@ journalDateSpanBothDates = journalDateSpanHelper Nothing
-- uses both primary and secondary dates. -- uses both primary and secondary dates.
journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan journalDateSpanHelper :: Maybe WhichDate -> Journal -> DateSpan
journalDateSpanHelper whichdate j = journalDateSpanHelper whichdate j =
DateSpan (minimumMay dates) (addDays 1 <$> maximumMay dates) DateSpan (Exact <$> minimumMay dates) (Exact . addDays 1 <$> maximumMay dates)
where where
dates = pdates ++ tdates dates = pdates ++ tdates
tdates = concatMap gettdate ts tdates = concatMap gettdate ts
@ -1037,12 +1037,12 @@ journalDateSpanHelper whichdate j =
-- | The earliest of this journal's transaction and posting dates, or -- | The earliest of this journal's transaction and posting dates, or
-- Nothing if there are none. -- Nothing if there are none.
journalStartDate :: Bool -> Journal -> Maybe Day journalStartDate :: Bool -> Journal -> Maybe Day
journalStartDate secondary j = b where DateSpan b _ = journalDateSpan secondary j journalStartDate secondary j = fromEFDay <$> b where DateSpan b _ = journalDateSpan secondary j
-- | The "exclusive end date" of this journal: the day following its latest transaction -- | The "exclusive end date" of this journal: the day following its latest transaction
-- or posting date, or Nothing if there are none. -- or posting date, or Nothing if there are none.
journalEndDate :: Bool -> Journal -> Maybe Day journalEndDate :: Bool -> Journal -> Maybe Day
journalEndDate secondary j = e where DateSpan _ e = journalDateSpan secondary j journalEndDate secondary j = fromEFDay <$> e where DateSpan _ e = journalDateSpan secondary j
-- | The latest of this journal's transaction and posting dates, or -- | The latest of this journal's transaction and posting dates, or
-- Nothing if there are none. -- Nothing if there are none.
@ -1254,5 +1254,5 @@ tests_Journal = testGroup "Journal" [
} }
] ]
} }
@?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11)) @?= (DateSpan (Just $ Exact $ fromGregorian 2014 1 10) (Just $ Exact $ fromGregorian 2014 10 11))
] ]

View File

@ -125,6 +125,7 @@ instance ToJSON TransactionModifier
instance ToJSON TMPostingRule instance ToJSON TMPostingRule
instance ToJSON PeriodicTransaction instance ToJSON PeriodicTransaction
instance ToJSON PriceDirective instance ToJSON PriceDirective
instance ToJSON EFDay
instance ToJSON DateSpan instance ToJSON DateSpan
instance ToJSON Interval instance ToJSON Interval
instance ToJSON Period instance ToJSON Period

View File

@ -44,38 +44,38 @@ import Text.Printf
import Hledger.Data.Types import Hledger.Data.Types
-- | Convert Periods to DateSpans. -- | Convert Periods to exact DateSpans.
-- --
-- >>> periodAsDateSpan (MonthPeriod 2000 1) == DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1) -- >>> periodAsDateSpan (MonthPeriod 2000 1) == DateSpan (Just $ Flex $ fromGregorian 2000 1 1) (Just $ Flex $ fromGregorian 2000 2 1)
-- True -- True
periodAsDateSpan :: Period -> DateSpan periodAsDateSpan :: Period -> DateSpan
periodAsDateSpan (DayPeriod d) = DateSpan (Just d) (Just $ addDays 1 d) periodAsDateSpan (DayPeriod d) = DateSpan (Just $ Exact d) (Just $ Exact $ addDays 1 d)
periodAsDateSpan (WeekPeriod b) = DateSpan (Just b) (Just $ addDays 7 b) periodAsDateSpan (WeekPeriod b) = DateSpan (Just $ Flex b) (Just $ Flex $ addDays 7 b)
periodAsDateSpan (MonthPeriod y m) = DateSpan (Just $ fromGregorian y m 1) (Just $ fromGregorian y' m' 1) periodAsDateSpan (MonthPeriod y m) = DateSpan (Just $ Flex $ fromGregorian y m 1) (Just $ Flex $ fromGregorian y' m' 1)
where where
(y',m') | m==12 = (y+1,1) (y',m') | m==12 = (y+1,1)
| otherwise = (y,m+1) | otherwise = (y,m+1)
periodAsDateSpan (QuarterPeriod y q) = DateSpan (Just $ fromGregorian y m 1) (Just $ fromGregorian y' m' 1) periodAsDateSpan (QuarterPeriod y q) = DateSpan (Just $ Flex $ fromGregorian y m 1) (Just $ Flex $ fromGregorian y' m' 1)
where where
(y', q') | q==4 = (y+1,1) (y', q') | q==4 = (y+1,1)
| otherwise = (y,q+1) | otherwise = (y,q+1)
quarterAsMonth q2 = (q2-1) * 3 + 1 quarterAsMonth q2 = (q2-1) * 3 + 1
m = quarterAsMonth q m = quarterAsMonth q
m' = quarterAsMonth q' m' = quarterAsMonth q'
periodAsDateSpan (YearPeriod y) = DateSpan (Just $ fromGregorian y 1 1) (Just $ fromGregorian (y+1) 1 1) periodAsDateSpan (YearPeriod y) = DateSpan (Just $ Flex $ fromGregorian y 1 1) (Just $ Flex $ fromGregorian (y+1) 1 1)
periodAsDateSpan (PeriodBetween b e) = DateSpan (Just b) (Just e) periodAsDateSpan (PeriodBetween b e) = DateSpan (Just $ Exact b) (Just $ Exact e)
periodAsDateSpan (PeriodFrom b) = DateSpan (Just b) Nothing periodAsDateSpan (PeriodFrom b) = DateSpan (Just $ Exact b) Nothing
periodAsDateSpan (PeriodTo e) = DateSpan Nothing (Just e) periodAsDateSpan (PeriodTo e) = DateSpan Nothing (Just $ Exact e)
periodAsDateSpan (PeriodAll) = DateSpan Nothing Nothing periodAsDateSpan (PeriodAll) = DateSpan Nothing Nothing
-- | Convert DateSpans to Periods. -- | Convert DateSpans to Periods.
-- --
-- >>> dateSpanAsPeriod $ DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1) -- >>> dateSpanAsPeriod $ DateSpan (Just $ Exact $ fromGregorian 2000 1 1) (Just $ Exact $ fromGregorian 2000 2 1)
-- MonthPeriod 2000 1 -- MonthPeriod 2000 1
dateSpanAsPeriod :: DateSpan -> Period dateSpanAsPeriod :: DateSpan -> Period
dateSpanAsPeriod (DateSpan (Just b) (Just e)) = simplifyPeriod $ PeriodBetween b e dateSpanAsPeriod (DateSpan (Just b) (Just e)) = simplifyPeriod $ PeriodBetween (fromEFDay b) (fromEFDay e)
dateSpanAsPeriod (DateSpan (Just b) Nothing) = PeriodFrom b dateSpanAsPeriod (DateSpan (Just b) Nothing) = PeriodFrom (fromEFDay b)
dateSpanAsPeriod (DateSpan Nothing (Just e)) = PeriodTo e dateSpanAsPeriod (DateSpan Nothing (Just e)) = PeriodTo (fromEFDay e)
dateSpanAsPeriod (DateSpan Nothing Nothing) = PeriodAll dateSpanAsPeriod (DateSpan Nothing Nothing) = PeriodAll
-- | Convert PeriodBetweens to a more abstract period where possible. -- | Convert PeriodBetweens to a more abstract period where possible.
@ -195,12 +195,12 @@ showPeriodMonthAbbrev (MonthPeriod _ m) -- Jan
showPeriodMonthAbbrev p = showPeriod p showPeriodMonthAbbrev p = showPeriod p
periodStart :: Period -> Maybe Day periodStart :: Period -> Maybe Day
periodStart p = mb periodStart p = fromEFDay <$> mb
where where
DateSpan mb _ = periodAsDateSpan p DateSpan mb _ = periodAsDateSpan p
periodEnd :: Period -> Maybe Day periodEnd :: Period -> Maybe Day
periodEnd p = me periodEnd p = fromEFDay <$> me
where where
DateSpan _ me = periodAsDateSpan p DateSpan _ me = periodAsDateSpan p
@ -231,11 +231,12 @@ periodPrevious p = p
-- | Move a standard period to the following period of same duration, staying within enclosing dates. -- | Move a standard period to the following period of same duration, staying within enclosing dates.
-- Non-standard periods are unaffected. -- Non-standard periods are unaffected.
periodNextIn :: DateSpan -> Period -> Period periodNextIn :: DateSpan -> Period -> Period
periodNextIn (DateSpan _ (Just e)) p = periodNextIn (DateSpan _ (Just e0)) p =
case mb of case mb of
Just b -> if b < e then p' else p Just b -> if b < e then p' else p
_ -> p _ -> p
where where
e = fromEFDay e0
p' = periodNext p p' = periodNext p
mb = periodStart p' mb = periodStart p'
periodNextIn _ p = periodNext p periodNextIn _ p = periodNext p
@ -243,11 +244,12 @@ periodNextIn _ p = periodNext p
-- | Move a standard period to the preceding period of same duration, staying within enclosing dates. -- | Move a standard period to the preceding period of same duration, staying within enclosing dates.
-- Non-standard periods are unaffected. -- Non-standard periods are unaffected.
periodPreviousIn :: DateSpan -> Period -> Period periodPreviousIn :: DateSpan -> Period -> Period
periodPreviousIn (DateSpan (Just b) _) p = periodPreviousIn (DateSpan (Just b0) _) p =
case me of case me of
Just e -> if e > b then p' else p Just e -> if e > b then p' else p
_ -> p _ -> p
where where
b = fromEFDay b0
p' = periodPrevious p p' = periodPrevious p
me = periodEnd p' me = periodEnd p'
periodPreviousIn _ p = periodPrevious p periodPreviousIn _ p = periodPrevious p

View File

@ -186,17 +186,17 @@ instance Show PeriodicTransaction where
-- a $1.00 -- a $1.00
-- <BLANKLINE> -- <BLANKLINE>
-- --
-- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03)) -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03))
-- [] -- []
-- --
-- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 01 01) (Just $ fromGregorian 2020 02 01)) -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 01 01) (Just $ Flex $ fromGregorian 2020 02 01))
-- --
-- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ fromGregorian 2020 02 01) (Just $ fromGregorian 2020 03 01)) -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 02 01) (Just $ Flex $ fromGregorian 2020 03 01))
-- 2020-02-01 -- 2020-02-01
-- ; generated-transaction: ~ every 3 months from 2019-05 -- ; generated-transaction: ~ every 3 months from 2019-05
-- a $1.00 -- a $1.00
-- <BLANKLINE> -- <BLANKLINE>
-- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 05)) -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 05))
-- 2018-01-01 -- 2018-01-01
-- ; generated-transaction: ~ every 3 days from 2018 -- ; generated-transaction: ~ every 3 days from 2018
-- a $1.00 -- a $1.00
@ -205,7 +205,7 @@ instance Show PeriodicTransaction where
-- ; generated-transaction: ~ every 3 days from 2018 -- ; generated-transaction: ~ every 3 days from 2018
-- a $1.00 -- a $1.00
-- <BLANKLINE> -- <BLANKLINE>
-- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ fromGregorian 2018 01 02) (Just $ fromGregorian 2018 01 05)) -- >>> _ptgenspan "every 3 days from 2018" (DateSpan (Just $ Flex $ fromGregorian 2018 01 02) (Just $ Flex $ fromGregorian 2018 01 05))
-- 2018-01-04 -- 2018-01-04
-- ; generated-transaction: ~ every 3 days from 2018 -- ; generated-transaction: ~ every 3 days from 2018
-- a $1.00 -- a $1.00
@ -213,7 +213,7 @@ instance Show PeriodicTransaction where
runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction] runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction PeriodicTransaction{..} requestedspan = runPeriodicTransaction PeriodicTransaction{..} requestedspan =
[ t{tdate=d} | (DateSpan (Just d) _) <- alltxnspans, spanContainsDate requestedspan d ] [ t{tdate=d} | (DateSpan (Just efd) _) <- alltxnspans, let d = fromEFDay efd, spanContainsDate requestedspan d ]
where where
t = nulltransaction{ t = nulltransaction{
tsourcepos = ptsourcepos tsourcepos = ptsourcepos
@ -249,7 +249,7 @@ checkPeriodicTransactionStartDate i s periodexpr =
_ -> Nothing _ -> Nothing
where where
checkStart d x = checkStart d x =
let firstDate = fixSmartDate d $ SmartRelative 0 x let firstDate = fromEFDay $ fixSmartDate d $ SmartRelative 0 x
in in
if d == firstDate if d == firstDate
then Nothing then Nothing

View File

@ -1,4 +1,4 @@
{-| {-|
Most data types are defined here to avoid import cycles. Most data types are defined here to avoid import cycles.
Here is an overview of the hledger data model: Here is an overview of the hledger data model:
@ -82,8 +82,8 @@ type WeekDay = Int -- 1-7
-- containing the reference date. -- containing the reference date.
data SmartDate data SmartDate
= SmartCompleteDate Day = SmartCompleteDate Day
| SmartAssumeStart Year (Maybe Month) | SmartAssumeStart Year (Maybe Month) -- XXX improve these constructor names
| SmartFromReference (Maybe Month) MonthDay | SmartFromReference (Maybe Month) MonthDay --
| SmartMonth Month | SmartMonth Month
| SmartRelative Integer SmartInterval | SmartRelative Integer SmartInterval
deriving (Show) deriving (Show)
@ -92,7 +92,27 @@ data SmartInterval = Day | Week | Month | Quarter | Year deriving (Show)
data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show) data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show)
data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Ord,Generic) -- | A date which is either exact or flexible.
-- Flexible dates are allowed to be adjusted in certain situations.
data EFDay = Exact Day | Flex Day deriving (Eq,Generic,Show)
-- EFDay's Ord instance treats them like ordinary dates, ignoring exact/flexible.
instance Ord EFDay where compare d1 d2 = compare (fromEFDay d1) (fromEFDay d2)
-- instance Ord EFDay where compare = maCompare
fromEFDay :: EFDay -> Day
fromEFDay (Exact d) = d
fromEFDay (Flex d) = d
modifyEFDay :: (Day -> Day) -> EFDay -> EFDay
modifyEFDay f (Exact d) = Exact $ f d
modifyEFDay f (Flex d) = Flex $ f d
-- | A possibly open-ended span of time, from an optional inclusive start date
-- to an optional exclusive end date. Each date can be either exact or flexible.
-- An "exact date span" is a Datepan with exact start and end dates.
data DateSpan = DateSpan (Maybe EFDay) (Maybe EFDay) deriving (Eq,Ord,Generic)
instance Default DateSpan where def = DateSpan Nothing Nothing instance Default DateSpan where def = DateSpan Nothing Nothing

View File

@ -571,8 +571,8 @@ p ||| q = \v -> p v || q v
queryStartDate :: Bool -> Query -> Maybe Day queryStartDate :: Bool -> Query -> Maybe Day
queryStartDate secondary (Or ms) = earliestMaybeDate $ map (queryStartDate secondary) ms queryStartDate secondary (Or ms) = earliestMaybeDate $ map (queryStartDate secondary) ms
queryStartDate secondary (And ms) = latestMaybeDate $ map (queryStartDate secondary) ms queryStartDate secondary (And ms) = latestMaybeDate $ map (queryStartDate secondary) ms
queryStartDate False (Date (DateSpan (Just d) _)) = Just d queryStartDate False (Date (DateSpan (Just d) _)) = Just $ fromEFDay d
queryStartDate True (Date2 (DateSpan (Just d) _)) = Just d queryStartDate True (Date2 (DateSpan (Just d) _)) = Just $ fromEFDay d
queryStartDate _ _ = Nothing queryStartDate _ _ = Nothing
-- | What end date (or secondary date) does this query specify, if any ? -- | What end date (or secondary date) does this query specify, if any ?
@ -580,8 +580,8 @@ queryStartDate _ _ = Nothing
queryEndDate :: Bool -> Query -> Maybe Day queryEndDate :: Bool -> Query -> Maybe Day
queryEndDate secondary (Or ms) = latestMaybeDate' $ map (queryEndDate secondary) ms queryEndDate secondary (Or ms) = latestMaybeDate' $ map (queryEndDate secondary) ms
queryEndDate secondary (And ms) = earliestMaybeDate' $ map (queryEndDate secondary) ms queryEndDate secondary (And ms) = earliestMaybeDate' $ map (queryEndDate secondary) ms
queryEndDate False (Date (DateSpan _ (Just d))) = Just d queryEndDate False (Date (DateSpan _ (Just d))) = Just $ fromEFDay d
queryEndDate True (Date2 (DateSpan _ (Just d))) = Just d queryEndDate True (Date2 (DateSpan _ (Just d))) = Just $ fromEFDay d
queryEndDate _ _ = Nothing queryEndDate _ _ = Nothing
queryTermDateSpan (Date spn) = Just spn queryTermDateSpan (Date spn) = Just spn
@ -835,8 +835,8 @@ tests_Query = testGroup "Query" [
(simplifyQuery $ And [Any,Any]) @?= (Any) (simplifyQuery $ And [Any,Any]) @?= (Any)
(simplifyQuery $ And [Acct $ toRegex' "b",Any]) @?= (Acct $ toRegex' "b") (simplifyQuery $ And [Acct $ toRegex' "b",Any]) @?= (Acct $ toRegex' "b")
(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any) (simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any)
(simplifyQuery $ And [Date (DateSpan Nothing (Just $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ fromGregorian 2012 01 01) Nothing)]) (simplifyQuery $ And [Date (DateSpan Nothing (Just $ Exact $ fromGregorian 2013 01 01)), Date (DateSpan (Just $ Exact $ fromGregorian 2012 01 01) Nothing)])
@?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01))) @?= (Date (DateSpan (Just $ Exact $ fromGregorian 2012 01 01) (Just $ Exact $ fromGregorian 2013 01 01)))
(simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b") (simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b")
,testCase "parseQuery" $ do ,testCase "parseQuery" $ do
@ -875,9 +875,9 @@ tests_Query = testGroup "Query" [
parseQueryTerm nulldate "payee:x" @?= Left <$> payeeTag (Just "x") parseQueryTerm nulldate "payee:x" @?= Left <$> payeeTag (Just "x")
parseQueryTerm nulldate "note:x" @?= Left <$> noteTag (Just "x") parseQueryTerm nulldate "note:x" @?= Left <$> noteTag (Just "x")
parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True) parseQueryTerm nulldate "real:1" @?= Right (Left $ Real True)
parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2008 01 01) (Just $ fromGregorian 2009 01 01)) parseQueryTerm nulldate "date:2008" @?= Right (Left $ Date $ DateSpan (Just $ Flex $ fromGregorian 2008 01 01) (Just $ Flex $ fromGregorian 2009 01 01))
parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2012 05 17) Nothing) parseQueryTerm nulldate "date:from 2012/5/17" @?= Right (Left $ Date $ DateSpan (Just $ Exact $ fromGregorian 2012 05 17) Nothing)
parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 04 01)) parseQueryTerm nulldate "date:20180101-201804" @?= Right (Left $ Date $ DateSpan (Just $ Exact $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 04 01))
parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a") parseQueryTerm nulldate "inacct:a" @?= Right (Right $ QueryOptInAcct "a")
parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag (toRegexCI' "a") Nothing) parseQueryTerm nulldate "tag:a" @?= Right (Left $ Tag (toRegexCI' "a") Nothing)
parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag (toRegexCI' "a") (Just $ toRegexCI' "some value")) parseQueryTerm nulldate "tag:a=some value" @?= Right (Left $ Tag (toRegexCI' "a") (Just $ toRegexCI' "some value"))
@ -899,18 +899,18 @@ tests_Query = testGroup "Query" [
,testCase "queryStartDate" $ do ,testCase "queryStartDate" $ do
let small = Just $ fromGregorian 2000 01 01 let small = Just $ fromGregorian 2000 01 01
big = Just $ fromGregorian 2000 01 02 big = Just $ fromGregorian 2000 01 02
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= big queryStartDate False (And [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan (Exact <$> big) Nothing]) @?= big
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= small queryStartDate False (And [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan Nothing Nothing]) @?= small
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= small queryStartDate False (Or [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan (Exact <$> big) Nothing]) @?= small
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing queryStartDate False (Or [Date $ DateSpan (Exact <$> small) Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing
,testCase "queryEndDate" $ do ,testCase "queryEndDate" $ do
let small = Just $ fromGregorian 2000 01 01 let small = Just $ fromGregorian 2000 01 01
big = Just $ fromGregorian 2000 01 02 big = Just $ fromGregorian 2000 01 02
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= small queryEndDate False (And [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing (Exact <$> big)]) @?= small
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= small queryEndDate False (And [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing Nothing]) @?= small
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= big queryEndDate False (Or [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing (Exact <$> big)]) @?= big
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing queryEndDate False (Or [Date $ DateSpan Nothing (Exact <$> small), Date $ DateSpan Nothing Nothing]) @?= Nothing
,testCase "matchesAccount" $ do ,testCase "matchesAccount" $ do
assertBool "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d" assertBool "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d"

View File

@ -211,7 +211,7 @@ rawOptsToInputOpts day rawopts =
,new_save_ = True ,new_save_ = True
,pivot_ = stringopt "pivot" rawopts ,pivot_ = stringopt "pivot" rawopts
,forecast_ = forecastPeriodFromRawOpts day rawopts ,forecast_ = forecastPeriodFromRawOpts day rawopts
,reportspan_ = DateSpan (queryStartDate False datequery) (queryEndDate False datequery) ,reportspan_ = DateSpan (Exact <$> queryStartDate False datequery) (Exact <$> queryEndDate False datequery)
,auto_ = boolopt "auto" rawopts ,auto_ = boolopt "auto" rawopts
,infer_equity_ = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost ,infer_equity_ = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost
,infer_costs_ = boolopt "infer-costs" rawopts ,infer_costs_ = boolopt "infer-costs" rawopts

View File

@ -76,11 +76,11 @@ definputopts = InputOpts
forecastPeriod :: InputOpts -> Journal -> Maybe DateSpan forecastPeriod :: InputOpts -> Journal -> Maybe DateSpan
forecastPeriod iopts j = do forecastPeriod iopts j = do
DateSpan requestedStart requestedEnd <- forecast_ iopts DateSpan requestedStart requestedEnd <- forecast_ iopts
let forecastStart = requestedStart <|> max mjournalend reportStart <|> Just (_ioDay iopts) let forecastStart = fromEFDay <$> requestedStart <|> max mjournalend (fromEFDay <$> reportStart) <|> Just (_ioDay iopts)
forecastEnd = requestedEnd <|> reportEnd <|> Just (addDays 180 $ _ioDay iopts) forecastEnd = fromEFDay <$> requestedEnd <|> fromEFDay <$> reportEnd <|> (Just $ addDays 180 $ _ioDay iopts)
mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates
DateSpan reportStart reportEnd = reportspan_ iopts DateSpan reportStart reportEnd = reportspan_ iopts
return . dbg2 "forecastspan" $ DateSpan forecastStart forecastEnd return . dbg2 "forecastspan" $ DateSpan (Exact <$> forecastStart) (Exact <$> forecastEnd)
-- ** Lenses -- ** Lenses

View File

@ -898,7 +898,7 @@ tests_JournalReader = testGroup "JournalReader" [
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
,ptinterval = Months 1 ,ptinterval = Months 1
,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing ,ptspan = DateSpan (Just $ Flex $ fromGregorian 2018 6 1) Nothing
,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1)) ,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
,ptdescription = "" ,ptdescription = ""
,ptcomment = "In 2019 we will change this\n" ,ptcomment = "In 2019 we will change this\n"
@ -909,7 +909,7 @@ tests_JournalReader = testGroup "JournalReader" [
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
,ptinterval = Months 1 ,ptinterval = Months 1
,ptspan = DateSpan (Just $ fromGregorian 2018 6 1) Nothing ,ptspan = DateSpan (Just $ Flex $ fromGregorian 2018 6 1) Nothing
,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1)) ,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
,ptdescription = "In 2019 we will change this" ,ptdescription = "In 2019 we will change this"
,ptcomment = "" ,ptcomment = ""
@ -931,7 +931,7 @@ tests_JournalReader = testGroup "JournalReader" [
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "2019-01-04" ptperiodexpr = "2019-01-04"
,ptinterval = NoInterval ,ptinterval = NoInterval
,ptspan = DateSpan (Just $ fromGregorian 2019 1 4) (Just $ fromGregorian 2019 1 5) ,ptspan = DateSpan (Just $ Exact $ fromGregorian 2019 1 4) (Just $ Exact $ fromGregorian 2019 1 5)
,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1)) ,ptsourcepos = (SourcePos "" (mkPos 1) (mkPos 1), SourcePos "" (mkPos 2) (mkPos 1))
,ptdescription = "" ,ptdescription = ""
,ptcomment = "" ,ptcomment = ""

View File

@ -147,7 +147,7 @@ accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = it
priorq = dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq] priorq = dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq]
tostartdateq = tostartdateq =
case mstartdate of case mstartdate of
Just _ -> Date (DateSpan Nothing mstartdate) Just _ -> Date (DateSpan Nothing (Exact <$> mstartdate))
Nothing -> None -- no start date specified, there are no prior postings Nothing -> None -- no start date specified, there are no prior postings
mstartdate = queryStartDate (date2_ ropts) reportq mstartdate = queryStartDate (date2_ ropts) reportq
datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq

View File

@ -162,11 +162,11 @@ tests_BalanceReport = testGroup "BalanceReport" [
mixedAmount (usd 0)) mixedAmount (usd 0))
,testCase "with date:" $ ,testCase "with date:" $
(defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives` (defreportspec{_rsQuery=Date $ DateSpan (Just $ Exact $ fromGregorian 2009 01 01) (Just $ Exact $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
([], nullmixedamt) ([], nullmixedamt)
,testCase "with date2:" $ ,testCase "with date2:" $
(defreportspec{_rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives` (defreportspec{_rsQuery=Date2 $ DateSpan (Just $ Exact $ fromGregorian 2009 01 01) (Just $ Exact $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0,mixedAmount (usd 1)) ("assets:bank:checking","assets:bank:checking",0,mixedAmount (usd 1))
,("income:salary","income:salary",0,mixedAmount (usd (-1))) ,("income:salary","income:salary",0,mixedAmount (usd (-1)))

View File

@ -112,7 +112,7 @@ journalAddBudgetGoalTransactions bopts ropts reportspan j =
either error' id $ -- PARTIAL: either error' id $ -- PARTIAL:
(journalApplyCommodityStyles >=> journalBalanceTransactions bopts) j{ jtxns = budgetts } (journalApplyCommodityStyles >=> journalBalanceTransactions bopts) j{ jtxns = budgetts }
where where
budgetspan = dbg3 "budget span" $ DateSpan mbudgetgoalsstartdate (spanEnd reportspan) budgetspan = dbg3 "budget span" $ DateSpan (Exact <$> mbudgetgoalsstartdate) (Exact <$> spanEnd reportspan)
where where
mbudgetgoalsstartdate = mbudgetgoalsstartdate =
-- We want to also generate budget goal txns before the report start date, in case -H is used. -- We want to also generate budget goal txns before the report start date, in case -H is used.

View File

@ -42,7 +42,7 @@ entriesReport rspec@ReportSpec{_rsReportOpts=ropts} =
tests_EntriesReport = testGroup "EntriesReport" [ tests_EntriesReport = testGroup "EntriesReport" [
testGroup "entriesReport" [ testGroup "entriesReport" [
testCase "not acct" $ (length $ entriesReport defreportspec{_rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1 testCase "not acct" $ (length $ entriesReport defreportspec{_rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
,testCase "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3 ,testCase "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ Exact $ fromGregorian 2008 06 01) (Just $ Exact $ fromGregorian 2008 07 01)} samplejournal) @?= 3
] ]
] ]

View File

@ -222,7 +222,7 @@ startingPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceora
precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan . precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
periodAsDateSpan $ period_ ropts periodAsDateSpan $ period_ ropts
precedingspan = DateSpan Nothing $ spanStart reportspan precedingspan = DateSpan Nothing (Exact <$> spanStart reportspan)
precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of
DateSpan Nothing Nothing -> emptydatespan DateSpan Nothing Nothing -> emptydatespan
a -> a a -> a
@ -331,7 +331,7 @@ calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startb
-- since this is a cumulative sum of valued amounts, it should not be valued again -- since this is a cumulative sum of valued amounts, it should not be valued again
cumulative = cumulativeSum nullacct changes cumulative = cumulativeSum nullacct changes
startingBalance = HM.lookupDefault nullacct name startbals startingBalance = HM.lookupDefault nullacct name startbals
valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance valuedStart = avalue (DateSpan Nothing (Exact <$> historicalDate)) startingBalance
-- In each column, get each account's balance changes -- In each column, get each account's balance changes
colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)] colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)]

View File

@ -23,7 +23,7 @@ where
import Data.List (nub, sortOn) import Data.List (nub, sortOn)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Maybe (isJust, isNothing)
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Safe (headMay) import Safe (headMay)
@ -115,7 +115,7 @@ matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting
matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q} j reportspan = matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q} j reportspan =
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where where
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing (Exact <$> spanStart reportspan)
beforeandduringps = beforeandduringps =
sortOn (postingDateOrDate2 (whichDate ropts)) -- sort postings by date or date2 sortOn (postingDateOrDate2 (whichDate ropts)) -- sort postings by date or date2
. (if invert_ ropts then map negatePostingAmount else id) -- with --invert, invert amounts . (if invert_ ropts then map negatePostingAmount else id) -- with --invert, invert amounts
@ -132,7 +132,7 @@ matchedPostingsBeforeAndDuring rspec@ReportSpec{_rsReportOpts=ropts,_rsQuery=q}
where where
depthless = filterQuery (not . queryIsDepth) depthless = filterQuery (not . queryIsDepth)
dateless = filterQuery (not . queryIsDateOrDate2) dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan beforeendq = dateqtype $ DateSpan Nothing (Exact <$> spanEnd reportspan)
dateqtype = if queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) then Date2 else Date dateqtype = if queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) then Date2 else Date
where where
@ -195,7 +195,7 @@ summarisePostingsInDateSpan spn@(DateSpan b e) wd mdepth showempty ps
| otherwise = summarypes | otherwise = summarypes
where where
postingdate = if wd == PrimaryDate then postingDate else postingDate2 postingdate = if wd == PrimaryDate then postingDate else postingDate2
b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b b' = maybe (maybe nulldate postingdate $ headMay ps) fromEFDay b
summaryp = nullposting{pdate=Just b'} summaryp = nullposting{pdate=Just b'}
clippedanames = nub $ map (clipAccountName mdepth) anames clippedanames = nub $ map (clipAccountName mdepth) anames
summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}] summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}]

View File

@ -382,14 +382,14 @@ periodFromRawOpts d rawopts =
where where
mlastb = case beginDatesFromRawOpts d rawopts of mlastb = case beginDatesFromRawOpts d rawopts of
[] -> Nothing [] -> Nothing
bs -> Just $ last bs bs -> Just $ fromEFDay $ last bs
mlaste = case endDatesFromRawOpts d rawopts of mlaste = case endDatesFromRawOpts d rawopts of
[] -> Nothing [] -> Nothing
es -> Just $ last es es -> Just $ fromEFDay $ last es
-- Get all begin dates specified by -b/--begin or -p/--period options, in order, -- Get all begin dates specified by -b/--begin or -p/--period options, in order,
-- using the given date to interpret relative date expressions. -- using the given date to interpret relative date expressions.
beginDatesFromRawOpts :: Day -> RawOpts -> [Day] beginDatesFromRawOpts :: Day -> RawOpts -> [EFDay]
beginDatesFromRawOpts d = collectopts (begindatefromrawopt d) beginDatesFromRawOpts d = collectopts (begindatefromrawopt d)
where where
begindatefromrawopt d' (n,v) begindatefromrawopt d' (n,v)
@ -407,7 +407,7 @@ beginDatesFromRawOpts d = collectopts (begindatefromrawopt d)
-- Get all end dates specified by -e/--end or -p/--period options, in order, -- Get all end dates specified by -e/--end or -p/--period options, in order,
-- using the given date to interpret relative date expressions. -- using the given date to interpret relative date expressions.
endDatesFromRawOpts :: Day -> RawOpts -> [Day] endDatesFromRawOpts :: Day -> RawOpts -> [EFDay]
endDatesFromRawOpts d = collectopts (enddatefromrawopt d) endDatesFromRawOpts d = collectopts (enddatefromrawopt d)
where where
enddatefromrawopt d' (n,v) enddatefromrawopt d' (n,v)
@ -600,7 +600,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
mPeriodEnd = case interval_ ropts of mPeriodEnd = case interval_ ropts of
NoInterval -> const . spanEnd . fst $ reportSpan j rspec NoInterval -> const . spanEnd . fst $ reportSpan j rspec
_ -> spanEnd <=< latestSpanContaining (historical : spans) _ -> spanEnd <=< latestSpanContaining (historical : spans)
historical = DateSpan Nothing $ spanStart =<< headMay spans historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans
spans = snd $ reportSpanBothDates j rspec spans = snd $ reportSpanBothDates j rspec
styles = journalCommodityStyles j styles = journalCommodityStyles j
err = error "journalApplyValuationFromOpts: expected all spans to have an end date" err = error "journalApplyValuationFromOpts: expected all spans to have an end date"
@ -676,7 +676,7 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
-- include price directives after the last transaction -- include price directives after the last transaction
journalspan = dbg3 "journalspan" $ if bothdates then journalDateSpanBothDates j else journalDateSpan (date2_ ropts) j journalspan = dbg3 "journalspan" $ if bothdates then journalDateSpanBothDates j else journalDateSpan (date2_ ropts) j
pricespan = dbg3 "pricespan" . DateSpan Nothing $ case value_ ropts of pricespan = dbg3 "pricespan" . DateSpan Nothing $ case value_ ropts of
Just (AtEnd _) -> fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j Just (AtEnd _) -> fmap (Exact . addDays 1) . maximumMay . map pddate $ jpricedirectives j
_ -> Nothing _ -> Nothing
-- If the requested span is open-ended, close it using the journal's start and end dates. -- If the requested span is open-ended, close it using the journal's start and end dates.
-- This can still be the null (open) span if the journal is empty. -- This can still be the null (open) span if the journal is empty.
@ -692,8 +692,8 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
adjust = isNothing $ spanStart requestedspan adjust = isNothing $ spanStart requestedspan
-- The requested span enlarged to enclose a whole number of intervals. -- The requested span enlarged to enclose a whole number of intervals.
-- This can be the null span if there were no intervals. -- This can be the null span if there were no intervals.
reportspan = dbg3 "reportspan" $ DateSpan (spanStart =<< headMay intervalspans) reportspan = dbg3 "reportspan" $ DateSpan (fmap Exact . spanStart =<< headMay intervalspans)
(spanEnd =<< lastMay intervalspans) (fmap Exact . spanEnd =<< lastMay intervalspans)
reportStartDate :: Journal -> ReportSpec -> Maybe Day reportStartDate :: Journal -> ReportSpec -> Maybe Day
reportStartDate j = spanStart . fst . reportSpan j reportStartDate j = spanStart . fst . reportSpan j

View File

@ -120,7 +120,7 @@ zipWithPadded _ [] bs = bs
-- | Figure out the overall date span of a PeriodicReport -- | Figure out the overall date span of a PeriodicReport
periodicReportSpan :: PeriodicReport a b -> DateSpan periodicReportSpan :: PeriodicReport a b -> DateSpan
periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing
periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (fmap Exact . spanStart $ head colspans) (fmap Exact . spanEnd $ last colspans)
-- | Map a function over the row names. -- | Map a function over the row names.
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c

View File

@ -422,7 +422,7 @@ reportSpecSetFutureAndForecast fcast rspec =
excludeforecastq (Just _) = Any excludeforecastq (Just _) = Any
excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction
And [ And [
Not (Date $ DateSpan (Just $ addDays 1 $ _rsDay rspec) Nothing) Not (Date $ DateSpan (Just $ Exact $ addDays 1 $ _rsDay rspec) Nothing)
,Not generatedTransactionTag ,Not generatedTransactionTag
] ]

View File

@ -28,6 +28,7 @@ import Hledger
import Hledger.Web.Foundation (App, Handler, Widget) import Hledger.Web.Foundation (App, Handler, Widget)
import Hledger.Web.Settings (widgetFile) import Hledger.Web.Settings (widgetFile)
import Data.Function ((&)) import Data.Function ((&))
import Control.Arrow (right)
addModal :: Route App -> Journal -> Day -> Widget addModal :: Route App -> Journal -> Day -> Widget
addModal addR j today = do addModal addR j today = do
@ -61,7 +62,7 @@ addForm j today = identifyForm "add" $ \extra -> do
return (formRes, $(widgetFile "add-form")) return (formRes, $(widgetFile "add-form"))
where where
-- custom fields -- custom fields
dateField = textField & checkMMap (pure . validateDate) (T.pack . show) dateField = textField & checkMMap (pure . right fromEFDay . validateDate) (T.pack . show)
where where
validateDate s = validateDate s =
first (const ("Invalid date format" :: Text)) $ first (const ("Invalid date format" :: Text)) $

View File

@ -509,8 +509,8 @@ rawOptsToCliOpts rawopts = do
currentDay <- getCurrentDay currentDay <- getCurrentDay
let day = case maybestringopt "today" rawopts of let day = case maybestringopt "today" rawopts of
Nothing -> currentDay Nothing -> currentDay
Just d -> fromRight (error' $ "Unable to parse date \"" ++ d ++ "\"") -- PARTIAL: Just d -> fromRight (error' $ "Unable to parse date \"" ++ d ++ "\"") $ -- PARTIAL:
$ fixSmartDateStrEither' currentDay (T.pack d) fromEFDay <$> fixSmartDateStrEither' currentDay (T.pack d)
let iopts = rawOptsToInputOpts day rawopts let iopts = rawOptsToInputOpts day rawopts
rspec <- either error' pure $ rawOptsToReportSpec day rawopts -- PARTIAL: rspec <- either error' pure $ rawOptsToReportSpec day rawopts -- PARTIAL:
mcolumns <- readMay <$> getEnvSafe "COLUMNS" mcolumns <- readMay <$> getEnvSafe "COLUMNS"

View File

@ -160,14 +160,15 @@ confirmedTransactionWizard :: PrevInput -> EntryState -> [AddingStage] -> Wizard
confirmedTransactionWizard prevInput es [] = confirmedTransactionWizard prevInput es [EnterDateAndCode] confirmedTransactionWizard prevInput es [] = confirmedTransactionWizard prevInput es [EnterDateAndCode]
confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) = case currentStage of confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) = case currentStage of
EnterDateAndCode -> dateAndCodeWizard prevInput es >>= \case EnterDateAndCode -> dateAndCodeWizard prevInput es >>= \case
Just (date, code) -> do Just (efd, code) -> do
let es' = es let
{ esArgs = drop 1 esArgs date = fromEFDay efd
, esDefDate = date es' = es{ esArgs = drop 1 esArgs
} , esDefDate = date
dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date }
dateAndCodeString = formatTime defaultTimeLocale yyyymmddFormat date
++ T.unpack (if T.null code then "" else " (" <> code <> ")") ++ T.unpack (if T.null code then "" else " (" <> code <> ")")
yyyymmddFormat = "%Y-%m-%d" yyyymmddFormat = "%Y-%m-%d"
confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack) confirmedTransactionWizard prevInput{prevDateAndCode=Just dateAndCodeString} es' (EnterDescAndComment (date, code) : stack)
Nothing -> Nothing ->
confirmedTransactionWizard prevInput es stack confirmedTransactionWizard prevInput es stack

View File

@ -739,8 +739,8 @@ multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowto
cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts
allamts = as ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)] allamts = as ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)]
addDateColumns spn@(DateSpan s e) = (wbFromText (showDateSpan spn) :) addDateColumns spn@(DateSpan s e) = (wbFromText (showDateSpan spn) :)
. (wbFromText (maybe "" showDate s) :) . (wbFromText (maybe "" showEFDate s) :)
. (wbFromText (maybe "" (showDate . addDays (-1)) e) :) . (wbFromText (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
paddedTranspose :: a -> [[a]] -> [[a]] paddedTranspose :: a -> [[a]] -> [[a]]
paddedTranspose _ [] = [[]] paddedTranspose _ [] = [[]]

View File

@ -3,6 +3,7 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-| {-|
The @roi@ command prints internal rate of return and time-weighted rate of return for and investment. The @roi@ command prints internal rate of return and time-weighted rate of return for and investment.
@ -95,15 +96,17 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
tableBody <- forM spans $ \spn@(DateSpan (Just begin) (Just end)) -> do tableBody <- forM spans $ \spn@(DateSpan (Just begin) (Just end)) -> do
-- Spans are [begin,end), and end is 1 day after the actual end date we are interested in -- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
let let
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue end d amt)) b = fromEFDay begin
e = fromEFDay end
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue e d amt))
valueBefore = valueBefore =
mixedAmountValue end begin $ mixedAmountValue e b $
total trans (And [ investmentsQuery total trans (And [ investmentsQuery
, Date (DateSpan Nothing (Just begin))]) , Date (DateSpan Nothing (Just begin))])
valueAfter = valueAfter =
mixedAmountValue end end $ mixedAmountValue e e $
total trans (And [investmentsQuery total trans (And [investmentsQuery
, Date (DateSpan Nothing (Just end))]) , Date (DateSpan Nothing (Just end))])
@ -123,14 +126,14 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
, Date spn ] ) , Date spn ] )
thisSpan = dbg3 "processing span" $ thisSpan = dbg3 "processing span" $
OneSpan begin end valueBefore valueAfter cashFlow pnl OneSpan b e valueBefore valueAfter cashFlow pnl
irr <- internalRateOfReturn showCashFlow prettyTables thisSpan irr <- internalRateOfReturn showCashFlow prettyTables thisSpan
twr <- timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue thisSpan twr <- timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue thisSpan
let cashFlowAmt = maNegate . maSum $ map snd cashFlow let cashFlowAmt = maNegate . maSum $ map snd cashFlow
let smallIsZero x = if abs x < 0.01 then 0.0 else x let smallIsZero x = if abs x < 0.01 then 0.0 else x
return [ showDate begin return [ showDate b
, showDate (addDays (-1) end) , showDate (addDays (-1) e)
, T.pack $ showMixedAmount valueBefore , T.pack $ showMixedAmount valueBefore
, T.pack $ showMixedAmount cashFlowAmt , T.pack $ showMixedAmount cashFlowAmt
, T.pack $ showMixedAmount valueAfter , T.pack $ showMixedAmount valueAfter
@ -198,7 +201,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
tail $ tail $
scanl scanl
(\(_, _, unitPrice, unitBalance) (date, amt) -> (\(_, _, unitPrice, unitBalance) (date, amt) ->
let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just date))]) let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just $ Exact date))])
in in
case amt of case amt of
Right amt' -> Right amt' ->

View File

@ -834,16 +834,7 @@ P 2022-01-01 AAAA $1.40
expenses:tax:us:2021 $500 ; plus means added to this account (debit) expenses:tax:us:2021 $500 ; plus means added to this account (debit)
; revenue/expense categories are also "accounts" ; revenue/expense categories are also "accounts"
2022-01-01 Whole Foods | payee name and description can be separated by a pipe char ; tag1: Kv
; Transaction or posting comments can contain searchable tags,
; written NAME: or NAME:VALUE (value ends at comma or end of line).
; There's tag1 above with an empty value, and here's tag2:with a five word value
expenses:food $50
assets:checking $-50
; A few tags have special meaning.
; A "date" tag on a posting adjusts its date. (Doesn't affect the transaction date).
; date:2022-01-03, the checking posting cleared two days later.
2022-01-01 ; The description is optional. 2022-01-01 ; The description is optional.
; Any currency/commodity symbols are allowed, on either side. ; Any currency/commodity symbols are allowed, on either side.
assets:cash:wallet GBP -10 assets:cash:wallet GBP -10
@ -4360,7 +4351,7 @@ file.
## Report start & end date ## Report start & end date
By default, most hledger reports will show the full span of time represented by the journal data. By default, most hledger reports will show the full span of time represented by the journal.
The report start date will be the earliest transaction or posting date, The report start date will be the earliest transaction or posting date,
and the report end date will be the latest transaction, posting, or market price date. and the report end date will be the latest transaction, posting, or market price date.
@ -4401,11 +4392,12 @@ Examples:
## Smart dates ## Smart dates
hledger's user interfaces accept a flexible "smart date" syntax. hledger's user interfaces accept a "smart date" syntax for added convenience.
Smart dates allow some english words, can be relative to today's date, Smart dates optionally can
and can have less-significant date parts omitted (defaulting to 1). be relative to today's date,
be written with english words,
Examples: and have less-significant parts omitted (missing parts are inferred as 1).
Some examples:
| | | | | |
|----------------------------------------------|---------------------------------------------------------------------------------------| |----------------------------------------------|---------------------------------------------------------------------------------------|
@ -4423,7 +4415,7 @@ Examples:
| `20181201` | 8 digit YYYYMMDD with valid year month and day | | `20181201` | 8 digit YYYYMMDD with valid year month and day |
| `201812` | 6 digit YYYYMM with valid year and month | | `201812` | 6 digit YYYYMM with valid year and month |
Counterexamples - malformed digit sequences might give surprising results: Some counterexamples - malformed digit sequences might give surprising results:
| | | | | |
|-------------|-------------------------------------------------------------------| |-------------|-------------------------------------------------------------------|
@ -4432,16 +4424,17 @@ Counterexamples - malformed digit sequences might give surprising results:
| `20181232` | 8 digits with an invalid day gives an error | | `20181232` | 8 digits with an invalid day gives an error |
| `201801012` | 9+ digits beginning with a valid YYYYMMDD gives an error | | `201801012` | 9+ digits beginning with a valid YYYYMMDD gives an error |
Note "today's date" can be overridden with the `--today` option, in case it's "Today's date" can be overridden with the `--today` option, in case
needed for testing or for recreating old reports. (Except for periodic it's needed for testing or for recreating old reports. (Except for
transaction rules; those are not affected by `--today`.) periodic transaction rules, which are not affected by `--today`.)
## Report intervals ## Report intervals
A report interval can be specified so that commands like A report interval can be specified so that reports like
[register](#register), [balance](#balance) and [activity](#activity) [register](#register), [balance](#balance) or [activity](#activity)
become multi-period, showing each subperiod as a separate row or column. become multi-period, showing each subperiod as a separate row or column.
These "standard" report intervals can be enabled by using the corresponding flag:
The following standard intervals can be enabled with command-line flags:
- `-D/--daily` - `-D/--daily`
- `-W/--weekly` - `-W/--weekly`
@ -4449,42 +4442,49 @@ These "standard" report intervals can be enabled by using the corresponding flag
- `-Q/--quarterly` - `-Q/--quarterly`
- `-Y/--yearly` - `-Y/--yearly`
More complex intervals can be specified using `-p/--period` (see below). More complex intervals can be specified using `-p/--period`, described below.
Specifying a report interval other than daily can cause a report's ## Date adjustment
start date and end date to be adjusted in some cases:
- If the report start date is specified explicitly, periods will start exactly on that date. With a report interval (other than daily), report start / end dates which
Eg with `-M -b 2023/1/15', have not been specified explicitly and in full (eg not `-b 2023-01-01`,
periods will begin on the 15th day of each month, starting from 2023-01-15. but `-b 2023-01` or `-b 2023` or unspecified) are considered flexible:
(Since hledger 1.29).
- If the report start date is inferred, eg from the journal, - A flexible start date will be automatically adjusted earlier if needed to
it will be adjusted earlier if necessary to start on a natural interval boundary. fall on a natural interval boundary.
Eg with `-M` by itself, and if the journal's earliest transaction is on 2023-02-04, - Similarly, a flexible end date will be adjusted later if needed
periods will begin on the 1st of each month, starting from 2023-02-01. to make the last period a whole interval (the same length as the others).
- The report end date will be adjusted later if necessary This is convenient for producing clean periodic reports (this is traditional hledger behaviour).
so that the last period is a whole interval, the same length as the others. By contrast, fully-specified exact dates will not be adjusted (this is new in hledger 1.29).
Eg in the example above if the journal's latest transaction is on 2023-03-15,
the report end date will be adjusted to 2023-04-01. An example: with a journal whose first date is 2023-01-10 and last date is 2023-03-20:
- `hledger bal -M -b 2023/1/15 -e 2023/3/10`\
The report periods will begin on the 15th day of each month, starting from 2023-01-15,
and the last period's last day will be 2023-03-09.
(Exact start and end dates, neither is adjusted.)
- `hledger bal -M -b 2023-01 -e 2023-04` or `hledger bal -M`\
The report periods will begin on the 1st of each month, starting from 2023-01-01,
and the last period's last day will be 2023-03-31.
(Flexible start and end dates, both are adjusted.)
## Period expressions ## Period expressions
The `-p/--period` option accepts period expressions, a shorthand way The `-p/--period` option specifies a period expression, which is a compact way
of expressing a start date, end date, and/or report interval all at of expressing a start date, end date, and/or report interval.
once.
Here's a basic period expression specifying the first quarter of 2009. Note, Here's a period expression with a start and end date (specifying the first quarter of 2009):
hledger always treats start dates as inclusive and end dates as exclusive:
| | | |
|----------------------------------| |----------------------------------|
| `-p "from 2009/1/1 to 2009/4/1"` | | `-p "from 2009/1/1 to 2009/4/1"` |
Keywords like "from" and "to" are optional, and so are the spaces, as long Several keywords like "from" and "to" are supported for readability; these are optional.
as you don't run two dates together. "to" can also be written as ".." or "-". "to" can also be written as ".." or "-".
These are equivalent to the above: The spaces are also optional, as long as you don't run two dates together.
So the following are equivalent to the above:
| | | |
|---------------------------| |---------------------------|
@ -4492,17 +4492,17 @@ These are equivalent to the above:
| `-p2009/1/1to2009/4/1` | | `-p2009/1/1to2009/4/1` |
| `-p2009/1/1..2009/4/1` | | `-p2009/1/1..2009/4/1` |
Dates are [smart dates](#smart-dates), so if the current year is 2009, the Dates are [smart dates](#smart-dates), so if the current year is 2009,
above can also be written as: these are also equivalent to the above:
| | | |
|-------------------------| |-------------------------|
| `-p "1/1 4/1"` | | `-p "1/1 4/1"` |
| `-p "january-apr"` | | `-p "jan-apr"` |
| `-p "this year to 4/1"` | | `-p "this year to 4/1"` |
If you specify only one date, the missing start or end date will be the If you specify only one date, the missing start or end date will be the
earliest or latest transaction in your journal: earliest or latest transaction date in the journal:
| | | | | |
|----------------------|-----------------------------------| |----------------------|-----------------------------------|
@ -4511,16 +4511,15 @@ earliest or latest transaction in your journal:
| `-p "from 2009"` | the same | | `-p "from 2009"` | the same |
| `-p "to 2009"` | everything before january 1, 2009 | | `-p "to 2009"` | everything before january 1, 2009 |
A single date with no "from" or "to" defines both the start and end date You can also specify a period by writing a single partial or full date:
like so:
| | | | | |
|-----------------|-------------------------------------------------------------| |-----------------|-----------------------------------------------------------------|
| `-p "2009"` | the year 2009; equivalent to “2009/1/1 to 2010/1/1” | | `-p "2009"` | the year 2009; equivalent to “2009/1/1 to 2010/1/1” |
| `-p "2009/1"` | the month of jan; equivalent to “2009/1/1 to 2009/2/1” | | `-p "2009/1"` | the month of january 2009; equivalent to “2009/1/1 to 2009/2/1” |
| `-p "2009/1/1"` | just that day; equivalent to “2009/1/1 to 2009/1/2” | | `-p "2009/1/1"` | the first day of 2009; equivalent to “2009/1/1 to 2009/1/2” |
Or you can specify a single quarter like so: or by using the "Q" quarter-year syntax (case insensitive):
| | | | | |
|-----------------|-------------------------------------------------------------| |-----------------|-------------------------------------------------------------|
@ -4529,10 +4528,8 @@ Or you can specify a single quarter like so:
### Period expressions with a report interval ### Period expressions with a report interval
`-p/--period`'s argument can also begin with, or entirely consist of, A period expression can also begin with a [report interval](#report-intervals),
a [report interval](#report-intervals). separated from the start/end dates (if any) by a space or the word `in`:
This should be separated from the start/end dates (if any) by a space, or the word `in`.
Some examples:
| | | |
|-----------------------------------------| |-----------------------------------------|
@ -4540,38 +4537,27 @@ Some examples:
| `-p "monthly in 2008"` | | `-p "monthly in 2008"` |
| `-p "quarterly"` | | `-p "quarterly"` |
Note a report interval can cause the report start/end dates to be adjusted in some cases,
as described above in [Report intervals](#report-intervals).
### More complex report intervals ### More complex report intervals
Period expressions allow some more complex kinds of interval to be specified, including: Some more complex intervals can be specified within period expressions, such as:
- `biweekly` - `biweekly` (every two weeks)
- `fortnightly` - `fortnightly`
- `bimonthly` - `bimonthly` (every two months)
- `every day|week|month|quarter|year` - `every day|week|month|quarter|year`
- `every N days|weeks|months|quarters|years` - `every N days|weeks|months|quarters|years`
Examples: Weekly on a custom day:
| |
|------------------------------------|
| `-p "bimonthly from 2008"` |
| `-p "every 2 weeks"` |
| `-p "every 5 months from 2009/03"` |
Weekly on custom day:
- `every Nth day of week` (`th`, `nd`, `rd`, or `st` are all accepted after the number) - `every Nth day of week` (`th`, `nd`, `rd`, or `st` are all accepted after the number)
- `every WEEKDAYNAME` (full or three-letter english weekday name, case insensitive) - `every WEEKDAYNAME` (full or three-letter english weekday name, case insensitive)
Monthly on custom day: Monthly on a custom day:
- `every Nth day [of month]` - `every Nth day [of month]`
- `every Nth WEEKDAYNAME [of month]` - `every Nth WEEKDAYNAME [of month]`
Yearly on custom day: Yearly on a custom day:
- `every MM/DD [of year]` (month number and day of month number) - `every MM/DD [of year]` (month number and day of month number)
- `every MONTHNAME DDth [of year]` (full or three-letter english month name, case insensitive, and day of month number) - `every MONTHNAME DDth [of year]` (full or three-letter english month name, case insensitive, and day of month number)
@ -4579,15 +4565,18 @@ Yearly on custom day:
Examples: Examples:
| | | | | |
|------------------------------|----------------------------------------------------------| |------------------------------------|----------------------------------------------------------|
| `-p "every 2nd day of week"` | periods will go from Tue to Tue | | `-p "bimonthly from 2008"` | |
| `-p "every Tue"` | same | | `-p "every 2 weeks"` | |
| `-p "every 15th day"` | period boundaries will be on 15th of each month | | `-p "every 5 months from 2009/03"` | |
| `-p "every 2nd Monday"` | period boundaries will be on second Monday of each month | | `-p "every 2nd day of week"` | periods will go from Tue to Tue |
| `-p "every 11/05"` | yearly periods with boundaries on 5th of November | | `-p "every Tue"` | same |
| `-p "every 5th November"` | same | | `-p "every 15th day"` | period boundaries will be on 15th of each month |
| `-p "every Nov 5th"` | same | | `-p "every 2nd Monday"` | period boundaries will be on second Monday of each month |
| `-p "every 11/05"` | yearly periods with boundaries on 5th of November |
| `-p "every 5th November"` | same |
| `-p "every Nov 5th"` | same |
Show historical balances at end of the 15th day of each month (N is an end date, exclusive as always): Show historical balances at end of the 15th day of each month (N is an end date, exclusive as always):