fix(allocations): fix result notifications

messages/uniworx/de.msg

@@ -1924,11 +1924,17 @@ CourseDeregistrationAllocationShouldLog: Selbstverschuldet
 CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
 
 MailSubjectAllocationResults allocation@AllocationName: Plätze für Zentralanmeldung „#{allocation}“ wurden verteilt
-AllocationResultsLecturer: Es wurden Plätze zugewiesen, wie folgt:
+AllocationResultsLecturer: Im Rahmen der oben genannten Zentralanmeldung wurden Plätze zugewiesen, wie folgt:
-AllocationResultLecturer csh@CourseShorthand count@Int64: #{count} Teilnehmer für #{csh}
+AllocationResultLecturer csh@CourseShorthand count@Int64 count2@Int64: #{count} Teilnehmer (von insgesamt #{count2}) für #{csh}
+AllocationResultLecturerAll csh@CourseShorthand count@Int64: #{count} Teilnehmer für #{csh}
+AllocationResultLecturerNone csh@CourseShorthand: Keine Teilnehmer für #{csh}
 AllocationResultsStudent: Sie haben Plätze erhalten in:
 AllocationNoResultsStudent: Sie haben leider keine Plätze erhalten.
 AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten.
+AllocationResultsTip: Die folgenden Informationen entsprechen dem aktuellen Stand der Zentralanmeldung und können sich, z.B. durch die Verteilung von Plätzen an Nachrücker, noch ändern. Über zukünftige Änderungen, die Sie betreffen, werden Sie gesondert informiert.
+AllocationResultsStudentTip: Unten aufgeführt sind alle Plätze, die Sie im Rahmen der genannten Zentralanmeldung erhalten haben und von denen Sie seit dem weder abgemeldet wurden, noch sich selbst abgemeldet haben. Plätze, über die Sie ggf. bereits informiert wurden, können also erneut aufgeführt sein.
+AllocationResultStudentRegistrationTip: Sie sind zu oben genanntem Kurs in Uni2work angemeldet.
+AllocationResultsStudentRegistrationTip: Sie sind zu den oben genannten Kursen in Uni2work angemeldet.
 
 FavouriteVisited: Kürzlich besucht
 FavouriteParticipant: Ihre Kurse

src/Handler/Utils/Allocation.hs

@@ -58,8 +58,12 @@ sinkAllocationPriorities allocId = C.mapM_ . imapM_ $ \matr prio ->
 
   
 computeAllocation :: AllocationId
-                  -> DB (AllocationFingerprint, Set (UserId, CourseId), Seq (MatchingLog UserId CourseId Natural))
+                  -> Maybe (Set CourseId) -- ^ Optionally restrict allocation to only consider the given courses
-computeAllocation allocId = do
+                  -> DB ( AllocationFingerprint
+                        , Set (UserId, CourseId)
+                        , Seq (MatchingLog UserId CourseId Natural)
+                        )
+computeAllocation allocId cRestr = do
   allocations <- selectList [ CourseParticipantAllocated ==. Just allocId ] []
   let allocations' = allocations
         & map ((, Sum 1) . courseParticipantUser . entityVal)
@@ -94,6 +98,9 @@ computeAllocation allocId = do
                  E.&&. lecturer E.^. LecturerUser E.==. participant E.^. CourseParticipantUser
           return E.countRows
 
