feat(exams): allow assigning exam participants to occurrences

messages/uniworx/de.msg

@@ -1190,7 +1190,9 @@ KnownBugs: Bekannte Bugs
 
 ExamUsersHeading: Klausurteilnehmer
 ExamUserDeregister: Teilnehmer von Klausur abmelden
+ExamUserAssignOccurrence: Termin/Raum zuweisen
 ExamUsersDeregistered count@Int64: #{show count} Teilnehmer abgemeldet
+ExamUsersOccurrenceUpdated count@Int64: Termin/Raum für #{show count} Teilnehmer gesetzt
 
 CsvFile: CSV-Datei
 CsvModifyExisting: Existierende Einträge angleichen
@@ -1214,3 +1216,5 @@ CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übun
 CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Klausurtermin erreichen hätte können
 CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat
 CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
+
+Action: Aktion

src/Handler/Exam.hs

@@ -36,7 +36,7 @@ import qualified Data.Conduit.List as C
 
 import Numeric.Lens (integral)
 
-import Database.Persist.Sql (deleteWhereCount)
+import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
 
 
 
@@ -872,6 +872,7 @@ instance CsvColumnsExplained ExamUserTableCsv where
     ]
 
 data ExamUserAction = ExamUserDeregister
+                    | ExamUserAssignOccurrence
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 instance Universe ExamUserAction
@@ -879,6 +880,9 @@ instance Finite ExamUserAction
 nullaryPathPiece ''ExamUserAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''ExamUserAction id
 
+data ExamUserActionData = ExamUserDeregisterData
+                        | ExamUserAssignOccurrenceData (Maybe ExamOccurrenceId)
+
 getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEUsersR = postEUsersR
 postEUsersR tid ssh csh examn = do
@@ -957,9 +961,19 @@ postEUsersR tid ssh csh examn = do
             , dbParamsFormAttrs  = []
             , dbParamsFormSubmit = FormSubmit
             , dbParamsFormAdditional = \csrf -> do
-                (res, vw) <- mreq (selectField optionsFinite) "" Nothing
+                let
-                let formWgt = toWidget csrf <> fvInput vw
+                  actionMap :: Map ExamUserAction (AForm Handler ExamUserActionData)
-                    formRes = (, mempty) . First . Just <$> res
+                  actionMap = Map.fromList
+                    [ ( ExamUserDeregister
+                      , pure ExamUserDeregisterData
+                      )
+                    , ( ExamUserAssignOccurrence
+                      , ExamUserAssignOccurrenceData
+                        <$> aopt (examOccurrenceField eid) (fslI MsgExamOccurrence) (Just Nothing)
+                      )
+                    ]
+                (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
+                let formRes = (, mempty) . First . Just <$> res
                 return (formRes, formWgt)
             , dbParamsFormEvaluate = liftHandlerT . runFormPost
             , dbParamsFormResult   = id
@@ -984,7 +998,7 @@ postEUsersR tid ssh csh examn = do
 
       examUsersDBTableValidator = def
 
-      postprocess :: FormResult (First ExamUserAction, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserAction, Set ExamRegistrationId)
+      postprocess :: FormResult (First ExamUserActionData, DBFormResult ExamRegistrationId Bool ExamUserTableData) -> FormResult (ExamUserActionData, Set ExamRegistrationId)
       postprocess inp = do
         (First (Just act), regMap) <- inp
         let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
@@ -992,12 +1006,20 @@ postEUsersR tid ssh csh examn = do
     over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
 
   formResult registrationResult $ \case
-    (ExamUserDeregister, selectedRegistrations) -> do
+    (ExamUserDeregisterData, selectedRegistrations) -> do
       nrDel <- runDB $ deleteWhereCount
         [ ExamRegistrationId <-. Set.toList selectedRegistrations
         ]
       addMessageI Success $ MsgExamUsersDeregistered nrDel
       redirect $ CExamR tid ssh csh examn EUsersR
+    (ExamUserAssignOccurrenceData occId, selectedRegistrations) -> do
+      nrUpdated <- runDB $ updateWhereCount
+        [ ExamRegistrationId <-. Set.toList selectedRegistrations
+        ]
+        [ ExamRegistrationOccurrence =. occId
+        ]
+      addMessageI Success $ MsgExamUsersOccurrenceUpdated nrUpdated
+      redirect $ CExamR tid ssh csh examn EUsersR
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading

src/Handler/Utils/Form.hs

@@ -913,6 +913,16 @@ optionsPersistCryptoId filts ords toDisplay = fmap mkOptionList $ do
                  , optionExternalValue = toPathPiece (cId :: CryptoID UUID (Key a))
                  }) cPairs
 
+examOccurrenceField :: ( MonadHandler m
+                       , HandlerSite m ~ UniWorX
+                       )
+                    => ExamId
+                    -> Field m ExamOccurrenceId
+examOccurrenceField eid
+  = hoistField liftHandlerT . selectField . (fmap $ fmap entityKey)
+    $ optionsPersistCryptoId [ ExamOccurrenceExam ==. eid ] [ Asc ExamOccurrenceName ] examOccurrenceName
+
+
 formResultModal :: (MonadHandler m, RedirectUrl (HandlerSite m) route) => FormResult a -> route -> (a -> WriterT [Message] m ()) -> m ()
 formResultModal res finalDest handler = maybeT_ $ do
   messages <- case res of