Minor Cron cleanup

src/Jobs/Crontab.hs

@@ -2,18 +2,17 @@ module Jobs.Crontab
   ( determineCrontab
   ) where
 
-import Import
+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.Trans.Writer (WriterT, execWriterT)
 import Control.Monad.Writer.Class (MonadWriter(..))
 
 import qualified Data.Conduit.List as C
@@ -88,28 +87,31 @@ determineCrontab = execWriterT $ do
             , 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
-      
+  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