From 78ada75704bd6061841e89b3abfbaf9cd9c81011 Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 12 Mar 2019 10:54:32 +0100 Subject: [PATCH] Filters for Participant List added --- src/Handler/Course.hs | 87 +++++++++++++++--------------- src/Handler/Utils/Table/Columns.hs | 22 ++++++++ 2 files changed, 67 insertions(+), 42 deletions(-) diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 35b635e17..4260a94b3 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -659,45 +659,10 @@ type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote)) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms))) -type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)) forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a) forceUserTableType = id -userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User) - , E.SqlExpr (E.Value UTCTime) - , E.SqlExpr (E.Value (Maybe (Key CourseUserNote))) - , StudyFeaturesDescription') - -userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do - -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis - features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures - E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser - E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId - E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid - return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features) - - -instance HasEntity UserTableData User where - hasEntity = _dbrOutput . _1 - -instance HasUser UserTableData where - -- hasUser = _entityVal - hasUser = _dbrOutput . _1 . _entityVal - -_userTableRegistration :: Lens' UserTableData UTCTime -_userTableRegistration = _dbrOutput . _2 - -_userTableNote :: Lens' UserTableData (Maybe CourseUserNoteId) -_userTableNote = _dbrOutput . _3 - -_userTableFeatures :: Lens' UserTableData (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms) -_userTableFeatures = _dbrOutput . _4 - -_rowUserSemester :: Traversal' UserTableData Int -_rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester - - -- Sql-Getters for this query, used for sorting and filtering (cannot be lenses due to being Esqueleto expressions) -- This ought to ease refactoring the query queryUser :: UserTableExpr -> E.SqlExpr (Entity User) @@ -722,6 +687,41 @@ queryFeaturesField :: (a `E.InnerJoin` b `E.InnerJoin` c) -> c queryFeaturesField = $(sqlIJproj 3 3) +userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User) + , E.SqlExpr (E.Value UTCTime) + , E.SqlExpr (E.Value (Maybe (Key CourseUserNote))) + , StudyFeaturesDescription') +userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do + -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis + features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures + E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser + E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId + E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid + return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features) + + +type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)) + +instance HasEntity UserTableData User where + hasEntity = _dbrOutput . _1 + +instance HasUser UserTableData where + -- hasUser = _entityVal + hasUser = _dbrOutput . _1 . _entityVal + +_userTableRegistration :: Lens' UserTableData UTCTime +_userTableRegistration = _dbrOutput . _2 + +_userTableNote :: Lens' UserTableData (Maybe CourseUserNoteId) +_userTableNote = _dbrOutput . _3 + +_userTableFeatures :: Lens' UserTableData (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms) +_userTableFeatures = _dbrOutput . _4 + +_rowUserSemester :: Traversal' UserTableData Int +_rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester + + colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) colUserComment tid ssh csh = sortable (Just "course-user-note") (i18nCell MsgCourseUserNote) @@ -755,7 +755,7 @@ makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget makeCourseUserTable cid colChoices psValidator = -- -- psValidator has default sorting and filtering let dbtIdent = "courseUsers" :: Text - dbtStyle = def + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtSQLQuery = userTableQuery cid dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms)) @@ -771,7 +771,7 @@ makeCourseUserTable cid colChoices psValidator = , ("course-user-field" , SortColumn $ queryUserFeatures >>> queryFeaturesField >>> (E.?. StudyTermsName)) , ("course-user-field-short" , SortColumn $ queryUserFeatures >>> queryFeaturesField >>> (E.?. StudyTermsShorthand)) , ("course-user-semesternr" , SortColumn $ queryUserFeatures >>> queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) - , ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration)) + , ("course-registration" , SortColumn $ queryParticipant >>> (E.^. CourseParticipantRegistration)) , ("course-user-note" , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date E.sub_select . E.from $ \edit -> do E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote) @@ -782,13 +782,16 @@ makeCourseUserTable cid colChoices psValidator = [ fltrUserNameLink queryUser , fltrUserEmail queryUser , fltrUserMatriclenr queryUser - , ("course-user-degree", error "TODO") -- TODO - , ("course-user-field" , error "TODO") -- TODO + -- , ("course-user-degree", error "TODO") -- TODO + -- , ("course-user-field" , error "TODO") -- TODO , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryUserFeatures >>> queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) - , ("course-registration", error "TODO") -- TODO - , ("course-user-note", error "TODO") -- TODO + -- , ("course-registration", error "TODO") -- TODO + -- , ("course-user-note", error "TODO") -- TODO + ] + dbtFilterUI = \mPrev -> mconcat + [ fltrUserNameLinkUI mPrev + , fltrUserMatriclenrUI mPrev ] - dbtFilterUI = mempty -- TODO dbtParams = def in dbTableWidget' psValidator DBTable{..} diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index 507ba10bf..b3791fe47 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -97,8 +97,23 @@ fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bo -> (d, FilterColumn t) fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)) +-- --TODO +-- fltrUserAny :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) +-- => (a -> E.SqlExpr (Entity User)) +-- -> (d, FilterColumn t) +-- fltrUserAny queryUser = ( "user-name-any", FilterColumn $ mkContainsFilter (queryAny . queryName)) +-- where +-- queryAny user = queryUser >>> (E.^. UserDisplayName) + +fltrUserNameLinkUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrUserNameLinkUI = fltrUserNameUI + +fltrUserNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrUserNameUI mPrev = + prismAForm (singletonFilter "user-name") mPrev $ aopt (searchField True) (fslI MsgCourseMembers) + ------------------- -- Matriclenumber colUserMatriclenr :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c) @@ -112,6 +127,9 @@ fltrUserMatriclenr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Boo -> (d, FilterColumn t) fltrUserMatriclenr queryUser = ( "user-matriclenumber", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserMatrikelnummer)) +fltrUserMatriclenrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrUserMatriclenrUI mPrev = + prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt (searchField False) (fslI MsgMatrikelNr) ---------------- @@ -127,4 +145,8 @@ fltrUserEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), -> (d, FilterColumn t) fltrUserEmail queryUser = ( "user-email", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserEmail)) +fltrUserEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrUserEmailUI mPrev = + prismAForm (singletonFilter "user-email") mPrev $ aopt (searchField False) (fslI MsgEMail) +