module Saturn.Unstable.Match where

import qualified Control.Monad as Monad
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Time as Time
import qualified Saturn.Unstable.Extra.Int as Int
import qualified Saturn.Unstable.Extra.Time as Time
import qualified Saturn.Unstable.Type.Day as Day
import qualified Saturn.Unstable.Type.Field as Field
import qualified Saturn.Unstable.Type.Hour as Hour
import qualified Saturn.Unstable.Type.Minute as Minute
import qualified Saturn.Unstable.Type.Month as Month
import qualified Saturn.Unstable.Type.Schedule as Schedule
import qualified Saturn.Unstable.Type.Weekday as Weekday
import qualified Saturn.Unstable.Type.Wildcard as Wildcard

-- | Returns 'True' if the given 'Time.UTCTime' matches the given
-- 'Schedule.Schedule', otherwise returns 'False'.
isMatch :: Time.UTCTime -> Schedule.Schedule -> Bool
isMatch :: UTCTime -> Schedule -> Bool
isMatch UTCTime
utcTime Schedule
schedule = forall a. a -> Maybe a -> a
Maybe.fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
  let time :: TimeOfDay
time = DiffTime -> TimeOfDay
Time.pastMidnight forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
Time.utctDayTime UTCTime
utcTime
  Word8
minute <- Int -> Maybe Word8
Int.toWord8 forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Int
Time.todMin TimeOfDay
time
  forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Minute -> Bool
Minute.isMatch Word8
minute forall a b. (a -> b) -> a -> b
$ Schedule -> Minute
Schedule.minute Schedule
schedule

  Word8
hour <- Int -> Maybe Word8
Int.toWord8 forall a b. (a -> b) -> a -> b
$ TimeOfDay -> Int
Time.todHour TimeOfDay
time
  forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Hour -> Bool
Hour.isMatch Word8
hour forall a b. (a -> b) -> a -> b
$ Schedule -> Hour
Schedule.hour Schedule
schedule

  let date :: Day
date = UTCTime -> Day
Time.utctDay UTCTime
utcTime
  let (Year
_, Int
monthOfYear, Int
dayOfMonth) = Day -> (Year, Int, Int)
Time.toGregorian Day
date
  Word8
month <- Int -> Maybe Word8
Int.toWord8 Int
monthOfYear
  forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Month -> Bool
Month.isMatch Word8
month forall a b. (a -> b) -> a -> b
$ Schedule -> Month
Schedule.month Schedule
schedule

  Word8
day <- Int -> Maybe Word8
Int.toWord8 Int
dayOfMonth
  let dayMatches :: Bool
dayMatches = Word8 -> Day -> Bool
Day.isMatch Word8
day forall a b. (a -> b) -> a -> b
$ Schedule -> Day
Schedule.day Schedule
schedule
  let weekday :: Word8
weekday = DayOfWeek -> Word8
Time.dayOfWeekToWord8 forall a b. (a -> b) -> a -> b
$ Day -> DayOfWeek
Time.dayOfWeek Day
date
  let weekdayMatches :: Bool
weekdayMatches = Word8 -> Weekday -> Bool
Weekday.isMatch Word8
weekday forall a b. (a -> b) -> a -> b
$ Schedule -> Weekday
Schedule.weekday Schedule
schedule
  forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall a b. (a -> b) -> a -> b
$
    if Schedule -> Bool
dayIsWildcard Schedule
schedule Bool -> Bool -> Bool
|| Schedule -> Bool
weekdayIsWildcard Schedule
schedule
      then Bool
dayMatches Bool -> Bool -> Bool
&& Bool
weekdayMatches
      else Bool
dayMatches Bool -> Bool -> Bool
|| Bool
weekdayMatches

  forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

dayIsWildcard :: Schedule.Schedule -> Bool
dayIsWildcard :: Schedule -> Bool
dayIsWildcard = Field -> Bool
Field.isWildcard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Field
Day.toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schedule -> Day
Schedule.day

weekdayIsWildcard :: Schedule.Schedule -> Bool
weekdayIsWildcard :: Schedule -> Bool
weekdayIsWildcard = Field -> Bool
Field.isWildcard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weekday -> Field
Weekday.toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schedule -> Weekday
Schedule.weekday

-- | Looks for the first time after the given 'Time.UTCTime' that matches the
-- given 'Schedule.Schedule'. Returns 'Nothing' if the 'Schedule.Schedule' only
-- matches dates that cannot happen, like February 30th.
nextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime
nextMatch :: UTCTime -> Schedule -> Maybe UTCTime
nextMatch UTCTime
utcTime Schedule
schedule =
  if Schedule -> Bool
dayIsWildcard Schedule
schedule Bool -> Bool -> Bool
|| Schedule -> Bool
weekdayIsWildcard Schedule
schedule
    then UTCTime -> Schedule -> Maybe UTCTime
incompleteNextMatch UTCTime
utcTime Schedule
schedule
    else do
      let wildcard :: Field
wildcard = Either Wildcard (NonEmpty Element) -> Field
Field.fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ () -> Wildcard
Wildcard.fromUnit ()
      Day
day <- Field -> Maybe Day
Day.fromField Field
wildcard
      Weekday
weekday <- Field -> Maybe Weekday
Weekday.fromField Field
wildcard
      forall a. [a] -> Maybe a
Maybe.listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
List.sort forall a b. (a -> b) -> a -> b
$
        forall a. [Maybe a] -> [a]
Maybe.catMaybes
          [ UTCTime -> Schedule -> Maybe UTCTime
incompleteNextMatch UTCTime
utcTime Schedule
schedule {day :: Day
Schedule.day = Day
day},
            UTCTime -> Schedule -> Maybe UTCTime
incompleteNextMatch UTCTime
utcTime Schedule
schedule {weekday :: Weekday
Schedule.weekday = Weekday
weekday}
          ]

incompleteNextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime
incompleteNextMatch :: UTCTime -> Schedule -> Maybe UTCTime
incompleteNextMatch UTCTime
utcTime Schedule
schedule = forall a. [a] -> Maybe a
Maybe.listToMaybe forall a b. (a -> b) -> a -> b
$ do
  let oldDate :: Day
oldDate = UTCTime -> Day
Time.utctDay UTCTime
utcTime
  let (Year
oldYear, Int
_, Int
_) = Day -> (Year, Int, Int)
Time.toGregorian Day
oldDate
  Year
year <- [Year
oldYear .. Year
oldYear forall a. Num a => a -> a -> a
+ Year
8]
  Int
month <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int
Int.fromWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month -> Set Word8
Month.expand forall a b. (a -> b) -> a -> b
$ Schedule -> Month
Schedule.month Schedule
schedule
  Int
day <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int
Int.fromWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Set Word8
Day.expand forall a b. (a -> b) -> a -> b
$ Schedule -> Day
Schedule.day Schedule
schedule
  Day
date <- forall a. Maybe a -> [a]
Maybe.maybeToList forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Maybe Day
Time.fromGregorianValid Year
year Int
month Int
day
  forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall a b. (a -> b) -> a -> b
$ Day
date forall a. Ord a => a -> a -> Bool
>= Day
oldDate
  forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> Set a -> Bool
Set.member (DayOfWeek -> Word8
Time.dayOfWeekToWord8 forall a b. (a -> b) -> a -> b
$ Day -> DayOfWeek
Time.dayOfWeek Day
date)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Weekday -> Set Word8
Weekday.expand
    forall a b. (a -> b) -> a -> b
$ Schedule -> Weekday
Schedule.weekday Schedule
schedule
  Int
hour <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int
Int.fromWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hour -> Set Word8
Hour.expand forall a b. (a -> b) -> a -> b
$ Schedule -> Hour
Schedule.hour Schedule
schedule
  Int
minute <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int
Int.fromWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Minute -> Set Word8
Minute.expand forall a b. (a -> b) -> a -> b
$ Schedule -> Minute
Schedule.minute Schedule
schedule
  DiffTime
time <-
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeOfDay -> DiffTime
Time.sinceMidnight
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
Maybe.maybeToList
      forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> Maybe TimeOfDay
Time.makeTimeOfDayValid Int
hour Int
minute Pico
0
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Day
date forall a. Eq a => a -> a -> Bool
== Day
oldDate) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Alternative f => Bool -> f ()
Monad.guard forall a b. (a -> b) -> a -> b
$ DiffTime
time forall a. Ord a => a -> a -> Bool
> UTCTime -> DiffTime
Time.utctDayTime UTCTime
utcTime
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Time.UTCTime {utctDay :: Day
Time.utctDay = Day
date, utctDayTime :: DiffTime
Time.utctDayTime = DiffTime
time}