From 6da8ad348182185f773ab08a10ff59a6a1e89b85 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 15 Jun 2021 17:40:19 +0200 Subject: [PATCH] feat(allocations): display number of ratings and vetos to admins --- frontend/src/app.sass | 3 +++ .../courses/allocation/de-de-formal.msg | 4 +++- .../categories/courses/allocation/en-eu.msg | 2 ++ src/Handler/Allocation/Show.hs | 18 ++++++++++++++ src/Handler/Allocation/UserForm.hs | 24 +++++++++++++++---- templates/allocation/show/course.hamlet | 3 +++ 6 files changed, 48 insertions(+), 6 deletions(-) diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 7829b8a3b..b2563cf73 100644 --- a/frontend/src/app.sass +++ b/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 diff --git a/messages/uniworx/categories/courses/allocation/de-de-formal.msg b/messages/uniworx/categories/courses/allocation/de-de-formal.msg index 498808e9b..216095d3f 100644 --- a/messages/uniworx/categories/courses/allocation/de-de-formal.msg +++ b/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"} \ No newline at end of file +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"}) \ No newline at end of file diff --git a/messages/uniworx/categories/courses/allocation/en-eu.msg b/messages/uniworx/categories/courses/allocation/en-eu.msg index d9a22d45d..99456e554 100644 --- a/messages/uniworx/categories/courses/allocation/en-eu.msg +++ b/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"}) diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs index 3c0f0fd85..6c66de6cf 100644 --- a/src/Handler/Allocation/Show.hs +++ b/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 diff --git a/src/Handler/Allocation/UserForm.hs b/src/Handler/Allocation/UserForm.hs index 4361f3e7a..3e051e65a 100644 --- a/src/Handler/Allocation/UserForm.hs +++ b/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) -allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired = formToAForm . hoist liftHandler $ do + -> AForm (ReaderT backend m) (Map CourseId ApplicationForm) +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
- $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
_{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
_{MsgCourseAllocationApplicationInstructionsApplication} diff --git a/templates/allocation/show/course.hamlet b/templates/allocation/show/course.hamlet index 483ecdd3b..57a26fe84 100644 --- a/templates/allocation/show/course.hamlet +++ b/templates/allocation/show/course.hamlet @@ -33,6 +33,9 @@ $if isAdmin $nothing \ _{MsgCourseMembersCount partCount} \ ^{iconProblem} + $maybe ratings <- mRatings +

+ _{MsgCourseAllocationCourseRatings ratings vetos} $if hasApplicationTemplate || is _Just courseApplicationsInstructions

_{MsgCourseApplicationInstructionsApplication}