From 669c803105a8e06d55a02bcddde6e5325b5a29b9 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 29 May 2019 14:09:29 +0200 Subject: [PATCH] FilterUI for Submission (Part 1) --- .vscode/tasks.json | 5 +++++ src/Handler/Corrections.hs | 34 ++++++++++++++++++++++++++---- src/Handler/Utils/Table/Columns.hs | 2 +- 3 files changed, 36 insertions(+), 5 deletions(-) diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 9c9d0aef8..27205f38c 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -48,6 +48,11 @@ "type": "npm", "script": "yesod:lint", "problemMatcher": [] + }, + { + "type": "npm", + "script": "yesod:start", + "problemMatcher": [] } ] } \ No newline at end of file diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index ca358a335..681580f68 100644 --- a/src/Handler/Corrections.hs +++ b/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) diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index c4e4d7081..09db6649d 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/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)