chore(tutorial): assigning exam occurrences may check duplicate examiners

towards #2347

messages/uniworx/categories/courses/courses/de-de-formal.msg

@@ -138,7 +138,8 @@ CourseUserNoTutorialsDeregistered: Teilnehmer:in ist zu keinem der gewählten Ku
 CourseUserTutorials: Angemeldete Kurse
 CourseUserExams: Angemeldete Prüfungen
 CourseUserExamOccurrences: Prüfungstermin
-CourseUserExamOccurrenceOverride: Ggf. vorhanden Prüfungstermin überschreiben
+CourseUserExamOccurrenceOverride: Ggf. vorhandenen Prüfungstermin überschreiben
+CourseUserExamOccurrenceAgainExaminer: Ggf. vorherige Prüfer erneut erlauben
 CourseUserSheets: Übungsblätter
 CsvColumnUserName: Voller Name des/der Teilnehmers/Teilnehmerin
 CsvColumnUserMatriculation: AVS Nummer des/der Teilnehmers/Teilnehmerin

messages/uniworx/categories/courses/courses/en-eu.msg

@@ -139,6 +139,7 @@ CourseUserTutorials: Registered courses
 CourseUserExams: Registered exams
 CourseUserExamOccurrences: Exam occurrence
 CourseUserExamOccurrenceOverride: Override other registrations for this exam, if any
+CourseUserExamOccurrenceAgainExaminer: Possibly allow previous examiners again
 CourseUserSheets: Exercise sheets
 CsvColumnUserName: Participant's full name
 CsvColumnUserMatriculation: Participant's AVS number

messages/uniworx/categories/courses/exam/exam/de-de-formal.msg

@@ -87,7 +87,7 @@ ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
 ExamRoomName: Interne Bezeichnung
 ExamRoomCapacity: Kapazität
 ExamRoomCapacityNegative: Kapazität darf nicht negativ sein
-ExamRommCapacityInsufficient n@Int: Kapazität reicht nicht aus, nur noch #{n} Plätze verfügbar
+ExamRoomCapacityInsufficient n@Int: Kapazität reicht nicht aus, #{noneOneMoreDE n "keine Plätze" "nur noch ein Platz" ("nur noch " <> tshow n <> " Plätze")} verfügbar
 ExamRoomTime: Termin
 ExamRoomStart: Beginn
 ExamRoomEnd: Ende

messages/uniworx/categories/courses/exam/exam/en-eu.msg

@@ -87,7 +87,7 @@ ExamRoomAlreadyExists: Occurrence already configured
 ExamRoomName: Internal name
 ExamRoomCapacity: Capacity
 ExamRoomCapacityNegative: Capacity may not be negative
-ExamRommCapacityInsufficient n@Int: Insufficient capacity, only #{n} remaining
+ExamRoomCapacityInsufficient n@Int: Insufficient capacity, #{noneOneMoreEN n "none" "just one" ("only " <> tshow n)} remaining
 ExamRoomTime: Time
 ExamRoomStart: Start
 ExamRoomEnd: End

src/Handler/Tutorial/Users.hs

@@ -32,6 +32,7 @@ import qualified Data.ByteString.Lazy as LBS
 
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
+import qualified Database.Esqueleto.Utils        as E
 
 import Handler.Course.Users
 
@@ -61,8 +62,9 @@ data TutorialUserActionData
   | TutorialUserSendMailData
   | TutorialUserDeregisterData
   | TutorialUserAssignExamData
