module Jobs.Crontab
  ( determineCrontab
  ) where

import Import 

import qualified Data.HashMap.Strict as HashMap
import Jobs.Types

import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Semigroup (Max(..))

import Data.Time.Zones
import Data.Time.Clock.POSIX

import Handler.Utils.DateTime
import Handler.Utils.Allocation (allocationDone)

import Control.Monad.Trans.Writer (WriterT, execWriterT)
import Control.Monad.Writer.Class (MonadWriter(..))

import qualified Data.Conduit.List as C

import qualified Database.Esqueleto as E


determineCrontab :: DB (Crontab JobCtl)
-- ^ Extract all future jobs from the database (sheet deadlines, ...)
determineCrontab = execWriterT $ do
  UniWorX{ appSettings' = AppSettings{..}, .. } <- getYesod

  case appJobFlushInterval of
    Just interval -> tell $ HashMap.singleton
      JobCtlFlush
      Cron
        { cronInitial = CronAsap
        , cronRepeat = CronRepeatScheduled CronAsap
        , cronRateLimit = interval
        , cronNotAfter = Right CronNotScheduled
        }
    Nothing -> return ()

  tell $ HashMap.singleton
    JobCtlDetermineCrontab
    Cron
      { cronInitial = CronAsap
      , cronRepeat = CronRepeatScheduled CronAsap
      , cronRateLimit = appJobCronInterval
      , cronNotAfter = Right CronNotScheduled
      }
  
  oldestInvitationMUTC <- lift $ preview (_head . _entityVal . _invitationExpiresAt . _Just) <$> selectList [InvitationExpiresAt !=. Nothing] [Asc InvitationExpiresAt, LimitTo 1]
  whenIsJust oldestInvitationMUTC $ \oldestInvUTC -> tell $ HashMap.singleton
    (JobCtlQueue JobPruneInvitations)
    Cron
      { cronInitial   = CronTimestamp $ utcToLocalTime oldestInvUTC
      , cronRepeat    = CronRepeatOnChange
      , cronRateLimit = nominalDay
      , cronNotAfter  = Right CronNotScheduled
      }

  tell . flip foldMap universeF $ \kind -> 
    case appHealthCheckInterval kind of
      Just int -> HashMap.singleton
        (JobCtlGenerateHealthReport kind)
        Cron
          { cronInitial = CronAsap
          , cronRepeat = CronRepeatScheduled CronAsap
          , cronRateLimit = int
          , cronNotAfter = Right CronNotScheduled
          }
      Nothing  -> mempty

  let newyear = cronCalendarAny
        { cronDayOfYear  = cronMatchOne 1
        }
   in tell $ HashMap.singleton
        (JobCtlQueue JobTruncateTransactionLog)
        Cron
          { cronInitial = newyear
          , cronRepeat = CronRepeatScheduled newyear
          , cronRateLimit = minNominalYear
          , cronNotAfter = Right CronNotScheduled
          }

  oldestLogEntry <- fmap listToMaybe . lift . E.select . E.from $ \transactionLog -> do
    E.where_ . E.not_ . E.isNothing $ transactionLog E.^. TransactionLogRemote
    E.orderBy [E.asc $ transactionLog E.^. TransactionLogTime]
    E.limit 1
    return $ transactionLog E.^. TransactionLogTime
  for_ oldestLogEntry $ \(E.Value oldestEntry) ->
    tell $ HashMap.singleton
      (JobCtlQueue JobDeleteTransactionLogIPs)
      Cron
        { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appTransactionLogIPRetentionTime oldestEntry
        , cronRepeat    = CronRepeatOnChange
        , cronRateLimit = nominalDay
        , cronNotAfter  = Right CronNotScheduled
        }


  if
    | is _Just appLdapConf
    , is _Just appLdapConf
    , Just syncWithin <- appSynchroniseLdapUsersWithin
      -> do
        now <- liftIO getPOSIXTime
        let
          epochInterval = syncWithin / 2
          interval = appSynchroniseLdapUsersInterval
          
          (ldapEpoch, epochNow) = now `divMod'` epochInterval
          ldapInterval = epochNow `div'` interval
          numIntervals = floor $ epochInterval / interval

          nextIntervals = do
            let
              n = ceiling $ 4 * appJobCronInterval / appSynchroniseLdapUsersInterval
            i <- [negate (ceiling $ n % 2) .. ceiling $ n % 2]
            let
              ((+ ldapEpoch) -> nextEpoch, nextInterval) = (ldapInterval + i) `divMod` numIntervals
              nextIntervalTime
                = posixSecondsToUTCTime $ fromInteger nextEpoch * epochInterval + fromInteger nextInterval * interval
            return (nextEpoch, nextInterval, nextIntervalTime)

        forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime) -> do
          $logDebugS "SynchroniseLdap" [st|currentTime: #{tshow ldapEpoch}.#{tshow epochNow}; upcomingSync: #{tshow nextEpoch}.#{tshow (fromInteger nextInterval * interval)}; upcomingData: #{tshow (numIntervals, nextEpoch, nextInterval)}|]
          tell $ HashMap.singleton
            (JobCtlQueue JobSynchroniseLdap
               { jEpoch         = fromInteger nextEpoch
               , jNumIterations = fromInteger numIntervals
               , jIteration     = fromInteger nextInterval
               })
            Cron
              { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ nextIntervalTime
              , cronRepeat    = CronRepeatNever
              , cronRateLimit = appSynchroniseLdapUsersInterval
              , cronNotAfter  = Left syncWithin
              }
    | otherwise
      -> return ()
    

  let
    sheetJobs (Entity nSheet Sheet{..}) = do
      tell $ HashMap.singleton
        (JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
        Cron
          { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveFrom
          , cronRepeat = CronRepeatNever
          , cronRateLimit = appNotificationRateLimit
          , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
          }
      tell $ HashMap.singleton
        (JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})
        Cron
          { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo
          , cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
          , cronRateLimit = appNotificationRateLimit
          , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
          }
      tell $ HashMap.singleton
        (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
        Cron
          { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
          , cronRepeat    = CronRepeatOnChange
          , cronRateLimit = appNotificationRateLimit
          , cronNotAfter  = Left appNotificationExpiration
          }             
      when sheetAutoDistribute $
        tell $ HashMap.singleton
          (JobCtlQueue $ JobDistributeCorrections nSheet)
          Cron
            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
            , cronRepeat    = CronRepeatNever
            , cronRateLimit = 3600 -- Irrelevant due to `cronRepeat`
            , cronNotAfter  = Left nominalDay
            }

  runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs

  let
    correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) DB ()
    correctorNotifications = (tell .) . Map.foldMapWithKey $ \(nUser, nSheet) (Max time) -> HashMap.singleton
      (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } )
      Cron 
        { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time
        , cronRepeat    = CronRepeatNever
        , cronRateLimit = appNotificationRateLimit
        , cronNotAfter  = Left appNotificationExpiration
        }
    
    submissionsByCorrector :: Entity Submission -> Map (UserId, SheetId) (Max UTCTime)
    submissionsByCorrector (Entity _ sub)
      | Just ratingBy <- submissionRatingBy sub
      , Just assigned <- submissionRatingAssigned sub
      , not $ submissionRatingDone sub
      = Map.singleton (ratingBy, submissionSheet sub) $ Max assigned
      | otherwise
      = Map.empty

    collateSubmissionsByCorrector acc entity = Map.unionWith (<>) acc $ submissionsByCorrector entity
  correctorNotifications <=< runConduit $
       transPipe lift ( selectSource [ SubmissionRatingBy !=. Nothing, SubmissionRatingAssigned !=. Nothing ] []
                      )
    .| C.fold collateSubmissionsByCorrector Map.empty

  
  let
    examJobs (Entity nExam Exam{..}) = do
      newestResult <- lift . E.select . E.from $ \examResult -> do
        E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
        return . E.max_ $ examResult E.^. ExamResultLastChanged

      whenIsJust examVisibleFrom $ \visibleFrom -> do
        case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of
          [E.Value (NTop (Just ts))] -> 
            tell $ HashMap.singleton
              (JobCtlQueue $ JobQueueNotification NotificationExamResult{..})
              Cron
                { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts
                , cronRepeat = CronRepeatOnChange
                , cronRateLimit = appNotificationRateLimit
                , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationExpiration $ max visibleFrom ts
                }
          _other -> return ()

        whenIsJust examRegisterFrom $ \registerFrom ->
          tell $ HashMap.singleton
            (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationActive{..})
            Cron
              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom
              , cronRepeat    = CronRepeatOnChange
              , cronRateLimit = appNotificationRateLimit
              , cronNotAfter  = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) examRegisterTo
              }
        whenIsJust ((,) <$> examRegisterFrom <*> examRegisterTo) $ \(registerFrom, registerTo) ->
          tell $ HashMap.singleton
            (JobCtlQueue $ JobQueueNotification NotificationExamRegistrationSoonInactive{..})
            Cron
              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) registerTo
              , cronRepeat    = CronRepeatOnChange
              , cronRateLimit = appNotificationRateLimit
              , cronNotAfter  = Right . CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
              }
        whenIsJust ((,) <$> examRegisterFrom <*> examDeregisterUntil) $ \(registerFrom, deregisterUntil) ->
          tell $ HashMap.singleton
            (JobCtlQueue $ JobQueueNotification NotificationExamDeregistrationSoonInactive{..})
            Cron
              { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) deregisterUntil
              , cronRepeat    = CronRepeatOnChange
              , cronRateLimit = appNotificationRateLimit
              , cronNotAfter  = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil
              }

      case examClosed of
        Just close -> do
          changedResults <- lift . E.select . E.from $ \examResult -> do
            E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
                 E.&&. examResult E.^. ExamResultLastChanged E.>. E.val close
            return $ examResult E.^. ExamResultId

          case newestResult of
            [E.Value (Just lastChange)]
              | not $ null changedResults
                -> tell $ HashMap.singleton
                     (JobCtlQueue $ JobQueueNotification NotificationExamOfficeExamResultsChanged{ nExamResults = Set.fromList $ map E.unValue changedResults })
                     Cron
                       { cronInitial = CronTimestamp  . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastChange
                       , cronRepeat = CronRepeatNever
                       , cronRateLimit = appNotificationRateLimit
                       , cronNotAfter = Left appNotificationExpiration
                       }
            _other -> return ()

          tell $ HashMap.singleton
            (JobCtlQueue $ JobQueueNotification NotificationExamOfficeExamResults{..})
            Cron
              { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ close
              , cronRepeat = CronRepeatNever
              , cronRateLimit = appNotificationRateLimit
              , cronNotAfter = Left appNotificationExpiration
              }
        Nothing -> return ()
  
  runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs

  let
    allocationJobs (Entity nAllocation Allocation{..}) = do
      whenIsJust allocationStaffRegisterFrom $ \staffRegisterFrom ->
        tell $ HashMap.singleton
          (JobCtlQueue $ JobQueueNotification NotificationAllocationStaffRegister{..})
          Cron
            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ staffRegisterFrom
            , cronRepeat    = CronRepeatOnChange
            , cronRateLimit = appNotificationRateLimit
            , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffRegisterTo
            }
      whenIsJust allocationRegisterFrom $ \registerFrom ->
        tell $ HashMap.singleton
          (JobCtlQueue $ JobQueueNotification NotificationAllocationRegister{..})
          Cron
            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerFrom
            , cronRepeat    = CronRepeatOnChange
            , cronRateLimit = appNotificationRateLimit
            , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationRegisterTo
            }
      whenIsJust allocationStaffAllocationFrom $ \allocationFrom ->
        tell $ HashMap.singleton
          (JobCtlQueue $ JobQueueNotification NotificationAllocationAllocation{..})
          Cron
            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ allocationFrom
            , cronRepeat    = CronRepeatOnChange
            , cronRateLimit = appNotificationRateLimit
            , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
            }
      case allocationRegisterTo of
        Just registerTo
          | maybe True (> registerTo) allocationStaffAllocationTo
            -> do
              tell $ HashMap.singleton
                (JobCtlQueue $ JobQueueNotification NotificationAllocationUnratedApplications{..})
                Cron
                  { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
                  , cronRepeat    = CronRepeatOnChange
                  , cronRateLimit = appNotificationRateLimit
                  , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
                  }
              tell $ HashMap.singleton
                (JobCtlQueue $ JobQueueNotification NotificationAllocationOutdatedRatings{..})
                Cron
                  { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
                  , cronRepeat    = CronRepeatOnChange
                  , cronRateLimit = appNotificationRateLimit
                  , cronNotAfter  = maybe (Right CronNotScheduled) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) allocationStaffAllocationTo
                  }
        _other
          -> return ()
      doneSince <- lift $ allocationDone nAllocation

      whenIsJust doneSince $ \doneSince' ->
        tell $ HashMap.singleton
          (JobCtlQueue $ JobQueueNotification NotificationAllocationResults{..})
          Cron
            { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
            , cronRepeat    = CronRepeatOnChange
            , cronRateLimit = appNotificationRateLimit
            , cronNotAfter  = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
            }

  runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs