From e1996ac2e51d74db09c833b6c57a80fcdcb9f6bf Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 18 Jul 2019 09:35:42 +0200 Subject: [PATCH] feat(exams): allow assigning exam participants to occurrences --- messages/uniworx/de.msg | 6 +++++- src/Handler/Exam.hs | 34 ++++++++++++++++++++++++++++------ src/Handler/Utils/Form.hs | 10 ++++++++++ 3 files changed, 43 insertions(+), 7 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index e6081f4d2..5aeb92255 100644 --- a/messages/uniworx/de.msg +++ b/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 @@ -1213,4 +1215,6 @@ CsvColumnExamUserOccurrence: Prüfungstermin/-Raum, zu dem der Teilnehmer angeme CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb erreicht hat 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 \ No newline at end of file +CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können + +Action: Aktion \ No newline at end of file diff --git a/src/Handler/Exam.hs b/src/Handler/Exam.hs index 5b0e634c5..5116add70 100644 --- a/src/Handler/Exam.hs +++ b/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 formWgt = toWidget csrf <> fvInput vw - formRes = (, mempty) . First . Just <$> res + let + actionMap :: Map ExamUserAction (AForm Handler ExamUserActionData) + 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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 4243a318c..b7548543c 100644 --- a/src/Handler/Utils/Form.hs +++ b/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