feat(allocations): show bounds on assignments due to allocation

messages/uniworx/de.msg

@@ -1645,4 +1645,9 @@ AdminUserMatriculation: Matrikelnummer
 AuthKindLDAP: Campus-Kennung
 AuthKindPWHash: Uni2work-Kennung
 UserAdded: Benutzer erfolgreich angelegt
-UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden
+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

src/Handler/Course/Application/List.hs

@@ -210,8 +210,8 @@ embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvException id
 getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCApplicationsR = postCApplicationsR
 postCApplicationsR tid ssh csh = do
-  table <- runDB $ do
+  (table, allocationsBounds) <- runDB $ do
-    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+    Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh
 
     let
       allocationLink :: Allocation -> SomeRoute UniWorX
@@ -532,10 +532,41 @@ postCApplicationsR tid ssh csh = do
       psValidator = def
         & defaultSorting [SortAscBy "user-name"]
 
-    dbTableWidget' psValidator DBTable{..}
+    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
+
+      let numApps addWhere = E.sub_select . E.from $ \courseApplication -> do
+            E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
+                 E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
+            addWhere courseApplication
+            return E.countRows
+
+          numApps' = numApps . const $ return ()
+
+          numFirstChoice = numApps $ \courseApplication ->
+            E.where_ . E.not_ . E.exists . E.from $ \courseApplication' -> do
+              E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. courseApplication' E.^. CourseApplicationAllocation
+                   E.&&. courseApplication E.^. CourseApplicationUser       E.==. courseApplication' E.^. CourseApplicationUser
+              E.where_ . E.not_ $ E.isNothing (courseApplication E.^. CourseApplicationAllocationPriority)
+                            E.||. E.isNothing (courseApplication' E.^. CourseApplicationAllocationPriority)
+              E.where_ $ courseApplication' E.^. CourseApplicationAllocationPriority E.>. courseApplication E.^. CourseApplicationAllocationPriority
+
+      return (allocation, numApps', numFirstChoice)
+
+    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
+                                capped = numApps' /= numApps
+                                      || numFirstChoice' /= numFirstChoice
+                          ]
+
+    (, allocationsBounds) <$> dbTableWidget' psValidator DBTable{..}
 
   let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
 
   siteLayoutMsg title $ do
     setTitleI title
-    table
+    $(widgetFile "course/applications-list")

templates/course/applications-list.hamlet

@@ -0,0 +1,19 @@
+$newline never
+$if not (null allocationsBounds)
+  <h2>_{MsgCourseAllocationsBounds (length allocationsBounds)}
+  <dl .deflist>
+    $forall (Allocation{allocationName}, numApps, numFirstChoice, capped) <- allocationsBounds
+      <dt .deflist__dt>
+        #{allocationName}
+      <dd .deflist__dd>
+        <p>
+          $if numApps == numFirstChoice
+            _{MsgCourseAllocationsBoundCoincide numFirstChoice}
+          $else
+            _{MsgCourseAllocationsBound numApps numFirstChoice}
+        $if capped
+          <p>
+            _{MsgCourseAllocationsBoundCapped}
+
+<h2>_{MsgMenuCourseApplications}
+^{table}

templates/i18n/changelog/de.hamlet

@@ -1,5 +1,11 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2019 09 12}
+  <dd .deflist__dd>
+    <ul>
+      <li>Abschätzung der durch Zentralanmeldung benötigten Kurskapazität
+      
   <dt .deflist__dt>
     ^{formatGregorianW 2019 09 05}
   <dd .deflist__dd>