module Handler.Exam.New ( getCExamNewR, postCExamNewR ) where import Import import Handler.Exam.Form import Handler.Exam.CorrectorInvite import qualified Data.Set as Set import Handler.Utils import Handler.Utils.Invitations import Jobs.Queue getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCExamNewR = postCExamNewR postCExamNewR tid ssh csh = do (cid, template) <- runDB $ do cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh template <- examTemplate cid return (cid, template) ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm validateExam $ examForm template formResult newExamResult $ \ExamForm{..} -> do insertRes <- runDBJobs $ do insertRes <- insertUnique Exam { examName = efName , examCourse = cid , examGradingRule = efGradingRule , examBonusRule = efBonusRule , examOccurrenceRule = efOccurrenceRule , examVisibleFrom = efVisibleFrom , examRegisterFrom = efRegisterFrom , examRegisterTo = efRegisterTo , examDeregisterUntil = efDeregisterUntil , examPublishOccurrenceAssignments = efPublishOccurrenceAssignments , examStart = efStart , examEnd = efEnd , examFinished = efFinished , examClosed = Nothing , examShowGrades = efShowGrades , examPublicStatistics = efPublicStatistics , examDescription = efDescription } whenIsJust insertRes $ \examid -> do insertMany_ [ ExamPart{..} | ExamPartForm{..} <- Set.toList efExamParts , let examPartExam = examid examPartNumber = epfNumber examPartName = epfName examPartMaxPoints = epfMaxPoints examPartWeight = epfWeight ] insertMany_ [ ExamOccurrence{..} | ExamOccurrenceForm{..} <- Set.toList efOccurrences , let examOccurrenceExam = examid examOccurrenceName = eofName examOccurrenceRoom = eofRoom examOccurrenceCapacity = eofCapacity examOccurrenceStart = eofStart examOccurrenceEnd = eofEnd examOccurrenceDescription = eofDescription ] let (invites, adds) = partitionEithers $ Set.toList efCorrectors insertMany_ [ ExamCorrector{..} | examCorrectorUser <- adds , let examCorrectorExam = examid ] sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites return insertRes case insertRes of Nothing -> addMessageI Error $ MsgExamNameTaken efName Just _ -> do addMessageI Success $ MsgExamCreated efName redirect $ CourseR tid ssh csh CExamListR let heading = prependCourseTitle tid ssh csh MsgExamNew siteLayoutMsg heading $ do setTitleI heading let newExamForm = wrapForm newExamWidget def { formMethod = POST , formAction = Just . SomeRoute $ CourseR tid ssh csh CExamNewR , formEncoding = newExamEnctype } $(widgetFile "exam-new")