94 lines
3.5 KiB
Haskell
94 lines
3.5 KiB
Haskell
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 = efClosed
|
|
, examShowGrades = efShowGrades
|
|
, examPublicStatistics = efPublicStatistics
|
|
, examDescription = efDescription
|
|
}
|
|
whenIsJust insertRes $ \examid -> do
|
|
insertMany_
|
|
[ ExamPart{..}
|
|
| ExamPartForm{..} <- Set.toList efExamParts
|
|
, let examPartExam = examid
|
|
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")
|