64 lines
1.9 KiB
Haskell
64 lines
1.9 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude
|
|
, RecordWildCards
|
|
, FlexibleContexts
|
|
#-}
|
|
|
|
module Jobs.Crontab
|
|
( determineCrontab
|
|
) where
|
|
|
|
import Import
|
|
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Jobs.Types
|
|
|
|
import Data.Time
|
|
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
|
|
}
|
|
Nothing -> return ()
|
|
|
|
tell $ HashMap.singleton
|
|
JobCtlDetermineCrontab
|
|
Cron
|
|
{ cronInitial = CronAsap
|
|
, cronRepeat = CronRepeatScheduled CronAsap
|
|
, cronRateLimit = appJobCronInterval
|
|
}
|
|
|
|
let
|
|
sheetJobs (Entity nSheet Sheet{..}) = do
|
|
tell $ HashMap.singleton
|
|
(JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
|
|
Cron
|
|
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveFrom
|
|
, cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
|
|
, cronRateLimit = appNotificationRateLimit
|
|
}
|
|
tell $ HashMap.singleton
|
|
(JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
|
|
Cron
|
|
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo
|
|
, cronRepeat = CronRepeatOnChange
|
|
, cronRateLimit = appNotificationRateLimit
|
|
}
|
|
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
|