-    { tuOccurrenceId :: ExamOccurrenceId
+    { tuOccurrenceId  :: ExamOccurrenceId
-    , tuReassign   :: Bool
+    , tuExaminerAgain :: Bool
+    , tuReassign      :: Bool
     }
   deriving (Eq, Ord, Read, Show, Generic)
 
@@ -160,7 +162,8 @@ postTUsersR tid ssh csh tutn = do
             ( TutorialUserAssignExam
             , TutorialUserAssignExamData
                 <$> apopt (selectField $ pure $ mkExamOccurrenceOptions exOccs) (fslI MsgCourseUserExamOccurrences) Nothing
-                <*> apopt checkBoxField (fslI MsgCourseUserExamOccurrenceOverride) (Just False)
+                <*> apopt checkBoxField (fslI MsgCourseUserExamOccurrenceAgainExaminer) (Just False)
+                <*> apopt checkBoxField (fslI MsgCourseUserExamOccurrenceOverride)      (Just False)
             ) $
         (if null qualifications then mempty else
           [ ( TutorialUserRenewQualification
@@ -232,23 +235,40 @@ postTUsersR tid ssh csh tutn = do
           ]
         addMessageI Success $ MsgTutorialUsersDeregistered nrDel
         reloadKeepGetParams croute
-    (TutorialUserAssignExamData{..}, selectedUsers)
+    (TutorialUserAssignExamData{..}, setSelectedUsers)
       | (Just (ExamOccurrence{..}, _, (eid,_))) <- Map.lookup tuOccurrenceId exOccs -> do
-            let n = Set.size selectedUsers
+        assignRes <- runDB $ do
-            capOk <- ifNothing examOccurrenceCapacity (pure True) $ \(fromIntegral -> totalCap) -> do
+          (Set.toList &&& Set.size -> (selectedUsers, nr_usrs)) <- if -- remove duplicate examiners, if desired
-              usedCap <- runDBRead $ count [ExamRegistrationOccurrence ==. Just tuOccurrenceId, ExamRegistrationUser /<-. Set.toList selectedUsers]
+            | isJust examOccurrenceExaminer && not tuExaminerAgain -> do
-              let ok = totalCap - usedCap >= n
+              conflictingUsers <- E.select $ do
-              unless ok $ addMessageI Error $ MsgExamRommCapacityInsufficient $ totalCap - usedCap
+                reg :& occ <- E.from $  E.table @ExamRegistration
-              pure ok
+                          `E.innerJoin` E.table @ExamOccurrence
-            when capOk do
+                          `E.on` (\(reg :& occ) -> occ E.^. ExamOccurrenceId E.=?. reg E.^. ExamRegistrationOccurrence)
-              let regTemplate uid = ExamRegistration eid uid (Just tuOccurrenceId) now
+                E.where_ $ occ E.^. ExamOccurrenceExaminer E.==. E.val examOccurrenceExaminer
-              nrOk <- runDB $ if tuReassign
+                  E.&&.    occ E.^. ExamOccurrenceExam     E.!=. E.val examOccurrenceExam
-                      then putMany [regTemplate uid | uid <- Set.toList selectedUsers] >> pure n
+                  E.&&.   (reg E.^. ExamRegistrationUser `E.in_` E.vals setSelectedUsers)
-                      else forM (Set.toList selectedUsers) (insertUnique . regTemplate) <&> (length . catMaybes)
+                E.orderBy [E.asc $ reg E.^. ExamRegistrationUser]
-              let allok = bool Warning Success $ nrOk == n
+                E.distinct $ pure $ reg E.^. ExamRegistrationUser
-              addMessageI allok $ MsgTutorialUserExamAssignedFor nrOk n $ ciOriginal examOccurrenceName
+              return $ setSelectedUsers `Set.difference` Set.fromAscList (E.unValue <$> conflictingUsers)
-              reloadKeepGetParams croute
+            | otherwise -> return setSelectedUsers
+          runExceptT $ do
+            whenIsJust examOccurrenceCapacity $ \(fromIntegral -> totalCap) -> do
+              usedCap <- lift $ count [ExamRegistrationOccurrence ==. Just tuOccurrenceId, ExamRegistrationUser /<-. selectedUsers]
+              let remCap = totalCap - usedCap
+              when (nr_usrs > remCap) $ throwE $ MsgExamRoomCapacityInsufficient remCap
+            let regTemplate uid = ExamRegistration eid uid (Just tuOccurrenceId) now
+            lift $ if tuReassign
+              then putMany [regTemplate uid | uid <- selectedUsers] >> pure nr_usrs
+              else forM selectedUsers (insertUnique . regTemplate) <&> (length . catMaybes)
+        case assignRes of
+          Left errm   -> do
+            addMessageI Error errm
             return Nothing
+          Right nrOk  -> do
+            let total = Set.size setSelectedUsers
+                allok = bool Warning Success $ nrOk == total
+            addMessageI allok $ MsgTutorialUserExamAssignedFor nrOk total $ ciOriginal examOccurrenceName
+            reloadKeepGetParams croute
     _other -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing
 
   case tcontent of