+    whenIsJust cRestr $ \restrSet ->
+      E.where_ $ course E.^. CourseId `E.in_` E.valList (Set.toList restrSet)
+
     return ( allocationCourse
            , E.maybe E.nothing (\c -> E.just $ c E.-. participants) (course E.^. CourseCapacity)
            , allocationCourse E.^. AllocationCourseMinCapacity E.-. participants
@@ -110,6 +117,7 @@ computeAllocation allocId = do
     & filterM (fmap not . alreadyAssigned)
   let preferences = Map.fromList $ do
         Entity _ CourseApplication{..} <- applications''
+        guard $ Map.member courseApplicationCourse capacities
         return ((courseApplicationUser, courseApplicationCourse), (courseApplicationAllocationPriority, courseApplicationRatingPoints))
 
   gradeScale <- getsYesod $ view _appAllocationGradeScale

src/Jobs.hs

@@ -276,10 +276,10 @@ execCrontab = do
       Just (_, MatchNone) -> liftBase retry
       Just x -> return (crontab, x)
 
-  -- do
+  do
-  --   lastTimes <- State.get
+    lastTimes <- State.get
-  --   now <- liftIO getCurrentTime
+    now <- liftIO getCurrentTime
-  --   $logDebugS "Crontab" . intercalate "\n" . map tshow . sortOn fst . flip map (HashMap.toList currentCrontab) $ \(job, cron) -> (,job) $ nextCronMatch appTZ (getMax <$> HashMap.lookup job lastTimes) (debouncingAcc settings job) now cron
+    $logDebugS "Crontab" . intercalate "\n" . map tshow . sortOn fst . flip map (HashMap.toList currentCrontab) $ \(job, cron) -> (,job) $ nextCronMatch appTZ (getMax <$> HashMap.lookup job lastTimes) (debouncingAcc settings job) now cron
 
   let doJob = mapRWST (liftHandler . runDBJobs . setSerializable) $ do
           newCrontab <- lift . hoist lift $ determineCrontab'

src/Jobs/Crontab.hs

@@ -222,7 +222,7 @@ determineCrontab = execWriterT $ do
                 { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts
                 , cronRepeat = CronRepeatOnChange
                 , cronRateLimit = appNotificationRateLimit
-                , cronNotAfter = Left appNotificationExpiration
+                , cronNotAfter = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationExpiration $ max visibleFrom ts
                 }
           _other -> return ()
 
@@ -346,7 +346,7 @@ determineCrontab = execWriterT $ do
             { cronInitial   = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay doneSince'
             , cronRepeat    = CronRepeatOnChange
             , cronRateLimit = appNotificationRateLimit
-            , cronNotAfter  = Left appNotificationExpiration
+            , cronNotAfter  = Right . CronTimestamp . utcToLocalTimeTZ appTZ . addUTCTime appNotificationCollateDelay $ addUTCTime appNotificationExpiration doneSince'
             }
 
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ allocationJobs

src/Jobs/Handler/SendNotification/Allocation.hs

@@ -170,12 +170,18 @@ dispatchNotificationAllocationResults nAllocation jRecipient = userMailT jRecipi
                               E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
                                    E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
                           )
-      let participantCount = E.sub_select . E.from $ \participant -> do
+      let allocatedCount = E.sub_select . E.from $ \participant -> do
             E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
                  E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
             return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64))
-      return (course, participantCount)
+      let participantCount = E.sub_select . E.from $ \participant -> do
-    let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value partCount) -> SomeMessage $ MsgAllocationResultLecturer courseShorthand partCount
+            E.where_ $ participant E.^. CourseParticipantCourse E.==. lecturer E.^. LecturerCourse
+            return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int64))
+      return (course, allocatedCount, participantCount)
+    let lecturerResults = flip map lecturerResults' $ \(Entity _ Course{..}, E.Value allocCount, E.Value partCount) -> SomeMessage $ if
+          | allocCount == partCount -> MsgAllocationResultLecturerAll courseShorthand allocCount
+          | allocCount == 0 -> MsgAllocationResultLecturerNone courseShorthand
+          | otherwise -> MsgAllocationResultLecturer courseShorthand allocCount partCount
 
     doParticipantResults <- E.selectExists . E.from $ \application ->
       E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)

templates/mail/allocationResults.hamlet

@@ -13,6 +13,9 @@ $newline never
     <h1>
       _{SomeMessage $ MsgMailSubjectAllocationResults allocationName}
 
+    <p>
+      _{SomeMessage MsgAllocationResultsTip}
+
     $if not (null lecturerResults)
       <p>
         _{SomeMessage MsgAllocationResultsLecturer}
@@ -21,16 +24,20 @@ $newline never
           <li>_{msg}
 
     $maybe pResults <- participantResults
+      <p>
+        _{SomeMessage MsgAllocationResultsStudentTip}
       $case pResults 
         $of []
           <p>_{SomeMessage MsgAllocationNoResultsStudent}
         $of [csh]
           <p>_{SomeMessage $ MsgAllocationResultStudent csh}
+          <p>_{SomeMessage MsgAllocationResultStudentRegistrationTip}
         $of cshs
           <p>
             _{SomeMessage MsgAllocationResultsStudent}
           <ul>
             $forall csh <- cshs
               <li>#{csh}
+          <p>_{SomeMessage MsgAllocationResultsStudentRegistrationTip}
 
     ^{ihamletSomeMessage editNotifications}