FilterUI for Submission (Part 1)

.vscode/tasks.json

@@ -48,6 +48,11 @@
       "type": "npm",
       "script": "yesod:lint",
       "problemMatcher": []
+    },
+    {
+      "type": "npm",
+      "script": "yesod:start",
+      "problemMatcher": []
     }
   ]
 }

src/Handler/Corrections.hs

@@ -35,7 +35,9 @@ import Data.Monoid (All(..))
 -- import qualified Data.UUID.Cryptographic as UUID
 -- import qualified Data.Conduit.List as C
 
+import Database.Esqueleto.Utils.TH
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Language (From)
 -- import qualified Database.Esqueleto.Internal.Sql as E
 
@@ -77,6 +79,9 @@ lastEditQuery submission = E.sub_select $ E.from $ \edit -> do
   E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
   return $ E.max_ $ edit E.^. SubmissionEditTime
 
+querySubmission :: CorrectionTableExpr -> E.SqlExpr (Entity Submission)
+querySubmission =  $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)
+
 -- Where Clauses
 ratedBy :: UserId -> CorrectionTableWhere
 ratedBy uid   ((_course `E.InnerJoin` _sheet `E.InnerJoin`  submission) `E.LeftOuterJoin` _corrector) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
@@ -325,6 +330,16 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
             Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
             Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
         )
+      , ( "user-name-email"
+        , 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.anyFilter
+                [ E.mkContainsFilter (E.^. UserSurname)
+                , E.mkContainsFilter (E.^. UserDisplayName)
+                , E.mkContainsFilter (E.^. UserEmail)
+                ]
+        )
       ]
     , dbtFilterUI  = fromMaybe mempty dbtFilterUI
     , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@@ -442,7 +457,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
                 [whamlet|_{MsgAssignSubmissionExceptionSubmissionsNotFound (length subCIDs)}|]
                 (Right $(widgetFile "messages/submissionsAssignNotFound"))
           addMessageWidget Error errorModal
-                
+
       handle assignExceptions . runDB $ do
         alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
         unless (null alreadyAssigned) $ do
@@ -583,8 +598,19 @@ postCCorrectionsR tid ssh csh = do
         , colCorrector
         , colAssigned
         ] -- Continue here
-      psValidator = def
-  correctionsR whereClause colonnade Nothing psValidator $ Map.fromList
+      filterUI = Just $ \mPrev -> mconcat
+        [ -- "name"
+          -- "matrikel"
+          -- "corrector"
+          -- "pseudonym" TODO
+          prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseMembers)
+        , 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
+  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Left cid)
     , deleteAction
@@ -607,7 +633,7 @@ postSSubsR tid ssh csh shn = do
         , colCorrector
         , colAssigned
         ]
-      psValidator = def
+      psValidator = def & defaultPagesize PagesizeAll
   correctionsR whereClause colonnade Nothing psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Right shid)

src/Handler/Utils/Table/Columns.hs

@@ -151,7 +151,7 @@ fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bo
   -> (d, FilterColumn t)
 fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName))
 
--- | Searche all names, i.e. DisplayName, Surname, EMail
+-- | Search all names, i.e. DisplayName, Surname, EMail
 fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
    => (a -> E.SqlExpr (Entity User))
    -> (d, FilterColumn t)