-- 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 , recur , starting , begin , enumMonths , enumDays , enumWeekDaysInWeek , enumWeekDaysInMonth , enumYearDays , enumHours , enumMinutes , enumSeconds , nthMonth , nthDay , nthWeekDay , nthWeekDayOfWeek , nthWeekDayOfMonth , nthYearDay , nthHour , nthMinute , nthSecond , filterMonths , filterDays , filterWeekDays , filterYearDays , filterHours , filterMinutes , filterSeconds ) 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.WeekDay import Data.Time.CalendarTime hiding (withDay) import Data.Time.Moment type Schedule a = Reader (InitialMoment a) [a] runSchedule :: Schedule a -> InitialMoment a -> [a] runSchedule = runReader 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) recur :: a -> a recur = id -- | '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} begin :: (Ord a, Moment a) => InitialMoment a -> a -> [a] begin im m0 = starting im m0 return -- | 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] -> 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) 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 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) 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' 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 filterCalendarTime :: (CalendarTimeConvertible a, Eq b) => (CalendarTime -> b) -> [b] -> [a] -> Schedule a filterCalendarTime f xs as = return $ filter (flip elem xs . f . toCalendarTime) as filterMonths :: CalendarTimeConvertible a => [Month] -> [a] -> Schedule a filterMonths = filterCalendarTime calendarMonth filterYearDays :: CalendarTimeConvertible a => [Int] -> [a] -> Schedule a filterYearDays = filterCalendarTime calendarYearDay filterDays :: CalendarTimeConvertible a => [Int] -> [a] -> Schedule a filterDays = filterCalendarTime calendarDay filterWeekDays :: CalendarTimeConvertible a => [WeekDay] -> [a] -> Schedule a filterWeekDays = filterCalendarTime calendarWeekDay filterHours :: CalendarTimeConvertible a => [Int] -> [a] -> Schedule a filterHours = filterCalendarTime calendarHour filterMinutes :: CalendarTimeConvertible a => [Int] -> [a] -> Schedule a filterMinutes = filterCalendarTime calendarMinute filterSeconds :: CalendarTimeConvertible a => [Int] -> [a] -> Schedule a filterSeconds = filterCalendarTime calendarSecond