diff --git a/models/courses.model b/models/courses.model index ad28201f8..37c087866 100644 --- a/models/courses.model +++ b/models/courses.model @@ -29,6 +29,12 @@ Course -- Information about a single course; contained info is always visible TermSchoolCourseName term school name -- name must be unique within school and semester deriving Generic +CourseScheduleOpt -- opt-in/-out for displaying occurrence related to this course (may be overriden by specific occurrence opts) + course CourseId + user UserId + opt Bool + UniqueCourseScheduleOpt course user + CourseEvent type CourseEventType course CourseId diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index b9186f509..7b931bff8 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -20,6 +20,7 @@ import Handler.ExamOffice.Course as Handler.Course import Handler.Course.News as Handler.Course import Handler.Course.Events as Handler.Course import Handler.Sheet.PersonalisedFiles as Handler.Course (getCPersonalFilesR) +import Handler.Course.Schedule as Handler.Course getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html diff --git a/src/Handler/Course/Schedule.hs b/src/Handler/Course/Schedule.hs new file mode 100644 index 000000000..e809e74a4 --- /dev/null +++ b/src/Handler/Course/Schedule.hs @@ -0,0 +1,41 @@ +module Handler.Course.Schedule + ( getCScheduleOptSetR, postCScheduleOptSetR + , getCScheduleOptDelR, postCScheduleOptDelR + ) where + +import Import + + +getCScheduleOptSetR, postCScheduleOptSetR :: TermId -> SchoolId -> CourseShorthand -> Bool -> Handler Html +getCScheduleOptSetR = postCScheduleOptSetR +postCScheduleOptSetR tid ssh csh opt = do + uid <- requireAuthId + + mResult <- runDB $ maybeT (return Nothing) $ do + cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh + scheduleOpt <- lift $ upsert (CourseScheduleOpt + { courseScheduleOptCourse = cid + , courseScheduleOptUser = uid + , courseScheduleOptOpt = opt + }) + [ CourseScheduleOptOpt =. opt + ] + return $ Just scheduleOpt + + case mResult of + Just (Entity _ CourseScheduleOpt{..}) -> addMessageI Success $ bool MsgScheduleOptOutSuccess MsgScheduleOptInSuccess courseScheduleOptOpt + Nothing -> addMessageI Error MsgScheduleOptError + redirect $ CourseR tid ssh csh CShowR + + +getCScheduleOptDelR, postCScheduleOptDelR :: TermId -> SchoolId -> CourseShorthand -> Handler Html +getCScheduleOptDelR = postCScheduleOptDelR +postCScheduleOptDelR tid ssh csh = do + uid <- requireAuthId + + runDB $ maybeT (return ()) $ do + cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh + lift . deleteBy $ UniqueCourseScheduleOpt cid uid + + addMessageI Success MsgScheduleOptDeleteSuccess + redirect $ CourseR tid ssh csh CShowR