dev: rename some Intervals for clarity [#2218]

This commit is contained in:
Simon Michael 2024-09-04 15:28:27 +01:00
parent 038ebd8c7a
commit 3fbad1892d
2 changed files with 47 additions and 56 deletions

View File

@ -221,33 +221,35 @@ spansSpan spans = DateSpan (spanStartDate =<< headMay spans) (spanEndDate =<< la
-- [DateSpan 2007-W01,DateSpan 2008-W02,DateSpan 2008-W03] -- [DateSpan 2007-W01,DateSpan 2008-W02,DateSpan 2008-W03]
-- >>> t (Weeks 2) 2008 01 01 2008 01 15 -- >>> t (Weeks 2) 2008 01 01 2008 01 15
-- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27] -- [DateSpan 2007-12-31..2008-01-13,DateSpan 2008-01-14..2008-01-27]
-- >>> t (DayOfMonth 2) 2008 01 01 2008 04 01 -- >>> t (MonthDay 2) 2008 01 01 2008 04 01
-- [DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01] -- [DateSpan 2008-01-02..2008-02-01,DateSpan 2008-02-02..2008-03-01,DateSpan 2008-03-02..2008-04-01]
-- >>> t (WeekdayOfMonth 2 4) 2011 01 01 2011 02 15 -- >>> t (NthWeekdayOfMonth 2 4) 2011 01 01 2011 02 15
-- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09] -- [DateSpan 2010-12-09..2011-01-12,DateSpan 2011-01-13..2011-02-09,DateSpan 2011-02-10..2011-03-09]
-- >>> t (DaysOfWeek [2]) 2011 01 01 2011 01 15 -- >>> t (DaysOfWeek [2]) 2011 01 01 2011 01 15
-- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17] -- [DateSpan 2010-12-28..2011-01-03,DateSpan 2011-01-04..2011-01-10,DateSpan 2011-01-11..2011-01-17]
-- >>> t (DayOfYear 11 29) 2012 10 01 2013 10 15 -- >>> t (MonthAndDay 11 29) 2012 10 01 2013 10 15
-- [DateSpan 2012-11-29..2013-11-28] -- [DateSpan 2012-11-29..2013-11-28]
-- --
splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan] splitSpan :: Bool -> Interval -> DateSpan -> [DateSpan]
splitSpan _ _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing] splitSpan _ _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
splitSpan _ _ ds | isEmptySpan ds = [] splitSpan _ _ ds | isEmptySpan ds = []
splitSpan _ _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds] splitSpan _ _ ds@(DateSpan (Just s) (Just e)) | s == e = [ds]
splitSpan _ NoInterval ds = [ds] splitSpan _ NoInterval ds = [ds]
splitSpan _ (Days n) ds = splitspan id addDays n ds splitSpan _ (Days n) ds = splitspan id addDays n ds
splitSpan adjust (Weeks n) ds = splitspan (if adjust then startofweek else id) addDays (7*n) ds splitSpan adjust (Weeks n) ds = splitspan (if adjust then startofweek else id) addDays (7*n) ds
splitSpan adjust (Months n) ds = splitspan (if adjust then startofmonth else id) addGregorianMonthsClip n ds splitSpan adjust (Months n) ds = splitspan (if adjust then startofmonth else id) addGregorianMonthsClip n ds
splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds splitSpan adjust (Quarters n) ds = splitspan (if adjust then startofquarter else id) addGregorianMonthsClip (3*n) ds
splitSpan adjust (Years n) ds = splitspan (if adjust then startofyear else id) addGregorianYearsClip n ds splitSpan adjust (Years n) ds = splitspan (if adjust then startofyear else id) addGregorianYearsClip n ds
splitSpan _ (DayOfMonth dom) ds = splitspan (nextnthdayofmonth dom) (addGregorianMonthsToMonthday dom) 1 ds splitSpan adjust (NthWeekdayOfMonth n wd) ds = splitspan (if adjust then prevstart else nextstart) advancemonths 1 ds
splitSpan _ (DayOfYear m n) ds = splitspan (nextmonthandday m n) (addGregorianYearsClip) 1 ds
splitSpan adjust (WeekdayOfMonth n wd) ds = splitspan (if adjust then prevNthWeekdayOfMonth n wd else nextNthWeekdayOfMonth n wd) advancemonths 1 ds
where where
prevstart = prevNthWeekdayOfMonth n wd
nextstart = nextNthWeekdayOfMonth n wd
advancemonths 0 = id advancemonths 0 = id
advancemonths m = advanceToNthWeekday n wd . startofmonth . addGregorianMonthsClip m advancemonths m = advanceToNthWeekday n wd . startofmonth . addGregorianMonthsClip m
splitSpan _ (DaysOfWeek []) ds = [ds] splitSpan _ (MonthDay dom) ds = splitspan (nextnthdayofmonth dom) (addGregorianMonthsToMonthday dom) 1 ds
splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys splitSpan _ (MonthAndDay m d) ds = splitspan (nextmonthandday m d) (addGregorianYearsClip) 1 ds
splitSpan _ (DaysOfWeek []) ds = [ds]
splitSpan _ (DaysOfWeek days@(n:_)) ds = spansFromBoundaries e bdrys
where where
(s, e) = dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds (s, e) = dateSpanSplitLimits (nthdayofweekcontaining n) nextday ds
bdrys = concatMap (flip map starts . addDays) [0,7..] bdrys = concatMap (flip map starts . addDays) [0,7..]
@ -985,41 +987,41 @@ weekdaysp = fmap headErr . group . sort <$> sepBy1 weekday (string' ",") -- PAR
-- >>> p "every week to 2009" -- >>> p "every week to 2009"
-- Right (Weeks 1,DateSpan ..2008-12-31) -- Right (Weeks 1,DateSpan ..2008-12-31)
-- >>> p "every 2nd day of month" -- >>> p "every 2nd day of month"
-- Right (DayOfMonth 2,DateSpan ..) -- Right (MonthDay 2,DateSpan ..)
-- >>> p "every 2nd day" -- >>> p "every 2nd day"
-- Right (DayOfMonth 2,DateSpan ..) -- Right (MonthDay 2,DateSpan ..)
-- >>> p "every 2nd day 2009.." -- >>> p "every 2nd day 2009.."
-- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- Right (MonthDay 2,DateSpan 2009-01-01..)
-- >>> p "every 2nd day 2009-" -- >>> p "every 2nd day 2009-"
-- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- Right (MonthDay 2,DateSpan 2009-01-01..)
-- >>> p "every 29th Nov" -- >>> p "every 29th Nov"
-- Right (DayOfYear 11 29,DateSpan ..) -- Right (MonthAndDay 11 29,DateSpan ..)
-- >>> p "every 29th nov ..2009" -- >>> p "every 29th nov ..2009"
-- Right (DayOfYear 11 29,DateSpan ..2008-12-31) -- Right (MonthAndDay 11 29,DateSpan ..2008-12-31)
-- >>> p "every nov 29th" -- >>> p "every nov 29th"
-- Right (DayOfYear 11 29,DateSpan ..) -- Right (MonthAndDay 11 29,DateSpan ..)
-- >>> p "every Nov 29th 2009.." -- >>> p "every Nov 29th 2009.."
-- Right (DayOfYear 11 29,DateSpan 2009-01-01..) -- Right (MonthAndDay 11 29,DateSpan 2009-01-01..)
-- >>> p "every 11/29 from 2009" -- >>> p "every 11/29 from 2009"
-- Right (DayOfYear 11 29,DateSpan 2009-01-01..) -- Right (MonthAndDay 11 29,DateSpan 2009-01-01..)
-- >>> p "every 11/29 since 2009" -- >>> p "every 11/29 since 2009"
-- Right (DayOfYear 11 29,DateSpan 2009-01-01..) -- Right (MonthAndDay 11 29,DateSpan 2009-01-01..)
-- >>> p "every 2nd Thursday of month to 2009" -- >>> p "every 2nd Thursday of month to 2009"
-- Right (WeekdayOfMonth 2 4,DateSpan ..2008-12-31) -- Right (NthWeekdayOfMonth 2 4,DateSpan ..2008-12-31)
-- >>> p "every 1st monday of month to 2009" -- >>> p "every 1st monday of month to 2009"
-- Right (WeekdayOfMonth 1 1,DateSpan ..2008-12-31) -- Right (NthWeekdayOfMonth 1 1,DateSpan ..2008-12-31)
-- >>> p "every tue" -- >>> p "every tue"
-- Right (DaysOfWeek [2],DateSpan ..) -- Right (DaysOfWeek [2],DateSpan ..)
-- >>> p "every 2nd day of week" -- >>> p "every 2nd day of week"
-- Right (DaysOfWeek [2],DateSpan ..) -- Right (DaysOfWeek [2],DateSpan ..)
-- >>> p "every 2nd day of month" -- >>> p "every 2nd day of month"
-- Right (DayOfMonth 2,DateSpan ..) -- Right (MonthDay 2,DateSpan ..)
-- >>> p "every 2nd day" -- >>> p "every 2nd day"
-- Right (DayOfMonth 2,DateSpan ..) -- Right (MonthDay 2,DateSpan ..)
-- >>> p "every 2nd day 2009.." -- >>> p "every 2nd day 2009.."
-- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- Right (MonthDay 2,DateSpan 2009-01-01..)
-- >>> p "every 2nd day of month 2009.." -- >>> p "every 2nd day of month 2009.."
-- Right (DayOfMonth 2,DateSpan 2009-01-01..) -- Right (MonthDay 2,DateSpan 2009-01-01..)
periodexprp :: Day -> TextParser m (Interval, DateSpan) periodexprp :: Day -> TextParser m (Interval, DateSpan)
periodexprp rdate = do periodexprp rdate = do
skipNonNewlineSpaces skipNonNewlineSpaces
@ -1048,9 +1050,9 @@ reportingintervalp = choice'
, Months 2 <$ string' "bimonthly" , Months 2 <$ string' "bimonthly"
, string' "every" *> skipNonNewlineSpaces *> choice' , string' "every" *> skipNonNewlineSpaces *> choice'
[ DaysOfWeek . pure <$> (nth <* skipNonNewlineSpaces <* string' "day" <* of_ "week") [ DaysOfWeek . pure <$> (nth <* skipNonNewlineSpaces <* string' "day" <* of_ "week")
, DayOfMonth <$> (nth <* skipNonNewlineSpaces <* string' "day" <* optOf_ "month") , MonthDay <$> (nth <* skipNonNewlineSpaces <* string' "day" <* optOf_ "month")
, liftA2 WeekdayOfMonth nth $ skipNonNewlineSpaces *> weekday <* optOf_ "month" , liftA2 NthWeekdayOfMonth nth $ skipNonNewlineSpaces *> weekday <* optOf_ "month"
, uncurry DayOfYear <$> (md <* optOf_ "year") , uncurry MonthAndDay <$> (md <* optOf_ "year")
, DaysOfWeek <$> weekdaysp , DaysOfWeek <$> weekdaysp
, DaysOfWeek [1..5] <$ string' "weekday" , DaysOfWeek [1..5] <$ string' "weekday"
, DaysOfWeek [6..7] <$ string' "weekendday" , DaysOfWeek [6..7] <$ string' "weekendday"
@ -1069,8 +1071,8 @@ reportingintervalp = choice'
optOf_ period = optional . try $ of_ period optOf_ period = optional . try $ of_ period
nth = decimal <* choice (map string' ["st","nd","rd","th"]) nth = decimal <* choice (map string' ["st","nd","rd","th"])
d_o_y = runPermutation $ liftA2 DayOfYear (toPermutation $ (month <|> mon) <* skipNonNewlineSpaces) d_o_y = runPermutation $ liftA2 MonthAndDay (toPermutation $ (month <|> mon) <* skipNonNewlineSpaces)
(toPermutation $ nth <* skipNonNewlineSpaces) (toPermutation $ nth <* skipNonNewlineSpaces)
-- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days". -- Parse any of several variants of a basic interval, eg "daily", "every day", "every N days".
tryinterval :: Text -> Text -> (Int -> Interval) -> TextParser m Interval tryinterval :: Text -> Text -> (Int -> Interval) -> TextParser m Interval

View File

@ -116,7 +116,7 @@ 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
-- Typical report periods (spans of time), both finite and open-ended. -- Some common report subperiods, both finite and open-ended.
-- A higher-level abstraction than DateSpan. -- A higher-level abstraction than DateSpan.
data Period = data Period =
DayPeriod Day DayPeriod Day
@ -132,16 +132,8 @@ data Period =
instance Default Period where def = PeriodAll instance Default Period where def = PeriodAll
---- Typical report period/subperiod durations, from a day to a year. -- All the kinds of report interval allowed in a period expression
--data Duration = -- (to generate periodic reports or periodic transactions).
-- DayLong
-- WeekLong
-- MonthLong
-- QuarterLong
-- YearLong
-- deriving (Eq,Ord,Show,Generic)
-- Ways in which a period can be divided into subperiods.
data Interval = data Interval =
NoInterval NoInterval
| Days Int | Days Int
@ -149,13 +141,10 @@ data Interval =
| Months Int | Months Int
| Quarters Int | Quarters Int
| Years Int | Years Int
| DayOfMonth Int | NthWeekdayOfMonth Int Int -- n, weekday 1-7
| WeekdayOfMonth Int Int | MonthDay Int -- 1-31
| DaysOfWeek [Int] | MonthAndDay Int Int -- month 1-12, monthday 1-31
| DayOfYear Int Int -- Month, Day | DaysOfWeek [Int] -- [weekday 1-7]
-- WeekOfYear Int
-- MonthOfYear Int
-- QuarterOfYear Int
deriving (Eq,Show,Ord,Generic) deriving (Eq,Show,Ord,Generic)
instance Default Interval where def = NoInterval instance Default Interval where def = NoInterval