From 300c3787867622a7fe3580b63cbbfba86a8b21f3 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 15 Jun 2021 12:25:11 +0200 Subject: [PATCH] feat(allocations): highlight app's of users without alloc'-user --- frontend/src/app.sass | 2 +- .../courses/application/de-de-formal.msg | 1 + .../courses/courses/application/en-eu.msg | 1 + src/Handler/Course/Application/List.hs | 34 +++++++++++++++++-- src/Utils/Icon.hs | 2 ++ 5 files changed, 36 insertions(+), 4 deletions(-) diff --git a/frontend/src/app.sass b/frontend/src/app.sass index e30529b8b..7829b8a3b 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -970,7 +970,7 @@ th, td right: 5px top: 5px -.occurrence--not-registered, .no-bonus, .allocation-course--excluded, .allocation-course--inactive, .occurrence--ignored +.occurrence--not-registered, .no-bonus, .allocation-course--excluded, .allocation-course--inactive, .occurrence--ignored, .allocation--no-allocation-user text-decoration: line-through .result diff --git a/messages/uniworx/categories/courses/courses/application/de-de-formal.msg b/messages/uniworx/categories/courses/courses/application/de-de-formal.msg index 90052d046..928acfc77 100644 --- a/messages/uniworx/categories/courses/courses/application/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/application/de-de-formal.msg @@ -28,6 +28,7 @@ AcceptApplicationsModeTip: Sollen akzeptierte Bewerber:innen direkt als Teilnehm AcceptApplicationsSecondary: Gleichstände auflösen AcceptApplicationsSecondaryTip: Wenn es im Laufe des Verfahrens mehrere Bewerber:innen mit der selben Bewertung für den selben Platz gibt, wie soll der Gleichstand aufgelöst werden? CsvColumnUserAppStudyFeatures: Alle relevanten Studiendaten des/der Teilnehmers/Teilnehmerin als Semikolon (;) separierte Liste +ApplicationAllocationNoAllocationUser: Dieser Student/diese Studentin nimmt nicht (mehr) an der Zentralvergabe teil. Die Bewerbung existiert zwar noch, wird jedoch bis auf Weiteres sicherlich nicht zu einer Anmeldung führen. CourseApplicationId: Bewerbungsnummer CourseApplicationRatingPoints: Bewertung diff --git a/messages/uniworx/categories/courses/courses/application/en-eu.msg b/messages/uniworx/categories/courses/courses/application/en-eu.msg index 4a2bb380b..75732036c 100644 --- a/messages/uniworx/categories/courses/courses/application/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/application/en-eu.msg @@ -28,6 +28,7 @@ AcceptApplicationsModeTip: Should accepted applications be enrolled in the cours AcceptApplicationsSecondary: Breaking ties AcceptApplicationsSecondaryTip: If a tie occurs during the acceptance process, how should it be broken? CsvColumnUserAppStudyFeatures: All relevant features of study for the participant, separated by semicolon (;) +ApplicationAllocationNoAllocationUser: This student does not (or does no longer) participate in the allocation. The application still exists, but will certainly not lead to a registriation while it is in this state. CourseApplicationId: Application number CourseApplicationRatingPoints: Grading diff --git a/src/Handler/Course/Application/List.hs b/src/Handler/Course/Application/List.hs index cf077b4ae..390c912f3 100644 --- a/src/Handler/Course/Application/List.hs +++ b/src/Handler/Course/Application/List.hs @@ -41,6 +41,7 @@ type CourseApplicationsTableData = DBRow ( Entity CourseApplication , Maybe (Entity Allocation) , Bool -- isParticipant , UserTableStudyFeatures + , Bool -- hasAllocationUser ) courseApplicationsIdent :: Text @@ -61,6 +62,13 @@ queryHasFiles = to $ hasFiles . $(sqlIJproj 2 1) . $(sqlLOJproj 3 1) queryAllocation :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity Allocation))) queryAllocation = to $(sqlLOJproj 3 2) +queryHasAllocationUser :: Getter CourseApplicationsTableExpr (E.SqlExpr (E.Value Bool)) +queryHasAllocationUser = to hasAllocationUser + where + hasAllocationUser (view queryCourseApplication -> courseApplication) = E.exists . E.from $ \allocationUser -> + E.where_ $ E.just (allocationUser E.^. AllocationUserAllocation) E.==. courseApplication E.^. CourseApplicationAllocation + E.&&. allocationUser E.^. AllocationUserUser E.==. courseApplication E.^. CourseApplicationUser + queryCourseParticipant :: Getter CourseApplicationsTableExpr (E.SqlExpr (Maybe (Entity CourseParticipant))) queryCourseParticipant = to $(sqlLOJproj 3 3) @@ -85,6 +93,9 @@ resultIsParticipant = _dbrOutput . _5 resultStudyFeatures :: Lens' CourseApplicationsTableData UserTableStudyFeatures resultStudyFeatures = _dbrOutput . _6 +resultHasAllocationUser :: Lens' CourseApplicationsTableData Bool +resultHasAllocationUser = _dbrOutput . _7 + newtype CourseApplicationsTableVeto = CourseApplicationsTableVeto Bool deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -253,6 +264,7 @@ postCApplicationsR tid ssh csh = do user <- view queryUser allocation <- view queryAllocation courseParticipant <- view queryCourseParticipant + hasAllocationUser <- view queryHasAllocationUser lift $ do E.on $ E.just (user E.^. UserId) E.==. courseParticipant E.?. CourseParticipantUser @@ -269,12 +281,13 @@ postCApplicationsR tid ssh csh = do , hasFiles , allocation , E.not_ . E.isNothing $ courseParticipant E.?. CourseParticipantId + , hasAllocationUser ) dbtProj :: _ CourseApplicationsTableData - dbtProj = dbtProjSimple $ \(application, user, E.Value hasFiles, allocation, E.Value isParticipant) -> do + dbtProj = dbtProjSimple $ \(application, user, E.Value hasFiles, allocation, E.Value isParticipant, E.Value hasAllocationUser) -> do feats <- courseUserStudyFeatures (application ^. _entityVal . _courseApplicationCourse) (user ^. _entityKey) - return (application, user, hasFiles, allocation, isParticipant, feats) + return (application, user, hasFiles, allocation, isParticipant, feats, hasAllocationUser) dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId) @@ -282,7 +295,22 @@ postCApplicationsR tid ssh csh = do dbtColonnade = mconcat [ cap (Sortable Nothing generatedColumnsHeader) $ mconcat [ sortable (Just "participant") (i18nCell MsgCourseApplicationIsParticipant) $ bool mempty (cell $ toWidget iconOK) . view resultIsParticipant - , emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand) + , sortable (Just "allocation-short") (i18nCell MsgAllocation) $ \x -> + let noAllocationUserShort alloc = + [whamlet| + $newline never + + #{view _allocationShorthand alloc} + |] + noAllocationUserTooltip = messageTooltip =<< messageIconI Warning IconNoAllocationUser MsgApplicationAllocationNoAllocationUser + in if | Just alloc <- x ^? resultAllocation . _entityVal + , x ^. resultHasAllocationUser + -> anchorCell (allocationLink alloc) $ alloc ^. _allocationShorthand + | Just alloc <- x ^? resultAllocation . _entityVal + -> anchorCell (allocationLink alloc) (noAllocationUserShort alloc) + & cellContents . mapped %~ (<> noAllocationUserTooltip) + | otherwise + -> mempty , anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey) , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) , lmap (view $ resultUser . _entityVal) colUserEmail diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index be30d24d8..d7cff02d5 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -98,6 +98,7 @@ data Icon | IconMenuWorkflows | IconVideo | IconSubmissionUserDuplicate + | IconNoAllocationUser deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable) deriving anyclass (Universe, Finite, NFData) @@ -179,6 +180,7 @@ iconText = \case IconMenuWorkflows -> "project-diagram" IconVideo -> "video" IconSubmissionUserDuplicate -> "copy" + IconNoAllocationUser -> "user-slash" nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon