module Cron
  ( evalCronMatch
  , CronNextMatch(..)
  , nextCronMatch
  , module Cron.Types
  ) where

import ClassyPrelude
import Prelude (lcm)
import Cron.Types

import Data.Time
import Data.Time.Calendar.OrdinalDate (toOrdinalDate, fromOrdinalDateValid)
import Data.Time.Calendar.WeekDate (toWeekDate, fromWeekDate, fromWeekDateValid)
import Data.Time.Zones

import Numeric.Natural
import Data.Ratio ((%))

import qualified Data.Set as Set

import Utils.Lens hiding (from, to)

  
data CronDate = CronDate
  { cdYear, cdWeekOfYear, cdDayOfYear
  , cdMonth, cdWeekOfMonth, cdDayOfMonth
  , cdDayOfWeek
  , cdHour, cdMinute, cdSecond :: Natural
  } deriving (Eq, Show, Read)

makeLenses_ ''CronDate


evalCronMatch :: CronMatch -> Natural -> Bool
evalCronMatch CronMatchAny _ = True
evalCronMatch CronMatchNone _ = False
evalCronMatch (CronMatchSome xs) x = Set.member x $ toNullable xs
evalCronMatch (CronMatchStep step) x = (x `mod` step) == 0
evalCronMatch (CronMatchContiguous from to) x = from <= x && x <= to
evalCronMatch (CronMatchIntersect a b) x = evalCronMatch a x && evalCronMatch b x
evalCronMatch (CronMatchUnion a b) x = evalCronMatch a x || evalCronMatch b x

toCronDate :: LocalTime -> CronDate
toCronDate LocalTime{..} = CronDate{..}
  where
    (fromInteger -> cdYear, fromIntegral -> cdMonth, fromIntegral -> cdDayOfMonth)
      = toGregorian localDay
    (_, fromIntegral -> cdDayOfYear)
      = toOrdinalDate localDay
    (_, fromIntegral -> cdWeekOfYear, fromIntegral -> cdDayOfWeek)
      = toWeekDate localDay
    cdWeekOfMonth = go 1 localDay
      where
        go :: Natural -> Day -> Natural
        go n day
          | dow /= 4  = go n $ fromWeekDate y w 4 -- According to ISO week of month is determined by Thursday
          | m == m'   = go (succ n) day'
          | otherwise = n
          where
            (y, w, dow) = toWeekDate day
            day'
              | w /= 0 = fromWeekDate y (pred w) dow
              | otherwise = fromWeekDate (pred y) 53 dow
            (_, m, _) = toGregorian day
            (_, m', _) = toGregorian day'
    TimeOfDay
      { todHour = fromIntegral -> cdHour
      , todMin = fromIntegral -> cdMinute
      , todSec = round -> cdSecond
      } = localTimeOfDay

consistentCronDate :: CronDate -> Bool
consistentCronDate cd@CronDate{ cdWeekOfMonth = _, ..} = fromMaybe False $ do
  gDay <- fromGregorianValid (fromIntegral cdYear) (fromIntegral cdMonth) (fromIntegral cdDayOfMonth)
  wDay <- fromWeekDateValid (fromIntegral cdYear) (fromIntegral cdWeekOfYear) (fromIntegral cdDayOfWeek)
  guard $ gDay == wDay
  oDay <- fromOrdinalDateValid (fromIntegral cdYear) (fromIntegral cdDayOfYear)
  guard $ wDay == oDay
  guard $ ((==) `on` cdWeekOfMonth) cd (toCronDate $ LocalTime wDay (error "TimeOfDay inspected in toCronDate"))
  return True


data CronNextMatch a = MatchAsap | MatchAt a | MatchNone
  deriving (Eq, Ord, Show, Read, Functor)

instance Applicative CronNextMatch where
  pure = MatchAt
  _ <*> MatchNone = MatchNone
  MatchNone <*> _ = MatchNone
  _ <*> MatchAsap = MatchAsap
  MatchAsap <*> _ = MatchAsap
  MatchAt f <*> MatchAt x = MatchAt $ f x

instance Alternative CronNextMatch where
  empty = MatchNone
  x <|> MatchNone = x
  MatchNone <|> x = x
  _ <|> MatchAsap = MatchAsap
  MatchAsap <|> _ = MatchAsap
  (MatchAt a) <|> (MatchAt _) = MatchAt a
  

listToMatch :: [a] -> CronNextMatch a
listToMatch [] = MatchNone
listToMatch (t:_) = MatchAt t

genMatch :: Int -- ^ Period
         -> Bool -- ^ Modular
         -> Natural -- ^ Start value
         -> CronMatch
         -> [Natural]
genMatch p m st CronMatchAny = take p $ map (bool id (succ . (`mod` fromIntegral p)) m) [st..]
genMatch _ _ _ CronMatchNone = []
genMatch p m _ (CronMatchSome xs) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) . Set.toAscList $ toNullable xs
genMatch p m st (CronMatchStep step) = do
  start <- [st..st + step]
  guard $ (start `mod` step) == 0
  take (ceiling $ fromIntegral p % step) $ map (bool id (succ . (`mod` fromIntegral p)) m) [start,start + step..]
