fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat(course-teaser-filter): filter for lecturers

Browse Source
This commit is contained in:
Sarah Vaupel 2019-08-06 17:33:48 +02:00
parent 3b419b3366
commit e96e17ff9f
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Handler/Course.hs
View File

@ -163,11 +163,11 @@ makeCourseTable whereClause colChoices psValidator = do
return (course, participants, registered, school) return (course, participants, registered, school)
lecturerQuery cid (user `E.InnerJoin` lecturer) = do lecturerQuery cid (user `E.InnerJoin` lecturer) = do
E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
E.where_ $ E.val cid E.==. lecturer E.^. LecturerCourse E.where_ $ cid E.==. lecturer E.^. LecturerCourse
return user return user
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do
lecturerList <- lift $ E.select $ E.from $ lecturerQuery $ entityKey course lecturerList <- lift $ E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
return (course, participants, registered, school, lecturerList) return (course, participants, registered, school, lecturerList)
snd <$> dbTable psValidator DBTable snd <$> dbTable psValidator DBTable
{ dbtSQLQuery { dbtSQLQuery
@ -204,12 +204,18 @@ makeCourseTable whereClause colChoices psValidator = do
-- ) -- )
, ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) -> , ( "school", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) ->
emptyOrIn $ school E.^. SchoolId -- TODO: Refactor all?! emptyOrIn $ school E.^. SchoolId -- TODO: Refactor all?!
-- mkExactFilter $ $(sqlIJProj 2 2) >>> (E.^. SchoolId) -- E.mkExactFilter $ $(sqlIJproj 2 2) >>> (E.^. SchoolId)
) )
, ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if , ( "schoolshort", FilterColumn $ \(_course `E.InnerJoin` school :: CourseTableExpr) criterias -> if
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool) | Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> school E.^. SchoolShorthand `E.in_` E.valList (Set.toList criterias) | otherwise -> school E.^. SchoolShorthand `E.in_` E.valList (Set.toList criterias)
) )
, ( "lecturer", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterias -> if
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> E.exists $ E.from $ \t -> do
user <- lecturerQuery (course E.^. CourseId) t
E.where_ $ E.any (E.hasInfix (user E.^. UserSurname) . E.val) (criterias :: Set.Set Text)
)
, ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of , ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> course2Registered muid tExpr E.==. E.val needle Just needle -> course2Registered muid tExpr E.==. E.val needle
@ -224,6 +230,7 @@ makeCourseTable whereClause colChoices psValidator = do
, dbtFilterUI = \mPrev -> mconcat $ catMaybes , dbtFilterUI = \mPrev -> mconcat $ catMaybes
[ Just $ prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTerm) [ Just $ prismAForm (singletonFilter "term" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift termField) (fslI MsgTerm)
, Just $ prismAForm (singletonFilter "schoolshort" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgCourseSchool) , Just $ prismAForm (singletonFilter "schoolshort" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgCourseSchool)
, Just $ prismAForm (singletonFilter "lecturer") mPrev $ aopt textField (fslI MsgCourseLecturer)
, Just $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgCourseFilterSearch) , Just $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgCourseFilterSearch)
, muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt boolField (fslI MsgCourseFilterRegistered)) , muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt boolField (fslI MsgCourseFilterRegistered))
] ]