packages feed

time-recurrence 0.6.1 → 0.9.0

raw patch · 13 files changed

+788/−648 lines, 13 filesdep ~HUnitdep ~data-ordlistdep ~mtl

Dependency ranges changed: HUnit, data-ordlist, mtl, old-locale, test-framework, test-framework-hunit, time

Files

README view
@@ -20,153 +20,186 @@  Daily for 10 occurrences: -> take 10 $ recur daily `begin` sep1997+> take 10 $ starting sep1997 $ recur daily  Daily until Dec. 24, 1997: -> takeWhile (<= dec1997) $ recur daily `begin` sep1997+> takeWhile (<= dec1997) $ starting sep1997 $ recur daily  Every other day - forever: -> recur daily `by` 2 `begin` sep1997+> starting sep1997 $ recur daily `by` 2  Every 10 days, 5 occurrences: -> take 5 $ recur daily `by` 10 `begin` sep1997+> take 5 $ starting sep1997 $ recur daily `by` 10  Every day in January, for 3 years: -> takeWhile (<= jan2000) $ recur yearly `starting` jan1998 $->   enumMonths [January] >=>->   filterWeekDays [Monday .. Sunday]+> takeWhile (<= jan2000) $ starting jan1998 $+>   recur yearly+>   >==> enum (Months [January])+>   >==> filter (WeekDays [Monday .. Sunday]) -> takeWhile (<= jan2000) $ recur daily `starting` jan1998 $->   enumMonths [January]+> takeWhile (<= jan2000) $ starting jan1998 $+>   recur daily +>   >==> enum (Months [January])  Weekly for 10 occurrences: -> take 10 $ recur weekly `begin` sep1997+> take 10 $ starting sep1997 $ recur weekly  Weekly until Dec. 24, 1997: -> takeWhile (<= dec1997) $ recur weekly `withStartOfWeek` Sunday `begin` sep1997+> takeWhile (<= dec1997) $ starting sep1997 $+>   recur weekly `withStartOfWeek` Sunday  Every other week - forever: -> recur weekly `by` 2 `begin` sep1997+> starting sep1997 $ recur weekly `by` 2  Weekly on Tuesday and Thursday for five weeks: -> takeUntil (<= oct1997) $ recur weekly `withStartOfWeek` Sunday `starting` sep1997 $->   enumWeekDaysInWeek [Tuesday, Thursday]+> takeUntil (<= oct1997) $ starting sep1997 $+>   recur weekly `withStartOfWeek` Sunday+>   >==> enum (WeekDaysInWeek [Tuesday, Thursday])  or -> take 10 $ recur weekly `withStartOfWeek` Sunday `starting` sep1997 $->   enumWeekDaysInWeek [Tuesday, Thursday]+> take 10 $ starting sep1997 $+>   recur weekly `withStartOfWeek` Sunday+>   >==> enum (WeekDaysInWeek [Tuesday, Thursday])  Every other week (Monday, Wednesday, Firday) until Dec. 24, 1997: -> takeWhile (<= dec1997) $ recur weekly `withStartOfWeek` Sunday `by` 2 `starting` sep1997$->   enumWeekDaysInWeek [Monday, Wednesday, Friday] >=>+> takeWhile (<= dec1997) $ starting sep1997 $+>   recur weekly `withStartOfWeek` Sunday `by` 2+>   >==> enum (WeekDaysInWeek [Monday, Wednesday, Friday])  > Every other week on Tuesday and Thursday, for 8 occurrences: -> take 8 $ recur weekly `withStartOfWeek` Sunday `by` 2 `starting` sep1997 $->   enumWeekDaysInWeek [Tuesday, Thursday]+> take 8 $ starting sep1997 $+>   recur weekly `by` 2 `withStartOfWeek` Sunday+>   >==> enum (WeekDaysInWeek [Tuesday, Thursday])  Monthly on the first Friday for 10 occurrences: -> take 10 $ recur monthly `starting` sep1997 $->   enumWeekDaysInMonth [Friday] >=>->   nthWeekDayOfMonth [1]+> take 10 $ starting sep1997 $+>   recur monthly+>   >==> enum (WeekDaysInMonth [Friday])+>   >==> select (WeekDaysInMonth [1])  Monthly on the first Friday until Dec. 24, 1997 -> takeWhile (<= dec1997) $ recur monthly `starting` sep1997 $->   enumWeekDaysInMonth [Friday] >=>->   nthWeekDayOfMonth [1]+> takeWhile (<= dec1997) $ starting sep1997 $+>   recur monthly+>   >==> enum (WeekDaysInMonth [Friday])+>   >==> select (WeekDaysInMonth [1])  Every other month on the first and last Sunday of the month for 10 occurrences: -> take 10 $ recur monthly `by` 2 `starting` sep1997 $->   enumWeekDaysInMonth [Sunday] >=>->   nthWeekDayOfMonth [1,-1]+> take 10 $ starting sep1997 $+>   recur monthly+>   >==> enum (WeekDaysInMonth [Sunday])+>   >==> select (WeekDaysInMonth [1,-1])  Monthly on the second-to-last Monday of the month for 6 months: -> take 6 $ recur monthly `starting` sep1997 $->   enumWeekDaysInMonth [Monday] >=>->   nthWeekDayOfMonth [-2]+> take 6 $ starting sep1997 $+>   recur monthly+>   >==> enum (WeekDaysInMonth [Monday])+>   >==> select (WeekDaysInMonth [-2])  Monthly on the third-to-last day of the month, forever: -> recur monthly `starting` sep1997 $ enumDays [-3]+> starting sep1997 $+>   recur monthly+>   >==> enum (Days [-3])  Monthly on the 2nd and 15th of the month for 10 occurrences: -> take 10 $ recur monthly `starting` sep1997 $ enumDays [2,15]+> take 10 $ starting sep1997 $+>   recur monthly+>   >==> enum (Days [2,15])  Monthly on the first and last day of the month for 10 occurrences: -> take 10 $ recur monthly `starting` sep1997 $ enumDays [1,-1]+> take 10 $ starting sep1997 $+>   recur monthly+>   >==> enum (Days [1,-1])  Every 18 months on the 10th thru 15th of the month for 10 occurrences: -> take 10 $ recur monthly `by` 18 `starting` sep1997 $ enumDays [10 .. 15]+> take 10 $ starting sep1997 $+>   recur monthly+>   >==> enum (Days [10 .. 15])  Every Tuesday, every other month: -> recur monthly `by` 2 `starting` sep1997 $ enumWeekDaysInMonth [Tuesday]+> starting sep1997 $+>   recur monthly `by` 2+>   >==> enum (WeekDaysInMonth [Tuesday])  Yearly in June and July for 10 occurrences: -> take 10 $ recur yearly `starting` sep1997 $ enumMonths [June, July]+> take 10 $ starting sep1997 $+>   recur yearly+>   >==> enum (Months [June, July])  Every other year on January thru March for 10 occurrences: -> take 10 $ recur yearly `by` 2 `starting` mar1997 $ ->   enumMonths [January .. March] >=>->   enumWeekDaysInMonth [Monday .. Sunday]+> take 10 $ starting mar1997 $+>   recur yearly `by` 2+>   >==> enum (Months [January .. March])+>   >==> enum (WeekDaysInMonth [Monday .. Sunday])  Every third year on the 1st, 100th, and 200th day for 10 occurrences: -> take 10 $ recur yearly `by` 3 `starting` sep1997 $->   enumYearDays [1,100,200]+> take 10 $ starting sep1997 $+>   recur yearly `by` 3+>   >==> enum (YearDays [1,100,200])  Every 20th Monday of the year, forever: -> recur monthly `starting` sep1997 $ ->   enumWeekDaysInMonth [Monday] >=>->   nthWeekDay [20]+> starting sep1997 $+>   recur montly+>   >==> enum (WeekDaysInMonth [Monday])+>   >==> select (WeekDays [20])  Monday of week number 20, forever: -> recur yearly `starting` mar1997 $->   enumWeekNumbers [20] >=>->   filterWeekDays [Monday]+> starting mar1997 $+>   recur yearly+>   >==> enum (Weeks [20])+>   >==> filter (WeekDays [Monday])  or -> recur weekly `starting` mar1997 $->  filterWeekNumbers [20] >=>->  filterWeekDays [Monday]+> starting mar1997 $+>   recur weekly+>   >==> filter (Weeks [20])+>   >==> filter (WeekDays [Monday])  Every Thursday in March, forever: -> recur yearly `starting` mar1997 $->   enumMonths [March] >=>->   enumWeekDaysInMonth [Thrusday]+> starting mar1997 $+>   recur yearly+>   >==> enum (Months [March])+>   >==> enum (WeekDaysInMonth [Thursday])  Every Thursday, but only during June thru August, forever: -> recur yearly `starting` mar1997 $->   enumMonths [June .. August] >=>->   enumWeekDaysInMonth [Thursday]+> starting mar1997 $+>   recur yearly+>   >==> enum (Months [June .. August])+>   >==> enum (WeekDaysInMonth [Thursday]) -Firday the 13th, Forever:+Friday the 13th, Forever: -> recur monthly `starting` sep1997 $ enumDays [13] >=> filterWeekDays [Friday]+> starting sep1997+>   recur monthly+>   >==> enum (Days [13])+>   >==> filter (WeekDays [Friday])  The first Saturday that follows the first Sunday of the month, forever: @@ -177,65 +210,81 @@ U.S. Presidential Election Day: Every 4 years, the first Tuesday after a Monday in November, forever: -> recur yearly `by` 4 `starting` nov1996 $->   enumMonths [November] >=>->   enumDays [2 .. 8] >=>->   filterWeekDays [Tuesday]+> starting nov1996 $+>   recur yearly `by` 4+>   >==> enum (Months [November])+>   >==> enum (Days [2 .. 8])+>   >==> filter (WeekDays [Tuesday])  The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months. -> take 3 $ recur monthly `starting` sep1997 $->   enumWeekDaysInMonth [Tuesday .. Thursday] >=>->   nthWeekDayOfMonth [3]+> take 3 $ starting sep1997 $+>   recur monthly+>   >==> enum (WeekDaysInMonth [Tuesday .. Thursday])+>   >==> select (WeekDaysInMonth [3])  The second-to-last weekday of the month: -> recur monthly `starting` sep1997 $->   enumWeekDaysOfMonth [Monday .. Friday] >=>->   nthWeekDayOfMonth [-2]+> starting sep1997 $+>   recur monthly+>   >==> enum (WeekDaysInMonth [Monday .. Friday])+>   >==> select (WeekDaysInMonth [-2])  Every 3 hours from 9:00 AM to 5:00 PM on a specific day:  > takeWhile (<= addSeconds sep1997 (8 * oneHour)) $ ->   recur hourly `by` 3 `begin` sep1997+>   starting sep1997 $+>   recur hourly `by` 3  Every 15 minutes for 6 occurrences: -> take 6 $ recur minutely `by` 15 `begin` sep1997+> take 6 $ starting sep1997 $+>   recur minutely `by` 15 -Every hour and a hald for 4 occurrences:+Every hour and a half for 4 occurrences: -> take 4 $ recur minutely `by` 90 `begin` sep1997+> take 4 $ starting sep1997 $ recur minutely `by` 90  Every 20 minutes from 9:00 AM to 4:40 PM every day: -> recur daily `starting` sep1997 $->   enumHours [9 .. 16] >=>->   enumMinutes [0,20,40]+> staring sep1997 $+>   recur daily $+>   >==> enum (Hours [9 .. 16])+>   >==> enum (Minutes [0,20,40])  or -> recur minutely `by` 20 `starting` sep1997 $ enumHours [9 .. 16]+> starting sep1997 $+>   recur minutely `by` 20+>   >==> enum (Hours [9 .. 16])  The following two examples will generate different results due to changes in the start of the week. -> take 4 $ recur weekly `by` 2 `withStartOfWeek` Monday $->   enumWeekDaysInWeek [Tuesday,Sunday]+> take 4 $+>   recur weekly `by` 2 `withStartOfWeek` Monday+>   >==> enum (WeekDaysInWeek [Tuesday, Sunday])  vs -> take 4 $ recur weekly `by` 2 `withStartOfWeek` Sunday $->   enumWeekDaysInWeek [Tuesday,Sunday]+> take 4 $+>   recur weekly `by` 2 `withStartOfWeek` Sunday+>   >==> enum (WeekDaysInWeek [Tuesday, Sunday])  An example where an invalid date (Feb. 30) is ignored: -> take 5 $ recur monthly `starting` jan2000 $ enumDays [15,30]+> take 5 $ starting jan2000 $+>   recur monthly+>   >==> enum (Days [15,30])  The 15th and the 30th of the month, forever: -> recur monthly `starting` sep1997 $ enumDays [15,30]+> starting sep1997 $+>   recur monthly+>   >==> enum (Days [15,30])  The 15th and the 30th of the month, but only during the work week:-> recur monthly `starting` sep1997 $->   enumDays [15,30] >=>->   filterWeekDays [Monday .. Friday]++> starting sep1997 $+>   recur monthly+>   >==> enum (Days [15,30])+>   >==> filter (WeekDays [Monday .. Friday])
src/Data/Time/Calendar/Month.hs view
@@ -18,7 +18,7 @@     | October     | November     | December-  deriving (Show, Eq, Ord, Bounded)+  deriving (Read, Show, Eq, Ord, Bounded)  instance Enum Month where   fromEnum January   = 1
src/Data/Time/Calendar/WeekDay.hs view
@@ -13,4 +13,4 @@     | Friday      | Saturday      | Sunday-  deriving (Show, Eq, Ord, Enum, Bounded)+  deriving (Read, Show, Eq, Ord, Enum, Bounded)
src/Data/Time/Moment.hs view
@@ -4,7 +4,7 @@     )   where +import Data.Time.Moment.FutureMoments as ReExport import Data.Time.Moment.Interval as ReExport import Data.Time.Moment.Moment as ReExport import Data.Time.Moment.StartOfWeek as ReExport-import Data.Time.Moment.UTC as ReExport
+ src/Data/Time/Moment/FutureMoments.hs view
@@ -0,0 +1,336 @@+module Data.Time.Moment.FutureMoments+    (+      FutureMoments -- abstract, instances: Eq, Ord, Show++      -- * Drive the Moment computation+    , iterateFutureMoments++    , enumMonths+    , enumWeeks+    , enumDays+    , enumWeekDaysInWeek+    , enumWeekDaysInMonth+    , enumYearDays+    , enumHours+    , enumMinutes+    , enumSeconds++    , nthMonth+    , nthDay+    , nthWeek+    , nthWeekDay+    , nthWeekDayOfWeek+    , nthWeekDayOfMonth+    , nthYearDay+    , nthHour+    , nthMinute+    , nthSecond++    , filterMonths+    , filterWeeks+    , filterDays+    , filterWeekDays+    , filterYearDays+    , filterHours+    , filterMinutes+    , filterSeconds++    )+  where++import Control.Monad.Reader+import Data.Maybe (fromMaybe, mapMaybe)+import Data.List+import Data.List.Ordered as O+import Data.Time.Calendar.Month+import Data.Time.Calendar.WeekDay+import Data.Time.CalendarTime hiding (withDay)+import Data.Time.Moment.Moment++type FutureMoments a = Reader (InitialMoment a) [a]++iterateFutureMoments :: +  Moment a  => +  InitialMoment a+  -> ([a] -> FutureMoments a)+  -> [a]+iterateFutureMoments im sch = runReader (iterateInitialMoment >>= sch) im+  where+    iterateInitialMoment :: Moment a => FutureMoments a+    iterateInitialMoment = do+      im <- ask+      return $ iterate (next (interval im) (period im)) (moment im)++-- | Normalize an bounded ordinal index+--   Pass an upper-bound 'ub' and an index 'idx'+--   Converts 'idx' < 0 into valid 'idx' > 0 or+--   Nothing+normalizeOrdinalIndex :: Int -> Int -> Maybe Int+normalizeOrdinalIndex _ 0 = Nothing+normalizeOrdinalIndex ub idx =+  if abs idx > ub+    then Nothing+    else Just $ (idx + ub') `mod` ub'+  where+    ub' = ub + 1++enumYearDays ::+  (CalendarTimeConvertible a, Moment a) =>+  [Int]+  -> [a]+  -> FutureMoments a+enumYearDays days as = return $ concatMap (enumYearDays' days) as+  where+    enumYearDays' days a = mapMaybe (withYearDay a) (days' a days)+    days' a = mapMaybe $ normalizeOrdinalIndex (daysInYear a)++enumMonths :: +  (CalendarTimeConvertible a, Moment a) => +  [Month] +  -> [a] +  -> FutureMoments a+enumMonths months as = return $ concatMap (enumMonths' months) as+  where+    enumMonths' months a = mapMaybe (withMonth a) months++enumWeeks ::+  (CalendarTimeConvertible a, Moment a) =>+  [Int]+  -> [a]+  -> FutureMoments a+enumWeeks weeks as = do+  sow <- asks startOfWeek+  return $ concatMap (enumWeeks' sow weeks) as+ where+   enumWeeks' sow weeks a = mapMaybe (withWeekNumber sow a) weeks++enumDays ::+  (CalendarTimeConvertible a, Moment a) =>+  [Int]+  -> [a]+  -> FutureMoments a+enumDays days as = return $ concatMap (enumDays' days) as+  where+    enumDays' days a = mapMaybe (withDay a) (days' a days)+    days' a = mapMaybe $ normalizeOrdinalIndex (lastDayOfMonth a)++enumWeekDaysInWeek ::+  (CalendarTimeConvertible a, Moment a) =>+  [WeekDay]+  -> [a]+  -> FutureMoments a+enumWeekDaysInWeek wdays as = return $ concatMap (enumWeekDays' wdays) as+  where+    enumWeekDays' :: (CalendarTimeConvertible a, Moment a) => [WeekDay] -> a -> [a]+    enumWeekDays' wdays a0 = let+      w0     = calendarWeekDay $ toCalendarTime a0+      wdays' = dropWhile (/= w0) $ O.nubSort wdays+      in map (advanceToWeekDay a0) wdays'++enumWeekDaysInMonth ::+  (CalendarTimeConvertible a, Moment a) =>+  [WeekDay]+  -> [a]+  -> FutureMoments a+enumWeekDaysInMonth wdays as = return $ concatMap (enumWeekDays' wdays) as+  where+    enumWeekDays' wdays a = let+      mdays  = mapMaybe (withDay a) [1 .. lastDayOfMonth a]+      in filter (flip elem wdays . calendarWeekDay . toCalendarTime) mdays++enumHours ::+  (CalendarTimeConvertible a, Moment a) =>+  [Int]+  -> [a]+  -> FutureMoments a+enumHours hours as = return $ concatMap (enumHours' hours) as+  where+    enumHours' hours a = mapMaybe (withHour a) (hours' a hours)+    hours' _ = mapMaybe $ normalizeOrdinalIndex 23++enumMinutes ::+  (CalendarTimeConvertible a, Moment a) =>+  [Int]+  -> [a]+  -> FutureMoments a+enumMinutes ms as = return $ concatMap (enumMinutes' ms) as+  where+    enumMinutes' ms a = mapMaybe (withMinute a) (ms' a ms)+    ms' _ = mapMaybe $ normalizeOrdinalIndex 59++enumSeconds ::+  (CalendarTimeConvertible a, Moment a) =>+  [Int]+  -> [a]+  -> FutureMoments a+enumSeconds secs as = return $ concatMap (enumSeconds' secs) as+  where+    enumSeconds' secs a = mapMaybe (withSecond a) (secs' a secs)+    secs' _ = mapMaybe $ normalizeOrdinalIndex 60++groupWith :: (Ord b) => (a -> b) -> [a] -> [[a]]+groupWith f = groupBy (\a b -> f a == f b)++nth :: [Int] -> [a] -> [a]+nth ns as = map ((as !!) . pred) $ mapMaybe (normalizeOrdinalIndex (length as)) ns++nth' ::+  (Ord b) =>+  (a -> b)+  -> [Int]+  -> [a]+  -> FutureMoments a+nth' f ns as = return $ concatMap (nth ns) $ groupWith f as++nthYearDay ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthYearDay = nth' $ calendarYear . toCalendarTime++nthMonth ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthMonth = nth' $ calendarYear . toCalendarTime++nthDay ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthDay = nth' $ calendarMonth . toCalendarTime++nthWeek ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthWeek ns as = do+  sow <- asks startOfWeek+  return $+    concatMap (nth ns) $+    groupWith (weekNumber sow . toCalendarTime) as++nthWeekDayOfWeek ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthWeekDayOfWeek ns as = do+  sow <- asks startOfWeek+  return $+    concatMap (nth ns) $+    concatMap (groupWith (weekNumber sow)) $+    groupWith (calendarMonth . toCalendarTime) as++nthWeekDayOfMonth ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthWeekDayOfMonth = nth' $ calendarMonth . toCalendarTime++nthWeekDay ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthWeekDay = nth' $ calendarYear . toCalendarTime++nthHour ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthHour = nth' $ calendarDay . toCalendarTime++nthMinute ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthMinute = nth' $ calendarHour . toCalendarTime++nthSecond ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+nthSecond = nth' $ calendarMinute . toCalendarTime++filterCalendarTime' ::+  (CalendarTimeConvertible a, Eq b) =>+  (CalendarTime -> b)+  -> [b]+  -> [a]+  -> [a]+filterCalendarTime' f xs as = filter (flip elem xs . f . toCalendarTime) as++filterCalendarTime ::+  (CalendarTimeConvertible a, Eq b) =>+  (CalendarTime -> b)+  -> [b]+  -> [a]+  -> FutureMoments a+filterCalendarTime f xs as = return $ filterCalendarTime' f xs as++filterMonths ::+  CalendarTimeConvertible a =>+  [Month]+  -> [a]+  -> FutureMoments a+filterMonths = filterCalendarTime calendarMonth++filterYearDays ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+filterYearDays = filterCalendarTime calendarYearDay++filterDays ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+filterDays = filterCalendarTime calendarDay++filterWeeks ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+filterWeeks wks as = do+  sow <- asks startOfWeek+  return $ filterCalendarTime' (fromMaybe 0 . weekNumber sow) (filter (>0) wks) as++filterWeekDays ::+  CalendarTimeConvertible a =>+  [WeekDay]+  -> [a]+  -> FutureMoments a+filterWeekDays = filterCalendarTime calendarWeekDay++filterHours ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+filterHours = filterCalendarTime calendarHour++filterMinutes ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+filterMinutes = filterCalendarTime calendarMinute++filterSeconds ::+  CalendarTimeConvertible a =>+  [Int]+  -> [a]+  -> FutureMoments a+filterSeconds = filterCalendarTime calendarSecond
− src/Data/Time/Moment/Moment.hs 
@@ -1,224 +0,0 @@-module Data.Time.Moment.Moment-    (-      -- * Moment-      Moment (..)-    , iterateMoments-    , withYearDay-    , withWeekNumber-    , withSecond-    , withMinute-    , withHour-    , withDay-    , withMonth-    , withYear-    , advanceToWeekDay--      -- * Initial Moment-    , InitialMoment (..)--      -- * Default Initial Moment-    , secondly-    , minutely-    , hourly-    , daily-    , weekly-    , monthly-    , yearly--      -- * Adjust Interval-    , by-      -- * Adjust Start of Week-    , withStartOfWeek--      -- * Period-    , Period (..)-    )-  where--import Data.Time.Calendar.Month-import Data.Time.Calendar.OrdinalDate-import Data.Time.Calendar.WeekDay-import Data.Time.CalendarTime hiding (withDay)-import qualified Data.Time.CalendarTime as CT-import Data.Time.Moment.Interval-import Data.Time.Moment.Private-import Data.Time.Moment.StartOfWeek--oneSecond :: Integer-oneSecond = 1--oneMinute :: Integer-oneMinute = 60 * oneSecond--oneHour :: Integer-oneHour   = 60 * oneMinute--oneDay :: Integer-oneDay    = 24 * oneHour--oneWeek :: Integer-oneWeek   = 7  * oneDay---- | The @Moment@ class is for representing a instance in time.------ Instances of @Moment@ can be derived for any user-defined--- datatype for which can satisfy the minimal complete definition.------ Minimal complete definition: 'epoch', 'addSeconds', 'addMonths', 'addYears'--class Moment a where-  -- | Provide a default moment.-  epoch      :: a-  addSeconds :: a -> Integer -> a-  addMonths  :: a -> Integer -> a-  addYears   :: a -> Integer -> a--  addMinutes :: a -> Integer -> a-  addMinutes a = addSeconds a . (* oneMinute)-  addHours   :: a -> Integer -> a-  addHours a = addSeconds a . (* oneHour)-  addDays    :: a -> Integer -> a-  addDays a = addSeconds a . (* oneDay)-  addWeeks   :: a -> Integer -> a-  addWeeks a = addSeconds a . (* oneWeek)--  -- | Produce a new @Moment@ in the future ocurring at (/interval/ * /freq/)-  next :: Interval -> Period -> a -> a-  next (Interval interval) freq =-    case freq of-      Seconds -> add oneSecond-      Minutes -> add oneMinute-      Hours   -> add oneHour-      Days    -> add oneDay-      Weeks   -> add oneWeek-      Months  -> flip addMonths interval-      Years   -> flip addYears interval-    where-      add x = flip addSeconds (interval * x)--  -- | Produce a new @Moment@ in the past ocurring at (-/interval/ * /freq/)-  prev :: Interval -> Period -> a -> a-  prev (Interval interval) = next $ Interval (-interval)---- | Produce an infinite list from an initial @Moment@ and a step function.-iterateMoments :: Moment a => (a -> a) -> a -> [a]-iterateMoments = iterate---- | Possibly produce a 'Moment' with the given week number-withWeekNumber :: -  (CalendarTimeConvertible a, Moment a) => -  StartOfWeek -  -> a -  -> Int -  -> Maybe a-withWeekNumber _ t wk = do-  let ct = toCalendarTime t-  day <- fromMondayStartWeekValid (calendarYear ct) wk (fromEnum $ calendarWeekDay ct)-  fromCalendarTime $ CT.withDay ct day---- | Possibly produce a 'Moment' with the given day of the year-withYearDay ::-  (CalendarTimeConvertible a, Moment a) =>-  a-  -> Int-  -> Maybe a-withYearDay t yd = do- let ct = toCalendarTime t- day <- fromOrdinalDateValid (calendarYear ct) yd- fromCalendarTime $ CT.withDay ct day---- | Possibly produce a 'Moment' with the given second-withSecond :: (CalendarTimeConvertible a, Moment a) => a -> Int -> Maybe a-withSecond t s = fromCalendarTime (toCalendarTime t){calendarSecond = s}---- | Possibly produce a 'Moment' with the given minute-withMinute :: (CalendarTimeConvertible a, Moment a) => a -> Int -> Maybe a-withMinute t m = fromCalendarTime (toCalendarTime t){calendarMinute = m}---- | Possibly produce a 'Moment' with the given hour-withHour :: (CalendarTimeConvertible a, Moment a) => a -> Int -> Maybe a-withHour t h = fromCalendarTime (toCalendarTime t){calendarHour = h}---- | Possibly produce a 'Moment' with the given month day-withDay :: (CalendarTimeConvertible a, Moment a) => a -> Int -> Maybe a-withDay t d = fromCalendarTime (toCalendarTime t){calendarDay = d}---- | Possibly produce a 'Moment' with the given month-withMonth :: (CalendarTimeConvertible a, Moment a) => a -> Month -> Maybe a-withMonth t m = fromCalendarTime (toCalendarTime t){calendarMonth = m}---- | Possibly produce a 'Moment' with the given year-withYear :: (CalendarTimeConvertible a, Moment a) => a -> Integer -> Maybe a-withYear t y = fromCalendarTime (toCalendarTime t){calendarYear = y}--advanceToWeekDay :: -  (CalendarTimeConvertible a, Moment a) => -  a -> -  WeekDay -> -  a-advanceToWeekDay t d = let-  ct  = toCalendarTime t-  d0  = calendarWeekDay ct-  d'  = fromEnum d-  d0' = fromEnum d0-  delta = toInteger $ d' - d0' `mod` 7-  in addDays t $ if delta == 0 then 7 else delta---- | The @InitialMoment@ datatype--data InitialMoment a = InitialMoment-    { period      :: Period-    , interval    :: Interval-    , startOfWeek :: StartOfWeek-    , moment      :: a-    }-  deriving (Show)--mkIM :: Moment a => Period -> InitialMoment a-mkIM f = InitialMoment f (toInterval 1) (StartOfWeek Monday) epoch---- | Default initial moments--secondly :: Moment a => InitialMoment a-secondly = mkIM Seconds--minutely :: Moment a => InitialMoment a-minutely = mkIM Minutes--hourly :: Moment a => InitialMoment a-hourly = mkIM Hours--daily :: Moment a => InitialMoment a-daily = mkIM Days--weekly :: Moment a => InitialMoment a-weekly = mkIM Weeks--monthly :: Moment a => InitialMoment a-monthly = mkIM Months--yearly :: Moment a => InitialMoment a-yearly = mkIM Years---- | Typically called infix on an existing 'InitialMoment', like:--- --- > monthly `by` 2-by :: InitialMoment a -> Integer -> InitialMoment a-by im i = im{interval=toInterval i}---- | Typically called infix on an existing 'InitialMoment', like:------ > weekly `withStartOfWeek` Tuesday-withStartOfWeek :: InitialMoment a -> WeekDay -> InitialMoment a-withStartOfWeek im sow = im{startOfWeek=toStartOfWeek sow}---- | @Period@ data type-data Period-    = Seconds-    | Minutes-    | Hours-    | Days-    | Weeks-    | Months-    | Years-  deriving (Enum, Bounded, Eq, Ord, Show)
src/Data/Time/Moment/UTC.hs view
@@ -1,12 +1,5 @@ module Data.Time.Moment.UTC     (-      secondlyUTC-    , minutelyUTC-    , hourlyUTC-    , dailyUTC-    , weeklyUTC-    , monthlyUTC-    , yearlyUTC     )   where @@ -18,26 +11,3 @@   addSeconds utc i = addUTCTime (fromIntegral i) utc   addMonths (UTCTime d t) i = UTCTime (addGregorianMonthsRollOver i d) t   addYears (UTCTime d t) i = UTCTime (addGregorianYearsRollOver i d) t---- | @InitialMoment@ defaults for @UTCTime@--secondlyUTC :: InitialMoment UTCTime-secondlyUTC = secondly--minutelyUTC :: InitialMoment UTCTime-minutelyUTC = minutely--hourlyUTC :: InitialMoment UTCTime-hourlyUTC = hourly--dailyUTC :: InitialMoment UTCTime-dailyUTC = daily--weeklyUTC :: InitialMoment UTCTime-weeklyUTC = weekly--monthlyUTC :: InitialMoment UTCTime-monthlyUTC = monthly--yearlyUTC :: InitialMoment UTCTime-yearlyUTC = yearly
src/Data/Time/Recurrence.hs view
@@ -1,6 +1,7 @@ module Data.Time.Recurrence     (       CalendarTime (..)+    , M.Moment     , module ReExport     )   where@@ -8,5 +9,8 @@ import Data.Time.CalendarTime import Data.Time.Calendar.Month as ReExport import Data.Time.Calendar.WeekDay as ReExport-import Data.Time.Moment as ReExport+import qualified Data.Time.Moment as M+import Data.Time.Moment.UTC ()+import Data.Time.Recurrence.AndThen as ReExport import Data.Time.Recurrence.Schedule as ReExport+import Data.Time.Recurrence.ScheduleDetails as ReExport hiding (eval)
+ src/Data/Time/Recurrence/AndThen.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-}+module Data.Time.Recurrence.AndThen+    (+      AndThen (..)+    )+  where++infixr 0 >==>++class AndThen a b c | a b -> c where+  (>==>) :: a -> b -> c
src/Data/Time/Recurrence/Schedule.hs view
@@ -1,316 +1,139 @@+{-# LANGUAGE GADTs, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances #-} -- This module is intended to be imported @qualified!, to avoid name -- clashes with "Prelude" functions. eg. -- -- > import qualified Data.Time.Recurrence.Schedule as S module Data.Time.Recurrence.Schedule     (-      Schedule -- abstract, instances: Eq, Ord, Show+      -- * Schedule+      Schedule (..)++      -- * Freq+    , Freq++      -- * Function interface to Recur     , recur-    , starting-    , begin -    , enumMonths-    , enumDays-    , enumWeekDaysInWeek-    , enumWeekDaysInMonth-    , enumYearDays-    , enumHours-    , enumMinutes-    , enumSeconds+      -- * Adjust Interval+    , by+      -- * Adjust Start of Week+    , withStartOfWeek -    , nthMonth-    , nthDay-    , nthWeekDay-    , nthWeekDayOfWeek-    , nthWeekDayOfMonth-    , nthYearDay-    , nthHour-    , nthMinute-    , nthSecond+      -- * Default Freq+    , secondly+    , minutely+    , hourly+    , daily+    , weekly+    , monthly+    , yearly -    , filterMonths-    , filterDays-    , filterWeekDays-    , filterYearDays-    , filterHours-    , filterMinutes-    , filterSeconds+      -- * evaluate a Schedule into a function+    , eval++      -- * run an evaluated Schedule from a moment+    , starting     )   where -import Control.Monad.Reader-import Data.List as L import Data.List.Ordered as O-import Data.Maybe (mapMaybe)-import Data.Time.Calendar.Month+import Data.Time.Calendar.Month () import Data.Time.Calendar.WeekDay-import Data.Time.CalendarTime hiding (withDay)-import Data.Time.Moment+import Data.Time.CalendarTime+import Data.Time.Moment hiding (interval, startOfWeek, Period(..))+import qualified Data.Time.Moment as M (Period(..))+import Data.Time.Recurrence.AndThen+import Data.Time.Recurrence.ScheduleDetails hiding (eval)+import qualified Data.Time.Recurrence.ScheduleDetails as D (eval) -type Schedule a = Reader (InitialMoment a) [a]+data Freq+    = Secondly { interval :: Interval, startOfWeek :: StartOfWeek }+    | Minutely { interval :: Interval, startOfWeek :: StartOfWeek }+    | Hourly   { interval :: Interval, startOfWeek :: StartOfWeek }+    | Daily    { interval :: Interval, startOfWeek :: StartOfWeek }+    | Weekly   { interval :: Interval, startOfWeek :: StartOfWeek }+    | Monthly  { interval :: Interval, startOfWeek :: StartOfWeek }+    | Yearly   { interval :: Interval, startOfWeek :: StartOfWeek }+  deriving (Show) -runSchedule :: Schedule a -> InitialMoment a -> [a]-runSchedule = runReader+defaultFreq :: (Interval -> StartOfWeek -> Freq) -> Freq+defaultFreq = flip uncurry (toInterval 1, toStartOfWeek Sunday) -repeatSchedule :: -  Moment a  => -  InitialMoment a -  -> ([a] -> Schedule a) -  -> [a]-repeatSchedule im sch = runSchedule (iterateInitialMoment >>= sch) im-  where-    iterateInitialMoment :: Moment a => Schedule a-    iterateInitialMoment = do-      im <- ask-      return $ iterate (next (interval im) (period im)) (moment im)+secondly :: Freq+secondly = defaultFreq Secondly -recur :: a -> a-recur = id+minutely :: Freq+minutely = defaultFreq Minutely --- | 'starting' is an infinite list of 'Moment's, where no 'Moment' --- occurrs before the 'InitialMoment'. The list is further refined--- by the passed in function.-starting :: (Ord a, Moment a) => -  InitialMoment a -  -> a -  -> ([a] -> Schedule a) -  -> [a]-starting im m0 = dropWhile (< m0) . O.nub . repeatSchedule im{moment=m0}+hourly :: Freq+hourly = defaultFreq Hourly -begin :: (Ord a, Moment a) => InitialMoment a -> a -> [a]-begin im m0 = starting im m0 return+daily :: Freq+daily = defaultFreq Daily --- | Normalize an bounded ordinal index---   Pass an upper-bound 'ub' and an index 'idx'---   Converts 'idx' < 0 into valid 'idx' > 0 or---   Nothing-normalizeOrdinalIndex :: Int -> Int -> Maybe Int-normalizeOrdinalIndex _ 0 = Nothing-normalizeOrdinalIndex ub idx =-  if abs idx > ub-    then Nothing-    else Just $ (idx + ub') `mod` ub'-  where-    ub' = ub + 1+weekly :: Freq+weekly = defaultFreq Weekly -enumYearDays ::-  (CalendarTimeConvertible a, Moment a) =>-  [Int]-  -> [a]-  -> Schedule a-enumYearDays days as = return $ concatMap (enumYearDays' days) as-  where-    enumYearDays' days a = mapMaybe (withYearDay a) (days' a days)-    days' a = mapMaybe $ normalizeOrdinalIndex (daysInYear a)+monthly :: Freq+monthly = defaultFreq Monthly -enumMonths :: -  (CalendarTimeConvertible a, Moment a) => -  [Month] -  -> [a] -  -> Schedule a-enumMonths months as = return $ concatMap (enumMonths' months) as-  where -    enumMonths' months a = mapMaybe (withMonth a) months+yearly :: Freq+yearly = defaultFreq Yearly -enumDays ::-  (CalendarTimeConvertible a, Moment a) =>-  [Int]-  -> [a]-  -> Schedule a-enumDays days as = return $ concatMap (enumDays' days) as-  where -    enumDays' days a = mapMaybe (withDay a) (days' a days)-    days' a = mapMaybe $ normalizeOrdinalIndex (lastDayOfMonth a)+-- | Typically called infix on an existing 'Freq', like:+-- +-- > monthly `by` 2+by :: Freq -> Integer -> Freq+by fr i = fr{interval=toInterval i} -enumWeekDaysInWeek ::-  (CalendarTimeConvertible a, Moment a) =>-  [WeekDay]-  -> [a]-  -> Schedule a-enumWeekDaysInWeek wdays as = return $ concatMap (enumWeekDays' wdays) as-  where-    enumWeekDays' :: (CalendarTimeConvertible a, Moment a) => [WeekDay] -> a -> [a]-    enumWeekDays' wdays a0 = let-      w0     = calendarWeekDay $ toCalendarTime a0-      wdays' = dropWhile (/= w0) $ O.nubSort wdays-      in map (advanceToWeekDay a0) wdays'+-- | Typically called infix on an existing 'Freq', like:+--+-- > weekly `withStartOfWeek` Tuesday+withStartOfWeek :: Freq -> WeekDay -> Freq+withStartOfWeek fr sow = fr{startOfWeek=toStartOfWeek sow} -enumWeekDaysInMonth ::-  (CalendarTimeConvertible a, Moment a) =>-  [WeekDay]-  -> [a]-  -> Schedule a-enumWeekDaysInMonth wdays as = return $ concatMap (enumWeekDays' wdays) as-  where-    enumWeekDays' wdays a = let-      mdays  = mapMaybe (withDay a) [1 .. lastDayOfMonth a]-      in filter (flip elem wdays . calendarWeekDay . toCalendarTime) mdays-      -enumHours ::-  (CalendarTimeConvertible a, Moment a) =>-  [Int]-  -> [a]-  -> Schedule a-enumHours hours as = return $ concatMap (enumHours' hours) as-  where-    enumHours' hours a = mapMaybe (withHour a) (hours' a hours)-    hours' _ = mapMaybe $ normalizeOrdinalIndex 23 -enumMinutes ::-  (CalendarTimeConvertible a, Moment a) =>-  [Int]-  -> [a]-  -> Schedule a-enumMinutes ms as = return $ concatMap (enumMinutes' ms) as-  where-    enumMinutes' ms a = mapMaybe (withMinute a) (ms' a ms)-    ms' _ = mapMaybe $ normalizeOrdinalIndex 59--enumSeconds ::-  (CalendarTimeConvertible a, Moment a) => -  [Int]-  -> [a]-  -> Schedule a-enumSeconds secs as = return $ concatMap (enumSeconds' secs) as-  where-    enumSeconds' secs a = mapMaybe (withSecond a) (secs' a secs)-    secs' _ = mapMaybe $ normalizeOrdinalIndex 60--groupWith :: (Ord b) => (a -> b) -> [a] -> [[a]]-groupWith f = groupBy (\a b -> f a == f b)--nth :: [Int] -> [a] -> [a]-nth ns as = map ((as !!) . pred) $ mapMaybe (normalizeOrdinalIndex (length as)) ns--nth' ::-  Ord b => -  (a -> b)-  -> [Int]-  -> [a]-  -> Schedule a-nth' f ns as = return $ concatMap (nth ns) $ groupWith f as--nthYearDay ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthYearDay = nth' $ calendarYear . toCalendarTime--nthMonth ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthMonth = nth' $ calendarYear . toCalendarTime--nthDay ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthDay = nth' $ calendarMonth . toCalendarTime--nthWeekDayOfWeek ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthWeekDayOfWeek ns as = do-  sow <- asks startOfWeek-  return $ -    concatMap (nth ns) $-    concatMap (groupWith (weekNumber sow)) $-    groupWith (calendarMonth . toCalendarTime) as --nthWeekDayOfMonth ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthWeekDayOfMonth = nth' $ calendarMonth . toCalendarTime--nthWeekDay ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthWeekDay = nth' $ calendarYear . toCalendarTime--nthHour ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthHour = nth' $ calendarDay . toCalendarTime--nthMinute ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthMinute = nth' $ calendarHour . toCalendarTime--nthSecond ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-nthSecond = nth' $ calendarMinute . toCalendarTime+data Schedule a where+    Recur :: Freq -> Schedule Freq+    And  :: Schedule Freq -> ScheduleDetails b -> Schedule (ScheduleDetails b) -filterCalendarTime ::-  (CalendarTimeConvertible a, Eq b) =>-  (CalendarTime -> b)-  -> [b]-  -> [a]-  -> Schedule a-filterCalendarTime f xs as = return $ filter (flip elem xs . f . toCalendarTime) as+deriving instance Show (Schedule a) -filterMonths ::-  CalendarTimeConvertible a =>-  [Month]-  -> [a]-  -> Schedule a-filterMonths = filterCalendarTime calendarMonth+recur :: Freq -> Schedule Freq+recur = Recur -filterYearDays ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-filterYearDays = filterCalendarTime calendarYearDay+instance AndThen (Schedule Freq) (ScheduleDetails b) (Schedule (ScheduleDetails b)) where+  (>==>) x y = And x y -filterDays ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-filterDays = filterCalendarTime calendarDay+eval :: (CalendarTimeConvertible a, Ord a, Moment a) => Schedule b -> (a -> [a])+eval (And recur details) = flip (startWith $ mkIM recur) $ D.eval details+eval recur@(Recur _)      = start $ mkIM recur -filterWeekDays ::-  CalendarTimeConvertible a => -  [WeekDay]-  -> [a]-  -> Schedule a-filterWeekDays = filterCalendarTime calendarWeekDay+starting :: (CalendarTimeConvertible a, Ord a, Moment a) => a -> Schedule b -> [a]+starting m0 sch = (eval sch) m0 -filterHours ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-filterHours = filterCalendarTime calendarHour+mkIM :: Moment a => Schedule Freq -> InitialMoment a+mkIM (Recur freq) =+    mkIM' (case freq of (Secondly _ _) -> M.Seconds+                        (Minutely _ _) -> M.Minutes+                        (Hourly   _ _) -> M.Hours+                        (Daily    _ _) -> M.Days+                        (Weekly   _ _) -> M.Weeks+                        (Monthly  _ _) -> M.Months+                        (Yearly   _ _) -> M.Years) (interval freq) (startOfWeek freq)+  where+    mkIM' :: Moment a => M.Period -> Interval -> StartOfWeek -> InitialMoment a+    mkIM' per int sow = InitialMoment per int sow epoch -filterMinutes ::-  CalendarTimeConvertible a =>-  [Int]+-- | 'startWith' is an infinite list of 'Moment's, where no 'Moment' +-- occurrs before the 'InitialMoment'. The list is further refined+-- by the passed in function.+startWith :: (Ord a, Moment a) => +  InitialMoment a +  -> a +  -> ([a] -> FutureMoments a)   -> [a]-  -> Schedule a-filterMinutes = filterCalendarTime calendarMinute+startWith im m0 = dropWhile (< m0) . O.nub . iterateFutureMoments im{moment=m0} -filterSeconds ::-  CalendarTimeConvertible a =>-  [Int]-  -> [a]-  -> Schedule a-filterSeconds = filterCalendarTime calendarSecond+start :: (Ord a, Moment a) => InitialMoment a -> a -> [a]+start im m0 = startWith im m0 return
+ src/Data/Time/Recurrence/ScheduleDetails.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE GADTs, EmptyDataDecls, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeSynonymInstances,UndecidableInstances #-}+module Data.Time.Recurrence.ScheduleDetails+    (+      -- * ScheduleDetails+      ScheduleDetails++    , eval++      -- * Functional interface to constructors+    , enum+    , filter+    , select++      -- * Period Filters+    , PeriodFilter (..)+    , EnumerablePeriodFilter (..)+    , FilterablePeriodFilter (..)+    , SelectablePeriodFilter (..)+    )+  where++import Prelude hiding (filter)+import Control.Monad ((>=>))+import Data.Time.Calendar.Month+import Data.Time.Calendar.WeekDay+import Data.Time.CalendarTime+import Data.Time.Moment hiding (Period(..))+import Data.Time.Recurrence.AndThen++data ScheduleDetails a where+    Enumerate  :: EnumerablePeriodFilter -> ScheduleDetails EnumerablePeriodFilter+    Filter     :: FilterablePeriodFilter -> ScheduleDetails FilterablePeriodFilter+    Select     :: SelectablePeriodFilter -> ScheduleDetails SelectablePeriodFilter+    EPFCons    :: ScheduleDetails EnumerablePeriodFilter -> ScheduleDetails EnumerablePeriodFilter -> ScheduleDetails EnumerablePeriodFilter+    FPFCons    :: ScheduleDetails FilterablePeriodFilter -> ScheduleDetails FilterablePeriodFilter -> ScheduleDetails FilterablePeriodFilter+    SPFCons    :: ScheduleDetails SelectablePeriodFilter -> ScheduleDetails SelectablePeriodFilter -> ScheduleDetails SelectablePeriodFilter+    EPFConsFPF :: ScheduleDetails EnumerablePeriodFilter -> ScheduleDetails FilterablePeriodFilter -> ScheduleDetails FilterablePeriodFilter+    FPFConsSPF :: ScheduleDetails FilterablePeriodFilter -> ScheduleDetails SelectablePeriodFilter -> ScheduleDetails SelectablePeriodFilter+    EPFConsSPF :: ScheduleDetails EnumerablePeriodFilter -> ScheduleDetails SelectablePeriodFilter -> ScheduleDetails SelectablePeriodFilter++deriving instance Show (ScheduleDetails a)++enum :: PeriodFilter Month WeekDay NotEnumerable -> ScheduleDetails EnumerablePeriodFilter+enum = Enumerate . EPF++filter :: PeriodFilter Month NotFilterable WeekDay -> ScheduleDetails FilterablePeriodFilter+filter = Filter . FPF++select :: PeriodFilter Int Int Int -> ScheduleDetails SelectablePeriodFilter+select = Select . SPF++type BareEPF = EnumerablePeriodFilter+type WrapEPF = ScheduleDetails EnumerablePeriodFilter++instance AndThen BareEPF BareEPF WrapEPF where+  (>==>) x y = (Enumerate x) `EPFCons` (Enumerate y)++instance AndThen BareEPF WrapEPF WrapEPF where+  (>==>) x y = (Enumerate x) `EPFCons` y++instance AndThen WrapEPF WrapEPF WrapEPF where+  (>==>) x y = x `EPFCons` y++type BareFPF = FilterablePeriodFilter+type WrapFPF = ScheduleDetails FilterablePeriodFilter++instance AndThen BareFPF BareFPF WrapFPF where+  (>==>) x y = (Filter x) `FPFCons` (Filter y)++instance AndThen BareFPF WrapFPF WrapFPF where+  (>==>) x y = (Filter x) `FPFCons` y++instance AndThen WrapFPF WrapFPF WrapFPF where+  (>==>) x y = x `FPFCons` y++type BareSPF = SelectablePeriodFilter+type WrapSPF = ScheduleDetails SelectablePeriodFilter++instance AndThen BareSPF BareSPF WrapSPF where+  (>==>) x y = (Select x) `SPFCons` (Select y)++instance AndThen BareSPF WrapSPF WrapSPF where+  (>==>) x y = (Select x) `SPFCons` y++instance AndThen WrapSPF WrapSPF WrapSPF where+  (>==>) x y = x `SPFCons` y++instance AndThen WrapEPF WrapFPF WrapFPF where+  (>==>) x y = x `EPFConsFPF` y++instance AndThen WrapFPF WrapSPF WrapSPF where+  (>==>) x y = x `FPFConsSPF` y++instance AndThen WrapEPF WrapSPF WrapSPF where+  (>==>) x y = x `EPFConsSPF` y++data PeriodFilter m e f+    = Seconds [Int]+    | Minutes [Int]+    | Hours [Int]+    | Days [Int]+    | Weeks [Int]+    | WeekDays [f]+    | WeekDaysInWeek [e]+    | WeekDaysInMonth [e]+    | Months [m]+    | YearDays [Int]+  deriving (Read, Show)++data NotEnumerable+data NotFilterable++instance Show NotEnumerable where+  show _ = undefined++instance Read NotEnumerable where+  readsPrec _ _ = undefined++instance Show NotFilterable where+  show _ = undefined++instance Read NotFilterable where+  readsPrec _ _ = undefined++newtype EnumerablePeriodFilter = EPF { fromEPF :: PeriodFilter Month WeekDay NotEnumerable } deriving (Read, Show)+newtype FilterablePeriodFilter = FPF { fromFPF :: PeriodFilter Month NotFilterable WeekDay } deriving (Read, Show)+newtype SelectablePeriodFilter = SPF { fromSPF :: PeriodFilter Int Int Int } deriving (Read, Show)++eval :: (CalendarTimeConvertible a, Ord a, Moment a) => ScheduleDetails b -> ([a] -> FutureMoments a)+eval (Enumerate x) = case (fromEPF x) of+    (Seconds ss)         -> enumSeconds ss+    (Minutes mm)         -> enumMinutes mm+    (Hours hh)           -> enumHours hh+    (WeekDays _)         -> undefined+    (WeekDaysInWeek ww)  -> enumWeekDaysInWeek ww+    (WeekDaysInMonth ww) -> enumWeekDaysInMonth ww+    (Days dd)            -> enumDays dd+    (Weeks wk)           -> enumWeeks wk+    (Months mm)          -> enumMonths mm+    (YearDays yy)        -> enumYearDays yy+eval (Filter x) = case (fromFPF x) of+    (Seconds ss)        -> filterSeconds ss+    (Minutes mm)        -> filterMinutes mm+    (Hours hh)          -> filterHours hh+    (WeekDays ww)       -> filterWeekDays ww+    (WeekDaysInWeek _)  -> undefined+    (WeekDaysInMonth _) -> undefined+    (Days dd)           -> filterDays dd+    (Weeks wk)          -> filterWeeks wk+    (Months mm)         -> filterMonths mm+    (YearDays yy)       -> filterYearDays yy+eval (Select x) = case (fromSPF x) of+    (Seconds ss)         -> nthSecond ss+    (Minutes mm)         -> nthMinute mm+    (Hours hh)           -> nthHour hh+    (WeekDays ww)        -> nthWeekDay ww+    (WeekDaysInWeek ww)  -> nthWeekDayOfWeek ww+    (WeekDaysInMonth ww) -> nthWeekDayOfMonth ww+    (Weeks wk)           -> nthWeek wk+    (Days dd)            -> nthDay dd+    (Months mm)          -> nthDay mm+    (YearDays yy)        -> nthYearDay yy+eval (EPFCons x y)    = eval x >=> eval y+eval (FPFCons x y)    = eval x >=> eval y+eval (SPFCons x y)    = eval x >=> eval y+eval (EPFConsFPF x y) = eval x >=> eval y+eval (FPFConsSPF x y) = eval x >=> eval y+eval (EPFConsSPF x y) = eval x >=> eval y++
tests/Tests.lhs view
@@ -17,8 +17,7 @@ > import Data.Time > import Data.Maybe (fromJust) -> import Prelude hiding (until)-> import Control.Monad ((>=>))+> import Prelude hiding (until, filter) > import Data.Time.Recurrence  We are certain of the validity of the dates used, and so fromJust is safe@@ -44,19 +43,19 @@ > tests =  >      [ testGroup "RFC5445 Examples" $ zipWith (testCase . show) [1::Int ..] >        [ assertEqual ("Test Daily from "++ show date1 ++". 10 Occurrences") ->            (take 10 $ recur daily `begin` date1)->            (take 10 $ recur monthly `starting` date1 $ enumDays [2 .. 11])+>            (take 10 $ starting date1 $ recur daily)+>            (take 10 $ starting date1 $ recur monthly >==> enum (Days [2 .. 11])) >        , assertEqual ("Test Daily from "++ show date1 ++". Until "++ show date2)->            (until date2 $ recur daily `begin` date1)->            (until date2 $ recur monthly `starting` date1 $ enumWeekDaysInMonth [Monday .. Sunday])+>            (until date2 $ starting date1 $ recur daily)+>            (until date2 $ starting date1 $ recur monthly >==> enum (WeekDaysInMonth [Monday .. Sunday])) >        , assertBool ("Test every other day from "++ show date1 ++". Cap at 10000")->            (checkDayDist 2 $ take 10000 $ recur daily `by` 2 `begin` date1) +>            (checkDayDist 2 $ take 10000 $ starting date1 $ recur $ daily `by` 2) >        , assertEqual ("Test every 10 days from "++ show date1 ++". 5 Occurrences")->            (take 5 $ recur daily `by` 10 `begin` date1)->            (take 5 $ recur yearly `starting` date1 $ enumMonths [September, October] >=> enumDays [2,12,22])+>            (take 5 $ starting date1 $ recur $ daily `by` 10)+>            (take 5 $ starting date1 $ recur yearly >==> enum (Months [September, October]) >==> enum (Days [2,12,22])) >        , assertEqual "Test every day in Jan. for 3 years"->            (until date4 $ recur yearly `starting` date3 $ enumMonths [January] >=> enumWeekDaysInMonth [Monday .. Sunday])->            (until date4 $ recur daily `starting` date3 $ filterMonths [January])+>            (until date4 $ starting date3 $ recur yearly >==> enum (Months [January]) >==> enum (WeekDaysInMonth [Monday .. Sunday]))+>            (until date4 $ starting date3 $ recur daily >==> filter (Months [January])) >        ] >      ]
time-recurrence.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.6.1+Version:             0.9.0  -- A short (one-line) description of the package. Synopsis:            Generate recurring dates.@@ -69,21 +69,23 @@      Data.Time.Calendar.WeekDay,      Data.Time.CalendarTime,      Data.Time.Moment,-     Data.Time.Moment.Interval,-     Data.Time.Moment.StartOfWeek,      Data.Time.Recurrence,+     Data.Time.Recurrence.AndThen      Data.Time.Recurrence.Schedule+     Data.Time.Recurrence.ScheduleDetails   Other-modules:      Data.Time.CalendarTime.CalendarTime,-     Data.Time.Moment.Moment,+     Data.Time.Moment.FutureMoments+     Data.Time.Moment.Interval,+     Data.Time.Moment.StartOfWeek,      Data.Time.Moment.Private,      Data.Time.Moment.UTC      -- Packages needed in order to build this package.   Build-depends:       base >= 4 && < 5,-                       time >= 1.4.0.1 && < 1.5,+                       time >= 1.4 && < 1.5,                        data-ordlist >= 0.4 && < 0.4.5,-                       mtl >= 2.0.1.0 && < 2.1+                       mtl >= 2.0 && < 2.2      Default-Language:    Haskell98   -- Modules not exported by this package.@@ -98,13 +100,13 @@   main-is:              Tests.lhs   ghc-options:          -Wall -fno-warn-name-shadowing -fno-warn-orphans   build-depends:        base >= 4 && < 5,-                        time >= 1.4.0.1 && < 1.5,-                        data-ordlist >= 0.4 && < 0.4.5,-                        mtl >= 2.0.1.0 && < 2.1,-                        test-framework >= 0.4.0 && < 0.5,-                        test-framework-hunit >= 0.2.6 && < 0.3,-                        HUnit >= 1.2.2.3 && < 1.3,-                        old-locale >= 1.0.0.2 && < 1.1+                        time >= 1.4 && < 1.5,+                        data-ordlist >= 0.4 && < 0.5,+                        mtl >= 2.0 && < 2.2,+                        test-framework >= 0.4 && < 0.7,+                        test-framework-hunit >= 0.2 && < 0.3,+                        HUnit >= 1.2 && < 1.3,+                        old-locale >= 1.0 && < 1.1   other-modules:     Data.Time.Recurrence   default-language:     Haskell98