module Jobs.Crontab
  ( determineCrontab
  ) where

import Import 

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

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

import Data.Time.Zones

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

import qualified Data.Conduit.List as C


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

  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
      }

  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
    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