Filters for Participant List added
This commit is contained in:
SJost
parent
913f4dea7c
commit
78ada75704
@ -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{..}
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user