Match.hs

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 = Maybe.fromMaybe False $ do
  let time = Time.pastMidnight $ Time.utctDayTime utcTime
  minute <- Int.toWord8 $ Time.todMin time
  Monad.guard . Minute.isMatch minute $ Schedule.minute schedule

  hour <- Int.toWord8 $ Time.todHour time
  Monad.guard . Hour.isMatch hour $ Schedule.hour schedule

  let date = Time.utctDay utcTime
  let (_, monthOfYear, dayOfMonth) = Time.toGregorian date
  month <- Int.toWord8 monthOfYear
  Monad.guard . Month.isMatch month $ Schedule.month schedule

  day <- Int.toWord8 dayOfMonth
  let dayMatches = Day.isMatch day $ Schedule.day schedule
  let weekday = Time.dayOfWeekToWord8 $ Time.dayOfWeek date
  let weekdayMatches = Weekday.isMatch weekday $ Schedule.weekday schedule
  Monad.guard $
    if dayIsWildcard schedule || weekdayIsWildcard schedule
      then dayMatches && weekdayMatches
      else dayMatches || weekdayMatches

  pure True

dayIsWildcard :: Schedule.Schedule -> Bool
dayIsWildcard = Field.isWildcard . Day.toField . Schedule.day

weekdayIsWildcard :: Schedule.Schedule -> Bool
weekdayIsWildcard = Field.isWildcard . Weekday.toField . 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 =
  if dayIsWildcard schedule || weekdayIsWildcard schedule
    then incompleteNextMatch utcTime schedule
    else do
      let wildcard = Field.fromEither . Left $ Wildcard.fromUnit ()
      day <- Day.fromField wildcard
      weekday <- Weekday.fromField wildcard
      Maybe.listToMaybe . List.sort $
        Maybe.catMaybes
          [ incompleteNextMatch utcTime schedule {Schedule.day = day},
            incompleteNextMatch utcTime schedule {Schedule.weekday = weekday}
          ]

incompleteNextMatch :: Time.UTCTime -> Schedule.Schedule -> Maybe Time.UTCTime
incompleteNextMatch utcTime schedule = Maybe.listToMaybe $ do
  let oldDate = Time.utctDay utcTime
  let (oldYear, _, _) = Time.toGregorian oldDate
  year <- [oldYear .. oldYear + 8]
  month <- fmap Int.fromWord8 . Set.toAscList . Month.expand $ Schedule.month schedule
  day <- fmap Int.fromWord8 . Set.toAscList . Day.expand $ Schedule.day schedule
  date <- Maybe.maybeToList $ Time.fromGregorianValid year month day
  Monad.guard $ date >= oldDate
  Monad.guard
    . Set.member (Time.dayOfWeekToWord8 $ Time.dayOfWeek date)
    . Weekday.expand
    $ Schedule.weekday schedule
  hour <- fmap Int.fromWord8 . Set.toAscList . Hour.expand $ Schedule.hour schedule
  minute <- fmap Int.fromWord8 . Set.toAscList . Minute.expand $ Schedule.minute schedule
  time <-
    fmap Time.sinceMidnight
      . Maybe.maybeToList
      $ Time.makeTimeOfDayValid hour minute 0
  Monad.when (date == oldDate) . Monad.guard $ time > Time.utctDayTime utcTime
  pure Time.UTCTime {Time.utctDay = date, Time.utctDayTime = time}