From 484fa1cc632b16d21e694426ae6552dc9098a8f1 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 13 Sep 2019 12:57:30 +0200 Subject: [PATCH] feat(exam-office): course/user opt-outs --- messages/uniworx/de.msg | 3 + routes | 1 + src/Foundation.hs | 16 ++++ src/Handler/Course.hs | 1 + src/Handler/ExamOffice/Course.hs | 75 +++++++++++++++++++ src/Handler/Utils/ExamOffice/Course.hs | 32 ++++++++ src/Utils/Lens.hs | 2 + .../course-exam-office-explanation/de.hamlet | 24 ++++++ 8 files changed, 154 insertions(+) create mode 100644 src/Handler/ExamOffice/Course.hs create mode 100644 src/Handler/Utils/ExamOffice/Course.hs create mode 100644 templates/i18n/course-exam-office-explanation/de.hamlet diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 412152b30..bd8e45ac9 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1022,6 +1022,7 @@ MenuCourseMembers: Kursteilnehmer MenuCourseAddMembers: Kursteilnehmer hinzufügen MenuCourseCommunication: Kursmitteilung MenuCourseApplications: Bewerbungen +MenuCourseExamOffice: Prüfungsämter MenuTermShow: Semester MenuSubmissionDelete: Abgabe löschen MenuUsers: Benutzer @@ -1743,3 +1744,5 @@ TitleChangeUserDisplayEmail: Öffentliche E-Mail Adresse setzen MailSubjectChangeUserDisplayEmail: Diese E-Mail Adresse in Uni2work veröffentlichen MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte! MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail Adresse in Uni2work veröffentlichen + +ExamOfficeOptOutsChanged: Zuständige Prüfungsämter erfolgreich angepasst \ No newline at end of file diff --git a/routes b/routes index f19b94a9a..79b77524e 100644 --- a/routes +++ b/routes @@ -115,6 +115,7 @@ /correctors CHiWisR GET /communication CCommR GET POST /notes CNotesR GET POST !corrector -- THIS route is used to check for overall course corrector access! + /exam-office CExamOfficeR GET POST !course-registered /subs CCorrectionsR GET POST /subs/assigned CAssignR GET POST /sheet SheetListR GET !course-registered !materials !corrector diff --git a/src/Foundation.hs b/src/Foundation.hs index 2db44e9ad..05ff75797 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -67,6 +67,7 @@ import qualified Control.Monad.Catch as C import Handler.Utils.StudyFeatures import Handler.Utils.SchoolLdap import Handler.Utils.ExamOffice.Exam.Auth +import Handler.Utils.ExamOffice.Course import Handler.Utils.Profile import Utils.Form import Utils.Sheet @@ -1831,6 +1832,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CourseR tid ssh csh CUsersR) = return ("Anmeldungen", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CAddUserR) = return ("Kursteilnehmer hinzufügen", Just $ CourseR tid ssh csh CUsersR) breadcrumb (CourseR tid ssh csh CInviteR) = return ("Einladung", Just $ CourseR tid ssh csh CShowR) + breadcrumb (CourseR tid ssh csh CExamOfficeR) = return ("Prüfungsamter", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh (CUserR cID)) = do uid <- decrypt cID User{userDisplayName} <- runDB $ get404 uid @@ -2454,6 +2456,20 @@ pageActions (CourseR tid ssh csh CShowR) = , menuItemModal = False , menuItemAccessCallback' = return True } + , MenuItem + { menuItemType = PageActionSecondary + , menuItemLabel = MsgMenuCourseExamOffice + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CExamOfficeR + , menuItemModal = True + , menuItemAccessCallback' = do + uid <- requireAuthId + runDB $ do + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + E.selectExists $ do + (_school, isForced) <- courseExamOfficeSchools (E.val uid) (E.val cid) + E.where_ $ E.not_ isForced + } ] pageActions (CourseR tid ssh csh CCorrectionsR) = [ MenuItem diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 93b837fa9..241aba4cf 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -16,6 +16,7 @@ import Handler.Course.Show as Handler.Course import Handler.Course.User as Handler.Course import Handler.Course.Users as Handler.Course import Handler.Course.Application as Handler.Course +import Handler.ExamOffice.Course as Handler.Course getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html diff --git a/src/Handler/ExamOffice/Course.hs b/src/Handler/ExamOffice/Course.hs new file mode 100644 index 000000000..3b212e7f5 --- /dev/null +++ b/src/Handler/ExamOffice/Course.hs @@ -0,0 +1,75 @@ +module Handler.ExamOffice.Course + ( getCExamOfficeR, postCExamOfficeR + ) where + +import Import + +import qualified Data.Set as Set + +import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E + +import Handler.Utils.ExamOffice.Course +import Handler.Utils + + +examOfficeOptOutForm :: UserId -> CourseId -> Maybe (Set SchoolId) -> Form (Set SchoolId) +-- ^ Deals with sets of _opt outs_ +examOfficeOptOutForm uid cid (fromMaybe Set.empty -> template) = renderWForm FormStandard $ do + schools <- liftHandlerT . runDB . E.select $ courseExamOfficeSchools (E.val uid) (E.val cid) + + res <- fmap sequence . forM schools $ \(Entity ssh School{..}, E.Value isForced) + -> fmap (ssh, ) <$> (bool wpopt wforcedJust isForced) checkBoxField (fslI schoolName) (Just $ ssh `Set.notMember` template) + + return $ res <&> setOf (folded . filtered (not . view _2) . _1) + +getCExamOfficeR, postCExamOfficeR :: TermId -> SchoolId -> CourseShorthand -> Handler Html +getCExamOfficeR = postCExamOfficeR +postCExamOfficeR tid ssh csh = do + uid <- requireAuthId + isModal <- hasCustomHeader HeaderIsModal + + (cid, optOuts, hasForced) <- runDB $ do + cid <- getKeyBy404 (TermSchoolCourseShort tid ssh csh) + optOuts <- selectList [ CourseUserExamOfficeOptOutCourse ==. cid, CourseUserExamOfficeOptOutUser ==. uid ] [] + hasForced <- E.selectExists $ do + (_school, isForced) <- courseExamOfficeSchools (E.val uid) (E.val cid) + E.where_ isForced + return (cid, optOuts, hasForced) + + ((optOutRes, optOutView), optOutEnc) + <- runFormPost $ examOfficeOptOutForm uid cid (Just $ setOf (folded . _entityVal . _courseUserExamOfficeOptOutSchool) optOuts ) + + formResultModal optOutRes (CourseR tid ssh csh CExamOfficeR) $ \optOuts' -> do + lift . runDB $ do + deleteWhere [ CourseUserExamOfficeOptOutCourse ==. cid + , CourseUserExamOfficeOptOutUser ==. uid + , CourseUserExamOfficeOptOutSchool /<-. Set.toList optOuts' + ] + forM_ optOuts' $ \ssh' -> + void $ insertUnique CourseUserExamOfficeOptOut + { courseUserExamOfficeOptOutCourse = cid + , courseUserExamOfficeOptOutUser = uid + , courseUserExamOfficeOptOutSchool = ssh' + } + tell . pure =<< messageI Success MsgExamOfficeOptOutsChanged + + + let optOutView' = wrapForm optOutView def + { formAction = Just . SomeRoute $ CourseR tid ssh csh CExamOfficeR + , formEncoding = optOutEnc + , formAttrs = [ asyncSubmitAttr | isModal ] + } + + siteLayoutMsg MsgMenuCourseExamOffice $ do + setTitleI MsgMenuCourseExamOffice + + let explanation = $(i18nWidgetFile "course-exam-office-explanation") + + [whamlet| + $newline never +
+ ^{explanation} +
+ ^{optOutView'} + |] diff --git a/src/Handler/Utils/ExamOffice/Course.hs b/src/Handler/Utils/ExamOffice/Course.hs new file mode 100644 index 000000000..f5613bfb0 --- /dev/null +++ b/src/Handler/Utils/ExamOffice/Course.hs @@ -0,0 +1,32 @@ +module Handler.Utils.ExamOffice.Course + ( courseExamOfficeSchools + ) where + +import Import.NoFoundation + +import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E + + +courseExamOfficeSchools :: E.SqlExpr (E.Value UserId) + -> E.SqlExpr (E.Value CourseId) + -> E.SqlQuery (E.SqlExpr (Entity School), E.SqlExpr (E.Value Bool)) -- ^ @Entity School@ and @forced@ +courseExamOfficeSchools user _course = E.from $ \(school `E.InnerJoin` userFunction `E.InnerJoin` (examOfficeField `E.FullOuterJoin` examOfficeUser)) + -> E.distinctOnOrderBy [E.asc $ userFunction E.^. UserFunctionSchool] $ do + E.on E.false + E.on $ ( examOfficeUser E.?. ExamOfficeUserUser E.==. E.just user + E.&&. examOfficeUser E.?. ExamOfficeUserOffice E.==. E.just (userFunction E.^. UserFunctionUser) + ) + E.||. ( examOfficeField E.?. ExamOfficeFieldOffice E.==. E.just (userFunction E.^. UserFunctionUser) + E.&&. E.exists ( E.from $ \studyFeatures -> + E.where_ $ E.just (studyFeatures E.^. StudyFeaturesField) E.==. examOfficeField E.?. ExamOfficeFieldField + E.&&. studyFeatures E.^. StudyFeaturesUser E.==. user + ) + ) + E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool + E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice + + let forced = E.maybe E.true id $ examOfficeField E.?. ExamOfficeFieldForced + + E.orderBy [E.desc forced] + return $ (school, forced) diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 6e1fd70a3..b7dc95ef0 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -190,6 +190,8 @@ makeLenses_ ''School makeLenses_ ''SchoolLdap makeLenses_ ''UserFunction + +makeLenses_ ''CourseUserExamOfficeOptOut -- makeClassy_ ''Load diff --git a/templates/i18n/course-exam-office-explanation/de.hamlet b/templates/i18n/course-exam-office-explanation/de.hamlet new file mode 100644 index 000000000..f6916abac --- /dev/null +++ b/templates/i18n/course-exam-office-explanation/de.hamlet @@ -0,0 +1,24 @@ +$newline never +

+ Hier können Sie der Meldung ihrer Prüfungsleistungen an Prüfungsämter # + bestimmter Institute (innerhalb von Uni2work) widersprechen. +

+ Bedenken Sie, dass die Meldung der Prüfungsleistungen direkt in Uni2work den # + Verwaltungsaufwand (und die damit verbunden Dauer) für die ordnungsgemäße # + Anrechung Ihrer Leistungen drastisch reduziert. +

+ Unter Umständen können Prüfungsämter ungeachtet der Angaben, die Sie hier # + machen, Einsicht in Ihre Leistungen erlangen.
+ Dies geschieht nur in begründeten Einzelfällen (z.B. bei Studierenden im # + ERASMUS-Programm). +

+ Nutzer, die unabhängig von diesen Einstellungen, Einsicht in Ihre # + Prüfungsleistungen haben (z.B. die Kursverwalter) können Ihre Note natürlich # + außerhalb von Uni2work an Prüfungsämter melden (auch solche, die hier nicht # + aufgeführt sind). +$if hasForced +

+ Wenn Sie der Meldung an einzelne Prüfungsämter nicht widersprechen können, # + so hat das jeweilige Prüfungsamt angegeben, dass die Einsicht, entweder # + aufgrund einer Ihrer Studiengänge (z.B. aufgrund der Studienordnung) oder # + bei Ihnen spezifisch, zwingend erforderlich ist.