diff --git a/src/Handler/Tutorial/Schedule.hs b/src/Handler/Tutorial/Schedule.hs index 4c84b6b4e..adc9c1b6d 100644 --- a/src/Handler/Tutorial/Schedule.hs +++ b/src/Handler/Tutorial/Schedule.hs @@ -5,12 +5,36 @@ module Handler.Tutorial.Schedule import Import +import Handler.Utils.Tutorial + getTScheduleOptSetR, postTScheduleOptSetR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Bool -> Handler Html getTScheduleOptSetR = postTScheduleOptSetR -postTScheduleOptSetR _tid _ssh _csh _tutn _opt = error "WIP" +postTScheduleOptSetR tid ssh csh tutn opt = do + uid <- requireAuthId + + runDB $ do + tutid <- fmap entityKey $ fetchTutorial tid ssh csh tutn + void $ upsert TutorialScheduleOpt + { tutorialScheduleOptTutorial = tutid + , tutorialScheduleOptUser = uid + , tutorialScheduleOptOpt = opt + } + [ TutorialScheduleOptOpt =. opt + ] + + addMessageI Success $ bool MsgScheduleOptOutSuccess MsgScheduleOptInSuccess opt + redirect $ CourseR tid ssh csh CShowR getTScheduleOptDelR, postTScheduleOptDelR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html getTScheduleOptDelR = postTScheduleOptDelR -postTScheduleOptDelR _tid _ssh _csh _tutn = error "WIP" +postTScheduleOptDelR tid ssh csh tutn = do + uid <- requireAuthId + + runDB $ do + tutid <- fmap entityKey $ fetchTutorial tid ssh csh tutn + deleteBy $ UniqueTutorialScheduleOpt tutid uid + + addMessageI Success MsgScheduleOptDeleteSuccess + redirect $ CourseR tid ssh csh CShowR