module Jobs.Crontab ( determineCrontab ) where import Import import qualified Data.HashMap.Strict as HashMap import Jobs.Types import Data.Maybe (fromJust) import qualified Data.Map as Map import Data.Semigroup (Max(..)) import Data.Time.Zones import Control.Monad.Trans.Writer (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 $ HashMap.singleton JobCtlGenerateHealthReport Cron { cronInitial = CronAsap , cronRepeat = CronRepeatScheduled CronAsap , cronRateLimit = appHealthCheckInterval , cronNotAfter = Right CronNotScheduled } 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 } sheetSubmissions <- lift $ collateSubmissions <$> selectList [SubmissionRatingBy !=. Nothing, SubmissionSheet ==. nSheet] [] tell $ flip Map.foldMapWithKey sheetSubmissions $ \nUser (Max mbTime) -> if | Just time <- mbTime -> HashMap.singleton (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } ) Cron { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time , cronRepeat = CronRepeatNever , cronRateLimit = appNotificationRateLimit , cronNotAfter = Left appNotificationExpiration } | otherwise -> mempty runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs -- | Partial function: Submission must not have Nothing at ratingBy collateSubmissions :: [Entity Submission] -> Map UserId (Max (Maybe UTCTime)) collateSubmissions = Map.fromListWith (<>) . fmap procCorrector where procCorrector :: Entity Submission -> (UserId ,Max (Maybe UTCTime)) procCorrector = (,) <$> fromJust . submissionRatingBy . entityVal <*> Max . submissionRatingAssigned . entityVal