feat(allocations): highlight app's of users without alloc'-user

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

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

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

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
+                      <span .allocation--no-allocation-user>
+                        #{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

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