feat(labels): label filter

messages/uniworx/categories/courses/exam/exam_office/de-de-formal.msg

@@ -58,6 +58,8 @@ ExamOfficeFieldForced: Forcierte Einsicht
 
 ExamOfficeGetSynced: Synchronisiert-Status in Prüfungsliste anzeigen
 ExamOfficeGetSyncedTip: Soll unter „Prüfungen“ der Synchronisiert-Status zu jeder Prüfung angezeigt werden? (Ein Deaktivieren dieser Option kann zu kürzeren Ladezeiten der Prüfungsliste führen.)
+
+ExamLabel: Prüfungs-Label
 ExamOfficeGetLabels: Labels in Prüfungsliste anzeigen
 ExamOfficeGetLabelsTip: Sollen unter „Prüfungen“ die gesetzten Labels zu jeder Prüfung angezeigt werden?
 ExamOfficeLabels: Prüfungs-Labels
@@ -66,3 +68,4 @@ ExamOfficeLabelName !ident-ok: Name
 ExamOfficeLabelStatus !ident-ok: Status
 ExamOfficeLabelPriority: Priorität
 ExamOfficeLabelAlreadyExists: Es existiert bereits ein Prüfungs-Label mit diesem Namen!
+ExamOfficeExamsNoLabel: Kein Label

messages/uniworx/categories/courses/exam/exam_office/en-eu.msg

@@ -56,6 +56,8 @@ ExamOfficeFieldForced: Forced access
 
 ExamOfficeGetSynced: Show synchronised status in exam list
 ExamOfficeGetSyncedTip: Should the synchronised status be displayed in “Exams”? (Disabling this option may lead to shorter loading times of the exam list.)
+
+ExamLabel: Exam label
 ExamOfficeGetLabels: Show labels in exam list
 ExamOfficeGetLabelsTip: Should the labels of each exam be displayed in “Exams”?
 ExamOfficeLabels: Exam labels
@@ -64,3 +66,4 @@ ExamOfficeLabelName: Name
 ExamOfficeLabelStatus: Status
 ExamOfficeLabelPriority: Priority
 ExamOfficeLabelAlreadyExists: There already exists an exam label with this name!
+ExamOfficeExamsNoLabel: No label

models/exam-office/exam-labels.model

@@ -3,7 +3,7 @@ ExamOfficeLabel
   name ExamOfficeLabelName
   status MessageStatus
   priority Int          -- determines label ordering
-  UniqueExamOfficeLabel user name status
+  UniqueExamOfficeLabel user name
   deriving Generic
 
 ExamOfficeExamLabel

src/Handler/ExamOffice/Exams.hs

@@ -21,6 +21,7 @@ import qualified Data.Conduit.Combinators as C
 data ExamsTableFilterProj = ExamsTableFilterProj
   { etProjFilterMayAccess  :: Maybe Bool
   , etProjFilterHasResults :: Maybe Bool
+  , etProjFilterLabel      :: Maybe (Either ExamOfficeExternalExamLabelId ExamOfficeExamLabelId)
   , etProjFilterIsSynced   :: Maybe Bool
   }
 
@@ -28,6 +29,7 @@ instance Default ExamsTableFilterProj where
   def = ExamsTableFilterProj
     { etProjFilterMayAccess  = Nothing
     , etProjFilterHasResults = Nothing
+    , etProjFilterLabel      = Nothing
     , etProjFilterIsSynced   = Nothing
     }
 
@@ -116,6 +118,7 @@ getEOExamsR :: Handler Html
 getEOExamsR = do
   (uid, User{..}) <- requireAuthPair
   now <- liftIO getCurrentTime
+  mr <- getMessageRender
 
   getSynced <- lookupGetParam "synced" >>= return . \case
     Just "yes" -> True
@@ -128,6 +131,22 @@ getEOExamsR = do
     _          -> userExamOfficeGetLabels
 
   examsTable <- runDB $ do
+    let labelFilterNoLabelOption = Option
+          { optionDisplay        = mr MsgExamOfficeExamsNoLabel
+          , optionInternalValue  = Nothing
+          , optionExternalValue  = "no-label"
+          }
+    labelFilterOptions <- mkOptionList . (labelFilterNoLabelOption :) <$> do
+      labels <- E.select . E.from $ \examOfficeLabel -> do
+        E.where_ $ examOfficeLabel E.^. ExamOfficeLabelUser E.==. E.val uid
+        E.orderBy [ E.asc $ examOfficeLabel E.^. ExamOfficeLabelName ]
+        return examOfficeLabel
+      return . flip map labels $ \(Entity lblId ExamOfficeLabel{..})
+        -> Option { optionDisplay       = examOfficeLabelName
+                  , optionInternalValue = Just lblId
+                  , optionExternalValue = examOfficeLabelName
+                  }
+
     let
       examLink :: Course -> Exam -> SomeRoute UniWorX
       examLink Course{..} Exam{..}
@@ -236,13 +255,13 @@ getEOExamsR = do
           colLabel = Colonnade.singleton (fromSortable . Sortable (Just "label") $ i18nCell MsgTableExamLabel) $ \x -> flip runReader x $ do
             mLabel <- preview resultLabel
             
-            -- TODO: implement and use select widget for setting label
+            -- TODO: use select frontend util
             if
               | Just (Just (Entity _ ExamOfficeLabel{..})) <- mLabel
               -> return $ cell
                 [whamlet|
                   $newline never
-                  #{examOfficeLabelName}
+                  #{examOfficeLabelName} (_{examOfficeLabelStatus}, #{tshow examOfficeLabelPriority})
                 |]
               | otherwise -> return $ cell mempty
 
@@ -315,17 +334,17 @@ getEOExamsR = do
             , sortTerm (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseTerm), views queryExternalExam (E.?. ExternalExamTerm)])
             ]
 
-          -- TODO: implement label filters: prio, status, name
           dbtFilter = mconcat $
-            [ singletonMap "may-access" . FilterProjected $ (_etProjFilterMayAccess ?~) . getAny
+            [ singletonMap "may-access"  . FilterProjected $ (_etProjFilterMayAccess  ?~) . getAny
             , singletonMap "has-results" . FilterProjected $ (_etProjFilterHasResults ?~) . getAny
-            ] <> (bool mempty
-            [ singletonMap "is-synced" . FilterProjected $ (_etProjFilterIsSynced ?~) . getAny
-            ] getSynced)
-          dbtFilterUI = mconcat $
-            (bool mempty
-            [ flip (prismAForm $ singletonFilter "is-synced" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamSynchronised)
-            ] getSynced)
+            , singletonMap "is-synced"   . FilterProjected $ (_etProjFilterIsSynced   ?~) . getAny
+            , singletonMap "label"       . FilterColumn . E.mkExactFilter $ views queryLabelExam (E.?. ExamOfficeLabelId)
+            ]
+          dbtFilterUI mPrev = mconcat $
+            [ prismAForm (singletonFilter "label"     . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return labelFilterOptions) (fslI MsgExamLabel)
+            | getLabels ] <>
+            [ prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamSynchronised)
+            | getSynced ]
 
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtParams = def