From 745feeac832ec6d5ce6cb508f7580aa15a35c308 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 29 May 2019 20:59:58 +0200
Subject: [PATCH] FilterUI for Submission (Part2)

---
 src/Handler/Corrections.hs | 54 ++++++++++++++++++++++++++++++--------
 1 file changed, 43 insertions(+), 11 deletions(-)

diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 681580f68..aef00e033 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -79,8 +79,17 @@ lastEditQuery submission = E.sub_select $ E.from $ \edit -> do
   E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
   return $ E.max_ $ edit E.^. SubmissionEditTime
 
+queryCourse :: CorrectionTableExpr -> E.SqlExpr (Entity Course)
+queryCourse = $(sqlIJproj 3 1) . $(sqlLOJproj 2 1)
+
+querySheet :: CorrectionTableExpr -> E.SqlExpr (Entity Sheet)
+querySheet = $(sqlIJproj 3 2) . $(sqlLOJproj 2 1)
+
 querySubmission :: CorrectionTableExpr -> E.SqlExpr (Entity Submission)
-querySubmission =  $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)
+querySubmission = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)
+
+queryCorrector :: CorrectionTableExpr -> E.SqlExpr (Maybe (Entity User))
+queryCorrector = $(sqlLOJproj 2 2)
 
 -- Where Clauses
 ratedBy :: UserId -> CorrectionTableWhere
@@ -330,6 +339,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
             Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
             Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
         )
+      , ( "corrector-name-email" -- corrector filter does not work for text-filtering
+        , FilterColumn $ E.anyFilter
+            [ E.mkContainsFilter $ queryCorrector >>> (E.?. UserSurname)
+            , E.mkContainsFilter $ queryCorrector >>> (E.?. UserDisplayName)
+            , E.mkContainsFilter $ queryCorrector >>> (E.?. UserEmail)
+            ]
+        )
       , ( "user-name-email"
         , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(submissionUser `E.InnerJoin` user) -> do
               E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
@@ -340,6 +356,18 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
                 , E.mkContainsFilter (E.^. UserEmail)
                 ]
         )
+      , ( "user-matriclenumber"
+        , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(submissionUser `E.InnerJoin` user) -> do
+              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
+              E.where_ $ querySubmission table E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
+              E.where_ $ (\f -> f user $ Set.singleton needle) $
+                E.mkContainsFilter (E.^. UserMatrikelnummer)
+        )
+      -- , ( "pseudonym"
+      --   , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(pseudonym) -> do
+      --       E.where_ $ querySheet table E.^. SheetId E.==. pseudonym E.^. SheetPseudonymSheet
+      --       E.where_ $ E.mkContainsFilter -- DB only stores Pseudonym == Word24. Conversion not possible in DB.
+      --   )
       ]
     , dbtFilterUI  = fromMaybe mempty dbtFilterUI
     , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@@ -599,17 +627,14 @@ postCCorrectionsR tid ssh csh = do
         , colAssigned
         ] -- Continue here
       filterUI = Just $ \mPrev -> mconcat
-        [ -- "name"
-          -- "matrikel"
-          -- "corrector"
-          -- "pseudonym" TODO
-          prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseMembers)
+        [ prismAForm (singletonFilter "user-name-email")      mPrev $ aopt textField (fslI MsgCourseMembers)
+        , prismAForm (singletonFilter "user-matriclenumber")  mPrev $ aopt textField (fslI MsgMatrikelNr)
+        , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
+          -- "pseudonym" TODO DB only stores Word24
         , Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
         , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField             (fslI MsgRatingTime)
         ]
-
-
-      psValidator = def & defaultPagesize PagesizeAll
+      psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
   correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Left cid)
@@ -633,8 +658,15 @@ postSSubsR tid ssh csh shn = do
         , colCorrector
         , colAssigned
         ]
-      psValidator = def & defaultPagesize PagesizeAll
-  correctionsR whereClause colonnade Nothing psValidator $ Map.fromList
+      filterUI = Just $ \mPrev -> mconcat
+        [ prismAForm (singletonFilter "user-name-email")      mPrev $ aopt textField (fslI MsgCourseMembers)
+        , prismAForm (singletonFilter "user-matriclenumber")  mPrev $ aopt textField (fslI MsgMatrikelNr)
+        , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
+          -- "pseudonym" TODO DB only stores Word24
+        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField             (fslI MsgRatingTime)
+        ]
+      psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
+  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Right shid)
     , autoAssignAction shid