feat(news): timeout sheets after a month

This commit is contained in:
Gregor Kleen 2020-04-27 10:44:04 +02:00
parent 3ea7371465
commit 31aa25a1fd

View File

@ -86,6 +86,8 @@ newsSystemMessages = do
newsUpcomingSheets :: UserId -> Widget
newsUpcomingSheets uid = do
cTime <- liftIO getCurrentTime
let noActiveToCutoff = toMidnight . addGregorianDurationRollOver (scaleCalendarDiffDays (-1) calendarMonth) $ utctDay cTime
let tableData :: E.LeftOuterJoin
(E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) (E.SqlExpr (Entity Course))) (E.SqlExpr (Entity Sheet)))
(E.InnerJoin (E.SqlExpr (Maybe (Entity Submission))) (E.SqlExpr (Maybe (Entity SubmissionUser))))
@ -101,8 +103,16 @@ newsUpcomingSheets uid = do
E.on $ submission E.?. SubmissionSheet E.==. E.just(sheet E.^. SheetId)
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
let showSheetNoActiveTo =
E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetActiveFrom)
E.||. E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetVisibleFrom)
E.||. E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetHintFrom)
E.||. E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetSolutionFrom)
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
E.&&. E.maybe E.true (E.>=. E.val cTime) (sheet E.^. SheetActiveTo)
E.&&. E.maybe showSheetNoActiveTo (E.>=. E.val cTime) (sheet E.^. SheetActiveTo)
return
( course E.^. CourseTerm
, course E.^. CourseSchool