chore(daily): add function to retrieve all exam occurrences for given days

the function uses the memcachedByClass mechanism, which was slightly refined as well to include the class within the memcached keys for added correctness

models/exams.model

@@ -47,7 +47,7 @@ ExamOccurrence
   end         UTCTime Maybe  
   description StoredMarkup Maybe  
   UniqueExamOccurrence exam name
-  deriving Generic
+  deriving Show Generic Binary
 ExamRegistration
   exam ExamId
   user UserId

src/Handler/Exam/Edit.hs

@@ -152,6 +152,7 @@ postEEditR tid ssh csh examn = do
         deleteWhere [ ExamCorrectorExam ==. eId ]
         insertMany_ $ map (ExamCorrector eId) adds
         memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId)
+        memcachedInvalidateClass MemcachedKeyClassExamOccurrences
 
         deleteWhere [ InvitationFor ==. invRef @ExamCorrector eId, InvitationEmail /<-. invites ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, eId, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites

src/Handler/Exam/New.hs

@@ -93,6 +93,7 @@ postCExamNewR tid ssh csh = do
                     ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
         memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId)
+        memcachedInvalidateClass MemcachedKeyClassExamOccurrences
 
         let recordNoShow (Entity _ CourseParticipant{..}) = do
               didRecord <- is _Just <$> insertUnique ExamResult

src/Handler/School/DayTasks.hs

@@ -74,7 +74,8 @@ getDayTutorials ssh d = E.unValue <<$>> E.select (do
 
 -- Datatype to be used as key for memcaching DayTask related stuff; note that newtype-CacheKeys are optimized away, so multiple constructors are advisable
 data DailyCacheKeys
-  = CacheKeyTutorialOccurrences  SchoolId (Day,Day)
+  = CacheKeyTutorialOccurrences  SchoolId (Day,Day)   -- ^ Map TutorialId (TutorialName, [LessonTime])
+  | CacheKeyExamOccurrences      SchoolId (Day,Day)   -- ^ Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence)
   | CacheKeySuggsParticipantNote SchoolId TutorialId
   | CacheKeySuggsAttendanceNote  SchoolId TutorialId
   | CacheKeyTutorialCheckResults SchoolId Day
@@ -139,6 +140,28 @@ getDayTutorials' ssh dlimit@(dstart, dend )
     lessonFltr LessonTime{..} = dstart <= localDay lessonStart
                             &&  dend   >= localDay lessonEnd
 
+-- | retrieve all exam occurrences for a school in a given time period; uses caching
+getDayExamOccurrences :: SchoolId -> (Day,Day) -> DB (Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence))
+getDayExamOccurrences ssh dlimit@(dstart, dend )
+  | dstart > dend = return mempty
+  | otherwise = memcachedByClass MemcachedKeyClassExamOccurrences (Just . Right $ 12 * diffDay) (CacheKeyExamOccurrences ssh dlimit) $ do
+    candidates <- E.select $ do
+      (trm :& crs :& exm :& occ) <- E.from $ E.table @Term
+          `E.innerJoin` E.table @Course          `E.on` (\(trm :& crs)             -> crs E.^. CourseTerm E.==. trm E.^. TermId)
+          `E.innerJoin` E.table @Exam            `E.on` (\(_ :& crs :& exm)        -> crs E.^. CourseId   E.==. exm E.^. ExamCourse)
+          `E.innerJoin` E.table @ExamOccurrence  `E.on` (\(_ :& _   :& exm :& occ) -> exm E.^. ExamId     E.==. occ E.^. ExamOccurrenceExam)
+      E.where_ $ E.val     ssh    E.==. crs E.^. CourseSchool
+        E.&&.    E.val     dstart E.<=. trm E.^. TermEnd
+        E.&&.    E.val     dend   E.>=. trm E.^. TermStart
+        E.&&. ( E.between (E.day      $ occ E.^. ExamOccurrenceStart) (E.val     dstart, E.val     dend)
+          E.||. E.between (E.dayMaybe $ occ E.^. ExamOccurrenceEnd)   (E.justVal dstart, E.justVal dend)
+          )
+      return (exm, occ)
+    return $ foldMap mkOccMap candidates
+  where
+    mkOccMap :: (Entity Exam, Entity ExamOccurrence) -> Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence)
+    mkOccMap (entityVal -> exm, Entity{..}) = Map.singleton entityKey (exm ^. _examCourse, exm ^. _examName, entityVal)
+
 
 type DailyTableExpr =
   (                     E.SqlExpr (Entity Course)

src/Handler/Utils/Memcached.hs

@@ -364,10 +364,11 @@ memcachedByClass :: forall a m k.
                , Binary k
                )
             => MemcachedKeyClass -> Maybe Expiry -> k -> m a -> m a
-memcachedByClass mkc mExp k = memcachedWith (memcachedByGet k, setAndAddClass)
+memcachedByClass mkc mExp k = memcachedWith (memcachedByGet ck, setAndAddClass)
   where
+    ck = (mkc, k)
     setAndAddClass v = do
-      mbKey <- memcachedBySet' mExp k v
+      mbKey <- memcachedBySet' mExp ck v
       whenIsJust mbKey $ \vKey -> do
         cl <- maybeMonoid <$> memcachedByGet mkc
         memcachedBySet Nothing mkc $ MemcachedKeyClassStore $ Set.insert vKey $ unMemcachedKeyClassStore cl