genMatch p m st (CronMatchContiguous from to) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) $ [max st from..to]
genMatch _ _ _ (CronMatchIntersect CronMatchNone _) = []
genMatch _ _ _ (CronMatchIntersect _ CronMatchNone) = []
genMatch p m st (CronMatchIntersect CronMatchAny other) = genMatch p m st other
genMatch p m st (CronMatchIntersect other CronMatchAny) = genMatch p m st other
genMatch p m st (CronMatchIntersect (CronMatchStep st1) (CronMatchStep st2))
  = genMatch p m st . CronMatchStep $ lcm st1 st2
genMatch p m st (CronMatchIntersect aGen bGen)
  | [] <- as' = []
  | (a:as) <- as' = mergeAnd (a:as) (genMatch p m a bGen)
  where
    as' = genMatch p m st aGen
    mergeAnd [] _ = []
    mergeAnd _ [] = []
    mergeAnd (a:as) (b:bs)
      | a <  b    = mergeAnd as (b:bs)
      | a == b    = a : mergeAnd as bs
      | otherwise = mergeAnd (a:as) bs
genMatch p m st (CronMatchUnion CronMatchNone other) = genMatch p m st other
genMatch p m st (CronMatchUnion other CronMatchNone) = genMatch p m st other
genMatch p m st (CronMatchUnion CronMatchAny _) = genMatch p m st CronMatchAny
genMatch p m st (CronMatchUnion _ CronMatchAny) = genMatch p m st CronMatchAny
genMatch p m st (CronMatchUnion aGen bGen) = merge (genMatch p m st aGen) (genMatch p m st bGen)
  where
    merge [] bs = bs
    merge as [] = as
    merge (a:as) (b:bs)
      | a <  b    = a : merge as (b:bs)
      | a == b    = a : merge as bs
      | otherwise = b : merge (a:as) bs

nextCronMatch :: TZ -- ^ Timezone of the `Cron`-Entry
              -> Maybe UTCTime -- ^ Time of last execution of the job
              -> NominalDiffTime -- ^ Scheduling precision
              -> UTCTime -- ^ Current time, used only for `CronCalendar`
              -> Cron
              -> CronNextMatch UTCTime
