feat(exams): implement schedule-opt handlers

src/Handler/Exam/Schedule.hs

@@ -5,12 +5,41 @@ module Handler.Exam.Schedule
 
 import Import
 
+import Handler.Utils.Exam
+
 
 getEScheduleOptSetR, postEScheduleOptSetR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> ExamOccurrenceName -> Bool -> Handler Html
 getEScheduleOptSetR = postEScheduleOptSetR
-postEScheduleOptSetR _tid _ssh _csh _ename _eoname _opt = error "WIP"
+postEScheduleOptSetR tid ssh csh examn eoccn opt = do
+  uid <- requireAuthId
+
+  mResult <- runDB $ maybeT (return Nothing) $ do
+    eId <- lift $ fetchExamId tid ssh csh examn
+    eoId <- MaybeT . getKeyBy $ UniqueExamOccurrence eId eoccn
+    scheduleOpt <- lift $ upsert ExamOccurrenceScheduleOpt
+      { examOccurrenceScheduleOptExamOccurrence =  eoId
+      , examOccurrenceScheduleOptUser           =  uid
+      , examOccurrenceScheduleOptOpt            =  opt
+      }
+      [ ExamOccurrenceScheduleOptOpt            =. opt
+      ]
+    return $ Just scheduleOpt
+
+  case mResult of
+    Just (Entity _ ExamOccurrenceScheduleOpt{..}) -> addMessageI Success $ bool MsgScheduleOptOutSuccess MsgScheduleOptInSuccess examOccurrenceScheduleOptOpt
+    Nothing -> addMessageI Error MsgScheduleOptError
+  redirect $ CExamR tid ssh csh examn EShowR
 
 
 getEScheduleOptDelR, postEScheduleOptDelR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> ExamOccurrenceName -> Handler Html
 getEScheduleOptDelR = postEScheduleOptDelR
-postEScheduleOptDelR _tid _ssh _csh _ename _eoname = error "WIP"
+postEScheduleOptDelR tid ssh csh examn eoccn = do
+  uid <- requireAuthId
+
+  runDB $ maybeT (return ()) $ do
+    eId <- lift $ fetchExamId tid ssh csh examn
+    eoId <- MaybeT . getKeyBy $ UniqueExamOccurrence eId eoccn
+    lift . deleteBy $ UniqueExamOccurrenceScheduleOpt eoId uid
+
+  addMessageI Success MsgScheduleOptDeleteSuccess
+  redirect $ CExamR tid ssh csh examn EShowR