feat(allocations): display number of ratings and vetos to admins

frontend/src/app.sass

@@ -874,6 +874,9 @@ section
     @extend .explanation
     grid-area: admin-info
 
+    .notification
+      margin-top: 0
+
 @media (max-width: 426px)
   .allocation-course
     grid-template-columns: 1fr

messages/uniworx/categories/courses/allocation/de-de-formal.msg

@@ -98,6 +98,7 @@ AllocationNoApplication: Keine Bewerbung
 CourseAllocationCourseParticipants: Teilnehmer:innen
 CourseMembersCount n@Int !ident-ok: #{n}
 CourseMembersCountLimited n@Int max@Int !ident-ok: #{n}/#{max}
+CourseAllocationCourseRatings ratings@Word64 vetos@Word64: #{ratings} #{pluralDE ratings "Bewertung" "Bewertungen"} (#{vetos} #{pluralDE vetos "Veto" "Vetos"})
 
 #templates allocation/accept
 ComputedAllocation: Berechnete Vergabe
@@ -246,4 +247,5 @@ AllocationMatchingLogFileName tid@TermId ssh@SchoolId ash@AllocationShorthand cI
 AllocationUserDeleteQuestion: Wollen Sie den/die unten aufgeführten Benutzer:in wirklich aus der Zentralanmeldung entfernen?
 AllocationUserDeleted: Benutzer:in erfolgreich entfernt
 AllocationApplicationsCount n@Word64: #{n} #{pluralDE n "Bewerbung" "Bewerbungen"}
-AllocationAllocationsCount n@Word64: #{n} #{pluralDE n "Zuweisung" "Zuweisungen"}
+AllocationAllocationsCount n@Word64: #{n} #{pluralDE n "Zuweisung" "Zuweisungen"}
+AllocationCourseHasRatings ratings@Word64 vetos@Word64: Dieser Kurs hat bereits #{ratings} #{pluralDE ratings "Bewertung" "Bewertungen"} (#{vetos} #{pluralDE vetos "Veto" "Vetos"})

messages/uniworx/categories/courses/allocation/en-eu.msg

@@ -98,6 +98,7 @@ AllocationNoApplication: No application
 CourseAllocationCourseParticipants: Participants
 CourseMembersCount n: #{n}
 CourseMembersCountLimited n max: #{n}/#{max}
+CourseAllocationCourseRatings ratings vetos: #{ratings} #{pluralENs ratings "rating"} (#{vetos} #{pluralENs vetos "veto"})
 
 #templates allocation/accept
 ComputedAllocation: Computed allocation
@@ -246,3 +247,4 @@ AllocationUserDeleteQuestion: Do you really want to remove the allocation partic
 AllocationUserDeleted: Participant successfully removed
 AllocationApplicationsCount n: #{n} #{pluralENs n "application"}
 AllocationAllocationsCount n: #{n} #{pluralENs n "allocation"}
+AllocationCourseHasRatings ratings vetos: This course already has #{ratings} #{pluralENs ratings "rating"} (#{vetos} #{pluralENs vetos "veto"})

src/Handler/Allocation/Show.hs

@@ -63,6 +63,10 @@ postAShowR tid ssh ash = do
     resultAllocationCourse = _6 . _entityVal
     resultParticipantCount :: _ => Lens' a Int
     resultParticipantCount = _7 . _Value
