fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Minor Cron cleanup

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-21 13:03:09 +02:00
parent 0a2b676a42
commit 37644a242f
1 changed files with 27 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/Jobs/Crontab.hs
View File

@ -7,13 +7,12 @@ import Import
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Jobs.Types import Jobs.Types
import Data.Maybe (fromJust)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Semigroup (Max(..)) import Data.Semigroup (Max(..))
import Data.Time.Zones import Data.Time.Zones
import Control.Monad.Trans.Writer (execWriterT) import Control.Monad.Trans.Writer (WriterT, execWriterT)
import Control.Monad.Writer.Class (MonadWriter(..)) import Control.Monad.Writer.Class (MonadWriter(..))
import qualified Data.Conduit.List as C import qualified Data.Conduit.List as C
@ -89,27 +88,30 @@ determineCrontab = execWriterT $ do
, cronNotAfter = Left nominalDay , cronNotAfter = Left nominalDay
} }
sheetSubmissions <- lift $ collateSubmissions <$> runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
selectList [SubmissionRatingBy !=. Nothing, SubmissionSheet ==. nSheet] []
tell $ flip Map.foldMapWithKey sheetSubmissions $ let
\nUser (Max mbTime) -> if correctorNotifications :: Map (UserId, SheetId) (Max UTCTime) -> WriterT (Crontab JobCtl) DB ()
| Just time <- mbTime -> HashMap.singleton correctorNotifications = (tell .) . Map.foldMapWithKey $ \(nUser, nSheet) (Max time) -> HashMap.singleton
(JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } ) (JobCtlQueue $ JobQueueNotification NotificationCorrectionsAssigned { nUser, nSheet } )
Cron Cron
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay time
, cronRepeat = CronRepeatNever , cronRepeat = CronRepeatNever
, cronRateLimit = appNotificationRateLimit , cronRateLimit = appNotificationRateLimit
, cronNotAfter = Left appNotificationExpiration , cronNotAfter = Left appNotificationExpiration
} }
| otherwise -> mempty
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs submissionsByCorrector :: Entity Submission -> Map (UserId, SheetId) (Max UTCTime)
submissionsByCorrector (Entity _ sub)
-- | Partial function: Submission must not have Nothing at ratingBy | Just ratingBy <- submissionRatingBy sub
collateSubmissions :: [Entity Submission] -> Map UserId (Max (Maybe UTCTime)) , Just assigned <- submissionRatingAssigned sub
collateSubmissions = Map.fromListWith (<>) . fmap procCorrector , not $ submissionRatingDone sub
where = Map.singleton (ratingBy, submissionSheet sub) $ Max assigned
procCorrector :: Entity Submission -> (UserId ,Max (Maybe UTCTime)) | otherwise
procCorrector = (,) <$> fromJust . submissionRatingBy . entityVal = Map.empty
<*> Max . submissionRatingAssigned . entityVal
collateSubmissionsByCorrector acc entity = Map.unionWith (<>) acc $ submissionsByCorrector entity
correctorNotifications <=< runConduit $
transPipe lift ( selectSource [ SubmissionRatingBy !=. Nothing, SubmissionRatingAssigned !=. Nothing ] []
)
.| C.fold collateSubmissionsByCorrector Map.empty