feat(course-users): allow for exam registration on CUsersR

messages/uniworx/de-de-formal.msg

@@ -116,6 +116,7 @@ CourseStudyFeatureTip: Dient ausschließlich der Information der Kursverwalter
 CourseStudyFeatureUpdated: Assoziiertes Studienfach geändert
 CourseStudyFeatureNone: Kein assoziiertes Studienfach
 CourseTutorial: Tutorium
+CourseExam: Prüfung
 CourseSecretWrong: Falsches Passwort
 CourseSecret: Zugangspasswort
 CourseEditOk       tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} wurde erfolgreich geändert.
@@ -167,7 +168,9 @@ CourseUserRegister: Zum Kurs anmelden
 CourseUserDeregister: Vom Kurs abmelden
 CourseUsersDeregistered count@Int64: #{show count} Teilnehmer vom Kurs abgemeldet
 CourseUserRegisterTutorial: Zu einem Tutorium anmelden
+CourseUserRegisterExam: Zu einer Prüfung anmelden
 CourseUsersTutorialRegistered count@Int64: #{show count} Teilnehmer zum Tutorium angemeldet
+CourseUsersExamRegistered count@Int64: #{show count} Teilnehmer zur Prüfung angemeldet
 CourseUserSendMail: Mitteilung verschicken
 TutorialUserDeregister: Vom Tutorium Abmelden
 TutorialUserSendMail: Mitteilung verschicken

messages/uniworx/en-eu.msg

@@ -116,6 +116,7 @@ CourseStudyFeatureTip: For information purposes only (visible to course administ
 CourseStudyFeatureUpdated: Successfully updated associated subject
 CourseStudyFeatureNone: No associated subject
 CourseTutorial: Tutorial
+CourseExam: Exam
 CourseSecretWrong: Wrong password
 CourseSecret: Access password
 CourseEditOk tid ssh csh: Successfully edited course #{tid}-#{ssh}-#{csh} 
@@ -168,6 +169,8 @@ CourseUserDeregister: Deregister from course
 CourseUsersDeregistered count: Successfully deregistered #{show count} users from course
 CourseUserRegisterTutorial: Register for a tutorial
 CourseUsersTutorialRegistered count: Successfully registered #{show count} users for tutorial
+CourseUserRegisterExam: Register for an exam
+CourseUsersExamRegistered count: Successfully registered #{show count} users for exam
 CourseUserSendMail: Send mail
 TutorialUserDeregister: Deregister from tutorial
 TutorialUserSendMail: Send mail

src/Handler/Course/Users.hs

@@ -255,6 +255,7 @@ userTableCsvHeader showSex UserCsvExportData{..} tuts = Csv.header $
 data CourseUserAction = CourseUserSendMail
                       | CourseUserDeregister
                       | CourseUserRegisterTutorial
+                      | CourseUserRegisterExam
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 instance Universe CourseUserAction
@@ -269,6 +270,9 @@ data CourseUserActionData = CourseUserSendMailData
                           | CourseUserRegisterTutorialData
                             { registerTutorial :: TutorialId
                             }
+                          | CourseUserRegisterExamData
+                            { registerExam :: ExamId
+                            }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
@@ -489,6 +493,10 @@ postCUsersR tid ssh csh = do
             apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [TutorialCourse ==. cid] [Asc TutorialName] tutorialName)
                   (fslI MsgCourseTutorial)
                   Nothing
+          , singletonMap CourseUserRegisterExam $ CourseUserRegisterExamData <$>
+            apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [ExamCourse ==. cid] [Asc ExamName] examName)
+                  (fslI MsgCourseExam)
+                  Nothing
           , if
               | mayRegister
                 -> singletonMap CourseUserDeregister $ courseUserDeregisterForm cid
@@ -520,6 +528,20 @@ postCUsersR tid ssh csh = do
           void . insertUnique . TutorialParticipant registerTutorial
         addMessageI Success . MsgCourseUsersTutorialRegistered . fromIntegral $ Set.size selectedUsers
         redirect $ CourseR tid ssh csh CUsersR
+    (CourseUserRegisterExamData{..}, selectedUsers) -> do
+        Sum nrReg <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> do
+          now <- liftIO getCurrentTime
+          -- TODO allow occurence
+          insert_ ExamRegistration
+            { examRegistrationExam       = registerExam
+            , examRegistrationUser       = uid
+            , examRegistrationOccurrence = Nothing
+            , examRegistrationTime       = now
+            }
+          audit $ TransactionExamRegister registerExam uid
+          return 1
+        addMessageI Success $ MsgCourseUsersExamRegistered nrReg
+        redirect $ CourseR tid ssh csh CUsersR
   let headingLong  = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|]
       headingShort = prependCourseTitle tid ssh csh MsgCourseMembers
   siteLayout headingLong $ do