+    resultRatingsCount :: _ => Getter a (Maybe Word64)
+    resultRatingsCount = _8 . _1 . _Value . to (assertM' (> 0))
+    resultVetosCount :: _ => Lens' a Word64
+    resultVetosCount = _8 . _2 . _Value
 
   (Entity aId Allocation{..}, School{..}, isAnyLecturer, isAdmin, courses, registration, wouldNotifyNewCourse) <- runDB $ do
     alloc@(Entity aId Allocation{allocationSchool}) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
@@ -86,6 +90,17 @@ postAShowR tid ssh ash = do
           participantCount = E.subSelectCount . E.from $ \courseParticipant ->
             E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
                  E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+          ratingsCount = E.subSelectCount . E.from $ \courseApplication' -> do
+            E.where_ $ courseApplication' E.^. CourseApplicationCourse E.==. course E.^. CourseId
+                 E.&&. courseApplication' E.^. CourseApplicationAllocation E.==. E.justVal aId
+                 E.&&. (       E.isJust (courseApplication' E.^. CourseApplicationRatingPoints)
+                         E.||. E.isJust (courseApplication' E.^. CourseApplicationRatingComment)
+                         E.||. courseApplication' E.^. CourseApplicationRatingVeto
+                       )
+          vetosCount = E.subSelectCount . E.from $ \courseApplication' -> do
+            E.where_ $ courseApplication' E.^. CourseApplicationCourse E.==. course E.^. CourseId
+                 E.&&. courseApplication' E.^. CourseApplicationAllocation E.==. E.justVal aId
+                 E.&&. courseApplication' E.^. CourseApplicationRatingVeto
       return ( course
              , courseApplication
              , hasTemplate
@@ -93,6 +108,7 @@ postAShowR tid ssh ash = do
              , courseIsVisible now course . Just $ E.val aId
              , allocationCourse
              , participantCount
+             , (ratingsCount, vetosCount)
              )
 
     registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
@@ -166,6 +182,8 @@ postAShowR tid ssh ash = do
               courseVisible          = cEntry ^. resultCourseVisible
               AllocationCourse{..}   = cEntry ^. resultAllocationCourse
               partCount              = cEntry ^. resultParticipantCount
+              mRatings               = cEntry ^. resultRatingsCount
+              vetos                  = cEntry ^. resultVetosCount
           cID <- encrypt cid :: WidgetFor UniWorX CryptoUUIDCourse
           mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
           mayEdit <- hasWriteAccessTo $ CourseR tid ssh courseShorthand CEditR

src/Handler/Allocation/UserForm.hs

@@ -9,6 +9,8 @@ import Handler.Allocation.Application
 import Handler.Utils
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.PostgreSQL as E
 import qualified Data.Map.Strict as Map
 
 import Text.Blaze (toMarkup)
@@ -69,16 +71,17 @@ allocationUserForm aId mTemplate = wFormToAForm $ do
     <*> applicationsRes
 
 
-allocationApplicationsForm :: forall m.
+allocationApplicationsForm :: forall m backend.
                               ( MonadHandler m, HandlerSite m ~ UniWorX
+                              , E.SqlBackendCanRead backend
                               )
                            => AllocationId
                            -> Maybe UserId
                            -> Map CourseId (Course, AllocationCourse, Bool)
                            -> FieldSettings UniWorX
                            -> Bool
-                           -> AForm m (Map CourseId ApplicationForm)
+                           -> AForm (ReaderT backend m) (Map CourseId ApplicationForm)
-allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired  = formToAForm . hoist liftHandler $ do
+allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired  = formToAForm $ do
   now <- liftIO getCurrentTime
   
   let afmApplicant = True
@@ -90,7 +93,16 @@ allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired  = form
       guard hasApplicationTemplate
       let Course{..} = course
       toTextUrl $ CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR
-    over _2 (course, allocCourse, mApplicationTemplate, ) <$> applicationForm (Just aId) cId muid ApplicationFormMode{..} Nothing
+    counts <- lift . fmap (maybe (Nothing, 0) $ bimap (assertM' (> 0) . E.unValue) E.unValue) . E.selectMaybe . E.from $ \courseApplication -> do
+      E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cId
+           E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.justVal aId
+      let hasRating = E.isJust (courseApplication E.^. CourseApplicationRatingPoints)
+                E.||. E.isJust (courseApplication E.^. CourseApplicationRatingComment)
+                E.||. courseApplication E.^. CourseApplicationRatingVeto
+      return ( E.count (courseApplication E.^. CourseApplicationId) `E.filterWhere` hasRating
+             , E.count (courseApplication E.^. CourseApplicationId) `E.filterWhere` (courseApplication E.^. CourseApplicationRatingVeto)
+             )
+    hoist liftHandler $ over _2 (course, allocCourse, mApplicationTemplate, counts, ) <$> applicationForm (Just aId) cId muid ApplicationFormMode{..} Nothing
   let appsRes = sequenceA $ view _1 <$> appsRes'
       appsViews = view _2 <$> appsRes'
   
@@ -98,7 +110,7 @@ allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired  = form
         [whamlet|
           $newline never
           <div .allocation__courses>
-            $forall (Course{courseTerm, courseSchool, courseShorthand, courseName, courseApplicationsInstructions}, AllocationCourse{allocationCourseAcceptSubstitutes}, mApplicationTemplate, ApplicationFormView{afvPriority, afvForm}) <- Map.elems appsViews
+            $forall (Course{courseTerm, courseSchool, courseShorthand, courseName, courseApplicationsInstructions}, AllocationCourse{allocationCourseAcceptSubstitutes}, mApplicationTemplate, (mRatings, vetos), ApplicationFormView{afvPriority, afvForm}) <- Map.elems appsViews
               <div .allocation-course>
                 <div .allocation-course__priority-label .allocation__label>
                   _{MsgAllocationPriority}
@@ -116,6 +128,8 @@ allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired  = form
                       _{MsgCourseAllocationCourseAcceptsSubstitutesNever}
                     $if allocationCourseAcceptSubstitutes >= Just now
                       \ ^{iconOK}
+                  $maybe ratings <- mRatings
+                    ^{notification NotificationBroad =<< messageI Warning (MsgAllocationCourseHasRatings ratings vetos)}
                 $if is _Just mApplicationTemplate || is _Just courseApplicationsInstructions
                   <div .allocation-course__instructions-label .allocation__label>
                     _{MsgCourseAllocationApplicationInstructionsApplication}

templates/allocation/show/course.hamlet

@@ -33,6 +33,9 @@ $if isAdmin
       $nothing
         \ _{MsgCourseMembersCount partCount}
         \ ^{iconProblem}
+    $maybe ratings <- mRatings
+      <p>
+        _{MsgCourseAllocationCourseRatings ratings vetos}
 $if hasApplicationTemplate || is _Just courseApplicationsInstructions
   <div .allocation-course__instructions-label .allocation__label>
     _{MsgCourseApplicationInstructionsApplication}