Filters for Participant List added

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-degree", error "TODO") -- TODO
-        , ("course-user-field" , error "TODO") -- TODO
+        -- , ("course-user-field" , error "TODO") -- TODO
         , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryUserFeatures >>> queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
-        , ("course-registration", error "TODO") -- TODO
+        -- , ("course-registration", error "TODO") -- TODO
-        , ("course-user-note", 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{..}
 

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)
+