From b8acc9b5da701bd0d17d9578ee2c9d4e835fc2d7 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <vaupel.sarah@campus.lmu.de>
Date: Mon, 10 Feb 2020 13:54:47 +0100
Subject: [PATCH] feat(course-users): allow for exam registration on CUsersR

---
 messages/uniworx/de-de-formal.msg |  3 +++
 messages/uniworx/en-eu.msg        |  3 +++
 src/Handler/Course/Users.hs       | 22 ++++++++++++++++++++++
 3 files changed, 28 insertions(+)

diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index 1a6b54a2d..832c31a53 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/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
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index 2b76cc741..ec1f07c68 100644
--- a/messages/uniworx/en-eu.msg
+++ b/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
diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs
index 551aeb679..8aaab1f73 100644
--- a/src/Handler/Course/Users.hs
+++ b/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