{-# LANGUAGE NoImplicitPrelude
           , RecordWildCards
           , PatternGuards
           , ViewPatterns
           , DeriveFunctor
           , TemplateHaskell
           , NamedFieldPuns
  #-}

module Cron
  ( 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 Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty

import Utils.Lens.TH
import Control.Lens

  
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 set) x = Set.member x $ toNullable set
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 set) = take p . map (bool id (succ . (`mod` fromIntegral p)) m) . Set.toAscList $ toNullable set
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
      | a >  b = 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
      | a >  b = b : merge (a:as) bs

nextCronMatch :: TZ -- ^ Timezone of the `Cron`-Entry
              -> Maybe UTCTime -- ^ Time of last execution of the job
              -> UTCTime -- ^ Current time, used only for `CronCalendar`
              -> Cron
              -> CronNextMatch UTCTime
nextCronMatch tz mPrev now c@Cron{..}
  | isNothing mPrev
  = execRef now False cronInitial
  | isJust mPrev
  , isNothing cronRepeat
  = MatchNone
  | Just prevT <- mPrev
  , Just CronPeriod{..} <- cronRepeat
  = case cronNext of
      CronAsap
        | addUTCTime cronMinInterval prevT <= now
          -> MatchAsap
        | otherwise
          -> MatchAt $ addUTCTime cronMinInterval prevT
      CronNotScheduled
        | CronTimestamp{ cronTimestamp = localTimeToUTCTZ tz -> ts } <- cronNext
        , now <= ts -> MatchAt ts
      cronNext -> execRef (addUTCTime cronMinInterval prevT) True cronNext
  where
    execRef ref wasExecd cronAbsolute = case cronAbsolute of
      CronAsap -> MatchAsap
      CronTimestamp{ cronTimestamp = localTimeToUTCTZ tz -> ts }
        | ref <= ts -> MatchAt ts
        | not wasExecd -> MatchAsap
        | otherwise -> MatchNone
      CronCalendar{..} -> listToMatch $ do
        let CronDate{..} = toCronDate $ utcToLocalTimeTZ tz ref
        cronYear <- genMatch 400 False cdYear cronYear
        cronWeekOfYear <- genMatch 53 True cdWeekOfYear cronWeekOfYear
        cronDayOfYear <- genMatch 366 True cdDayOfYear cronDayOfYear
        cronMonth <- genMatch 12 True cdMonth cronMonth
        cronWeekOfMonth <- genMatch 5 True cdWeekOfMonth cronWeekOfMonth
        cronDayOfMonth <- genMatch 31 True cdDayOfMonth cronDayOfMonth
        cronDayOfWeek <- genMatch 7 True cdDayOfWeek cronDayOfWeek
        cronHour <- genMatch 24 True cdHour cronHour
        cronMinute <- genMatch 60 True cdMinute cronMinute
        cronSecond <- genMatch 60 True cdSecond cronSecond
        guard $ consistentCronDate CronDate{..}
        localDay <- maybeToList $ fromGregorianValid (fromIntegral cronYear) (fromIntegral cronMonth) (fromIntegral cronDayOfMonth)
        let localTimeOfDay = TimeOfDay (fromIntegral cronHour) (fromIntegral cronMinute) (fromIntegral cronSecond)
        return $ localTimeToUTCTZ tz LocalTime{..}
      CronNotScheduled -> MatchNone