nextCronMatch tz mPrev prec now c@Cron{..} = case notAfter of
  MatchAsap -> MatchNone
  MatchAt ts
    | MatchAt ts' <- nextMatch
    , ts' <= ts -> MatchAt ts'
    | MatchAsap <- nextMatch
    , now <= ts -> MatchAsap
    | otherwise -> MatchNone
  MatchNone -> nextMatch
  where
    notAfter
      | Right c' <- cronNotAfter
      , Just ref <- notAfterRef
      = execRef' ref False c'
      | Left diff <- cronNotAfter
      , Just ref <- notAfterRef
      = MatchAt $ diff `addUTCTime` ref
      | otherwise = MatchNone
    notAfterRef
      | Just prevT <- mPrev = Just prevT
      | otherwise = case execRef' now False cronInitial of
          MatchAsap -> error "execRef' should not return MatchAsap"
          MatchAt t -> Just t
          MatchNone -> Nothing
    nextMatch = case mPrev of
      Nothing
        -> execRef now False cronInitial
      Just prevT
        -> case cronRepeat of
            CronRepeatOnChange
              | not $ matchesCron tz Nothing prec prevT c
                -> let
                     cutoffTime = addUTCTime cronRateLimit prevT
                   in case execRef now False cronInitial of
                        MatchAsap
                          | now < cutoffTime -> MatchAt cutoffTime
                        MatchAt ts 
                          | ts < cutoffTime -> MatchAt cutoffTime
                        other -> other
            CronRepeatScheduled cronNext
              -> case cronNext of
                   CronAsap
                     | addUTCTime cronRateLimit prevT <= now
                       -> MatchAsap
                     | otherwise
                       -> MatchAt $ addUTCTime cronRateLimit prevT
                   _other
                     -> execRef (addUTCTime cronRateLimit prevT) True cronNext
            _other -> MatchNone

    execRef ref wasExecd cronAbsolute = case execRef' ref wasExecd cronAbsolute of
      MatchAt t
        | t <= ref -> MatchAsap
      other -> other

    execRef' ref wasExecd cronAbsolute = case cronAbsolute of
      CronAsap -> MatchAt ref
      CronTimestamp{ cronTimestamp = localTimeToUTCTZ tz -> ts }
        | ref <= ts || not wasExecd -> MatchAt ts
        | otherwise -> MatchNone
      CronCalendar{..} -> listToMatch $ do
        let CronDate{..} = toCronDate $ utcToLocalTimeTZ tz ref

        mCronYear <- genMatch 400 False cdYear cronYear
        mCronWeekOfYear <- genMatch 53 True cdWeekOfYear cronWeekOfYear
        mCronDayOfYear <- genMatch 366 True cdDayOfYear cronDayOfYear
        mCronMonth <- genMatch 12 True cdMonth cronMonth
        mCronWeekOfMonth <- genMatch 5 True cdWeekOfMonth cronWeekOfMonth
        mCronDayOfMonth <- genMatch 31 True cdDayOfMonth cronDayOfMonth
        mCronDayOfWeek <- genMatch 7 True cdDayOfWeek cronDayOfWeek
        mCronHour <- genMatch 24 True cdHour cronHour
        mCronMinute <- genMatch 60 True cdMinute cronMinute
        mCronSecond <- genMatch 60 True cdSecond cronSecond
        guard $ consistentCronDate CronDate
          { cdYear = mCronYear, cdMonth = mCronMonth, cdDayOfMonth = mCronDayOfMonth
          , cdHour = mCronHour, cdMinute = mCronMinute, cdSecond = mCronSecond
          , cdWeekOfYear = mCronWeekOfYear, cdWeekOfMonth = mCronWeekOfMonth
          , cdDayOfYear = mCronDayOfYear, cdDayOfWeek = mCronDayOfWeek
          }

        localDay <- maybeToList $ fromGregorianValid (fromIntegral mCronYear) (fromIntegral mCronMonth) (fromIntegral mCronDayOfMonth)
        let localTimeOfDay = TimeOfDay (fromIntegral mCronHour) (fromIntegral mCronMinute) (fromIntegral mCronSecond)
        return $ localTimeToUTCTZ tz LocalTime{..}
      CronNotScheduled -> MatchNone

matchesCron :: TZ -- ^ Timezone of the `Cron`-Entry
            -> Maybe UTCTime -- ^ Previous execution of the job
            -> NominalDiffTime -- ^ Scheduling precision
            -> UTCTime -- ^ "Current" time
            -> Cron
            -> Bool
-- ^ @matchesCron tz prev prec now c@ determines whether the given `Cron`
--   specification @c@ should match @now@, under the assumption that the next
--   check will occur no earlier than @now + prec@.
matchesCron tz mPrev prec now cron = case nextCronMatch tz mPrev prec now cron of
  MatchAsap -> True
  MatchNone -> False
  MatchAt ts -> ts <= addUTCTime prec now