feat(course-teaser): filter by open registration

This commit is contained in:
Sarah Vaupel 2019-08-09 16:31:50 +02:00
parent 7926f29da1
commit c2c12b9643

View File

@ -74,6 +74,7 @@ makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((),
=> _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
makeCourseTable whereClause colChoices psValidator = do
muid <- lift maybeAuthId
now <- liftIO getCurrentTime
let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
dbtSQLQuery qin@(course `E.InnerJoin` school) = do
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
@ -135,12 +136,12 @@ makeCourseTable whereClause colChoices psValidator = do
user <- lecturerQuery (course E.^. CourseId) t
E.where_ $ E.any (E.hasInfix (user E.^. UserSurname) . E.val) (criterias :: Set.Set Text)
)
-- , ( "openregistration", FilterColumn $ \(course `E.InnerJoin` _school) criterion -> case getLast (criterion :: Last Bool) of
-- Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-- -- TODO: get current time??
-- Just True -> (maybe (E.val True :: E.SqlExpr (E.Value Bool)) ((E.<=.) today) $ course E.^. CourseRegisterTo) E.&&. (maybe (E.val True :: E.SqlExpr (E.Value Bool)) ((E.>=.) today) $ course E.^. CourseRegisterFrom)
-- _ -> E.val False :: E.SqlExpr (E.Value Bool) -- TODO: rethink
-- )
, ( "openregistration", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterion -> case getLast (criterion :: Last Bool) of
Nothing -> E.val True
Just b -> let regTo = course E.^. CourseRegisterTo
regFrom = course E.^. CourseRegisterFrom
in (E.==.) (E.val b) $ (E.isNothing regTo E.||. E.val (Just now) E.<=. regTo) E.&&. E.val (Just now) E.>=. regFrom
)
, ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> course2Registered muid tExpr E.==. E.val needle
@ -157,7 +158,7 @@ makeCourseTable whereClause colChoices psValidator = do
, 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 "openregistration" . maybePrism _PathPiece) mPrev $ aopt checkboxField (fslI MsgCourseRegisterOpen)
, Just $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgCourseRegisterOpen)
, muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt boolField (fslI MsgCourseFilterRegistered))
]
, dbtStyle = def