feat(allocations): allow changing course capacity during allocation

Also refine display of allocation registration bounds

messages/uniworx/de.msg

@@ -1650,4 +1650,5 @@ UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden
 CourseAllocationsBounds n@Int: Voraussichtliche Zuteilungen durch #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"}
 CourseAllocationsBoundCoincide numFirstChoice@Int: Vstl. #{numFirstChoice} Teilnehmer
 CourseAllocationsBound numApps@Int numFirstChoice@Int: Vstl. zwischen #{numFirstChoice} und #{numApps} Teilnehmer
-CourseAllocationsBoundCapped: Die Anzahl von Zuteilungen wird wmgl. durch die Kurskapazität eingeschränkt
+CourseAllocationsBoundCapped: Die Anzahl von Zuteilungen wird wmgl. durch die Kurskapazität eingeschränkt.
+CourseAllocationsBoundWarningOpen: Diese Informationen entsprechen nur dem aktuellen Stand der Bewerbungen und können sich noch ändern.

src/Handler/Course/Application/List.hs

@@ -532,6 +532,9 @@ postCApplicationsR tid ssh csh = do
       psValidator = def
         & defaultSorting [SortAscBy "user-name"]
 
+    participants <- count [ CourseParticipantCourse ==. cid ]
+    let remainingCapacity = subtract participants <$> courseCapacity
+
     allocationsBounds' <- E.select . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do
       E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
        E.&&. allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
@@ -557,15 +560,17 @@ postCApplicationsR tid ssh csh = do
     let
       allocationsBounds = [ (allocation, numApps', numFirstChoice', capped)
                           | (Entity _ allocation, E.Value numApps, E.Value numFirstChoice) <- allocationsBounds'
-                          , let numApps' = maybe id min courseCapacity numApps
-                                numFirstChoice' = maybe id min courseCapacity numFirstChoice
+                          , let numApps' = max 0 $ maybe id min remainingCapacity numApps
+                                numFirstChoice' = max 0 $ maybe id min remainingCapacity numFirstChoice
                                 capped = numApps' /= numApps
                                       || numFirstChoice' /= numFirstChoice
                           ]
 
     (, allocationsBounds) <$> dbTableWidget' psValidator DBTable{..}
 
+  now <- liftIO getCurrentTime
   let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
+      registrationOpen = maybe True (now <)
 
   siteLayoutMsg title $ do
     setTitleI title

src/Handler/Course/Edit.hs

@@ -303,10 +303,11 @@ validateCourse = do
     prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
     prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
 
-    fmap join . for prevAllocation $ \Allocation{allocationStaffRegisterTo} -> if
+    fmap join . for prevAllocation $ \Allocation{allocationStaffAllocationTo, allocationRegisterByCourse} -> if
       | userAdmin
         -> return Nothing
-      | NTop allocationStaffRegisterTo <= NTop (Just now)
+      | NTop allocationStaffAllocationTo <= NTop (Just now)
+      , NTop allocationRegisterByCourse > NTop (Just now)
         -> Just . courseCapacity <$> getJust cid
       | otherwise
         -> return Nothing

templates/course/applications-list.hamlet

@@ -2,7 +2,7 @@ $newline never
 $if not (null allocationsBounds)
   <h2>_{MsgCourseAllocationsBounds (length allocationsBounds)}
   <dl .deflist>
-    $forall (Allocation{allocationName}, numApps, numFirstChoice, capped) <- allocationsBounds
+    $forall (Allocation{allocationName, allocationRegisterTo}, numApps, numFirstChoice, capped) <- allocationsBounds
       <dt .deflist__dt>
         #{allocationName}
       <dd .deflist__dd>
@@ -12,8 +12,11 @@ $if not (null allocationsBounds)
           $else
             _{MsgCourseAllocationsBound numApps numFirstChoice}
         $if capped
-          <p>
+          <p .bound_explanation>
             _{MsgCourseAllocationsBoundCapped}
+        $if registrationOpen allocationRegisterTo
+          <p .bound_explanation>
+            _{MsgCourseAllocationsBoundWarningOpen}
 
 <h2>_{MsgMenuCourseApplications}
 ^{table}

templates/course/applications-list.lucius

@@ -0,0 +1,4 @@
+.bound_explanation {
+  color: var(--color-fontsec);
+  font-style: italic;
+}