From 1252a5fc79354df10bd0b8d17953fb306ae5024a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 2 Dec 2019 15:25:55 +0100 Subject: [PATCH] feat(external-exams): edit existing exams --- messages/uniworx/de-de-formal.msg | 5 +- messages/uniworx/en-eu.msg | 3 ++ src/Handler/ExternalExam/Edit.hs | 82 ++++++++++++++++++++++++++++++- src/Utils.hs | 3 ++ src/Utils/Lens.hs | 3 ++ 5 files changed, 93 insertions(+), 3 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 48ac52d8f..95cb9df15 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1260,6 +1260,8 @@ BreadcrumbExternalExamUsers: Teilnehmer BreadcrumbExternalExamGrades: Prüfungsleistungen BreadcrumbExternalExamStaffInvite: Einladung zum Prüfer +ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn} + TitleMetrics: Metriken AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren. @@ -2242,4 +2244,5 @@ ExternalExamStaffAlreadyAdded: Person wurde bereits der Prüfung hinzugefügt ExternalExamUserMustBeStaff: Sie selbst müssen stets assoziierte Person sein, für die externen Prüfungen, die Sie anlegen ExternalExamCourseExists: Der angegebene Kurs existiert im System. Prüfungen sollten daher direkt beim Kurs (statt extern) hinterlegt werden. ExternalExamExists coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ existiert bereits. -ExternalExamCreated coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich angelegt. \ No newline at end of file +ExternalExamCreated coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich angelegt. +ExternalExamEdited coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich bearbeitet. \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 7dc50cac4..5a8e0840f 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -1259,6 +1259,8 @@ BreadcrumbExternalExamUsers: Participants BreadcrumbExternalExamGrades: Exam results BreadcrumbExternalExamStaffInvite: Invitation +ExternalExamEdit coursen@CourseName examn@ExamName: Edit: #{coursen}, #{examn} + TitleMetrics: Metrics AuthPredsInfo: To view their own courses like a participant would, administrators and correctors can deactivate the checking of their credentials temporarily. Disabled authorisation predicates always fail. This means that deactivated predicates are not checked to grant access where it would otherwise not be permitted. These settings are only temporary, until your session expires i.e. your browser-cookie does. By deactivating predicates you can lock yourself out temporarily, at most. @@ -2242,3 +2244,4 @@ ExternalExamUserMustBeStaff: You yourself must always be an associated person fo ExternalExamCourseExists: This course already exists with uni2work. Exams for courses that exist within uni2work should be associated with the course directly instead of being created as an external exam. ExternalExamExists coursen@CourseName examn@ExamName: Exam “#{examn}” already exists for course “#{coursen}”. ExternalExamCreated coursen@CourseName examn@ExamName: Succesfully created exam “#{examn}” for course “#{coursen}”. +ExternalExamEdited coursen@CourseName examn@ExamName: Succesfully edited exam “#{examn}” for course “#{coursen}”. diff --git a/src/Handler/ExternalExam/Edit.hs b/src/Handler/ExternalExam/Edit.hs index d89987ab9..276a94815 100644 --- a/src/Handler/ExternalExam/Edit.hs +++ b/src/Handler/ExternalExam/Edit.hs @@ -4,9 +4,87 @@ module Handler.ExternalExam.Edit import Import -import Handler.ExternalExam.Form () +import Handler.Utils +import Handler.Utils.Invitations + +import Handler.ExternalExam.Form +import Handler.ExternalExam.StaffInvite + +import qualified Data.Set as Set +import qualified Data.Map as Map + +import Jobs.Queue getEEEditR, postEEEditR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html getEEEditR = postEEEditR -postEEEditR = error "Not implemented" +postEEEditR tid ssh coursen examn = do + (Entity eeId ExternalExam{..}, schools, staff) <- runDB $ do + eExam@(Entity eeId _) <- getBy404 $ UniqueExternalExam tid ssh coursen examn + schools <- setOf (folded . _entityVal . _externalExamOfficeSchoolSchool) <$> selectList [ ExternalExamOfficeSchoolExam ==. eeId ] [] + actualStaff <- selectList [ ExternalExamStaffExam ==. eeId ] [] + invitedStaff <- sourceInvitationsF @ExternalExamStaff eeId + let staff = setOf (folded . _entityVal . _externalExamStaffUser . re _Right) actualStaff + <> Set.mapMonotonic Left (Map.keysSet invitedStaff) + return (eExam, schools, staff) + + let + template = ExternalExamForm + { eefTerm = tid + , eefSchool = ssh + , eefCourseName = coursen + , eefExamName = examn + , eefDefaultTime = externalExamDefaultTime + , eefShowGrades = externalExamShowGrades + , eefOfficeSchools = schools + , eefStaff = staff + } + + ((examResult, examWidget'), examEnctype) <- runFormPost . externalExamForm $ Just template + + formResult examResult $ \ExternalExamForm{..} -> do + replaceRes <- runDBJobs $ do + replaceRes <- replaceUnique eeId ExternalExam + { externalExamTerm = eefTerm + , externalExamSchool = eefSchool + , externalExamCourseName = eefCourseName + , externalExamExamName = eefExamName + , externalExamDefaultTime = eefDefaultTime + , externalExamShowGrades = eefShowGrades + } + when (is _Nothing replaceRes) $ do + forM_ (eefStaff `setSymmDiff` staff) $ \change -> if + | change `Set.member` eefStaff -> case change of + Left invEmail -> + sinkInvitationsF externalExamStaffInvitationConfig + [(invEmail, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff))] + Right staffUid -> + insert_ $ ExternalExamStaff staffUid eeId + | otherwise -> case change of + Left invEmail -> + deleteInvitation @ExternalExamStaff eeId invEmail + Right staffUid -> + deleteBy $ UniqueExternalExamStaff eeId staffUid + + forM_ (eefOfficeSchools `setSymmDiff` schools) $ \change -> if + | change `Set.member` eefOfficeSchools -> + insert_ $ ExternalExamOfficeSchool change eeId + | otherwise -> + deleteBy $ UniqueExternalExamOfficeSchool eeId change + return replaceRes + + case replaceRes of + Nothing -> do + addMessageI Success $ MsgExternalExamEdited eefCourseName eefExamName + redirect $ EExamR eefTerm eefSchool eefCourseName eefExamName EEShowR + Just _ -> + addMessageI Error $ MsgExternalExamExists eefCourseName eefExamName + + let heading = MsgExternalExamEdit coursen examn + + siteLayoutMsg heading $ do + setTitleI heading + wrapForm examWidget' def + { formAction = Just . SomeRoute $ EExamR tid ssh coursen examn EEEditR + , formEncoding = examEnctype + } diff --git a/src/Utils.hs b/src/Utils.hs index f266cece4..dd9473692 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -381,6 +381,9 @@ setProduct :: Set a -> Set b -> Set (a, b) -- ^ Depends on the valid internal structure of the given sets setProduct (Set.toAscList -> as) (Set.toAscList -> bs) = Set.fromDistinctAscList $ (,) <$> as <*> bs +setPartitionEithers :: (Ord a, Ord b) => Set (Either a b) -> (Set a, Set b) +setPartitionEithers = (,) <$> setMapMaybe (preview _Left) <*> setMapMaybe (preview _Right) + ---------- -- Maps -- ---------- diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index e64bc46a7..28482cb8c 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -221,6 +221,9 @@ makeLenses_ ''Tutorial makeLenses_ ''SessionFile +makeLenses_ ''ExternalExamOfficeSchool +makeLenses_ ''ExternalExamStaff + -- makeClassy_ ''Load