feat: warnings about multiple terms/schools

messages/uniworx/de-de-formal.msg

@@ -142,9 +142,11 @@ CourseDescriptionTip: Beliebiges Html-Markup ist gestattet
 CourseHomepageExternal: Externe Homepage
 CourseShorthand: Kürzel
 CourseShorthandUnique: Muss nur innerhalb Institut und Semester eindeutig sein. Wird verbatim in die Url der Kursseite übernommen.
+CourseSemesterMultipleTip: Es stehen für Sie aktuell mehrere Semester zur Auswahl. Stellen Sie bitte sicher, dass Sie das für den Kurs korrekte Semester wählen.
 CourseSemester: Semester
 CourseSchool: Institut
 CourseSchoolShort: Institut
+CourseSchoolMultipleTip: Es stehen für Sie mehrere Institute zur Auswahl. Stellen Sie bitte sicher, dass Sie das für den Kurs korrekte Institut wählen.
 CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
 CourseSecretFormat: beliebige Zeichenkette
 CourseRegisterFromTip: Ohne Datum ist keine eigenständige Anmeldung von Studierenden erlaubt.

messages/uniworx/en-eu.msg

@@ -142,9 +142,11 @@ CourseDescriptionTip: You may use arbitrary Html-Markup
 CourseHomepageExternal: External homepage
 CourseShorthand: Shorthand
 CourseShorthandUnique: Needs to be unique within school and semester. Will be used verbatim within the url of the course page.
+CourseSemesterMultipleTip: You are currently allowed to select from among multiple semesters. Please ensure that you select the appropriate semester for your course.
 CourseSemester: Semester
 CourseSchool: Department
 CourseSchoolShort: Department
+CourseSchoolMultipleTip: You may select from among multiple departments. Please ensure that you select the appropriate department for your course.
 CourseSecretTip: Enrollment for this course will require the password, if set
 CourseSecretFormat: Arbitrary string
 CourseRegisterFromTip: When left empty students will not be able to enrol themselves

src/Handler/Course/Edit.hs

@@ -115,16 +115,18 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
       return (lecturerSchools, adminSchools, oldSchool)
     let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
 
-    termsField <- case template of
+    (termsField, userTerms) <- liftHandler $ case template of
-          -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
+      -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
-          (Just cform)  | (Just cid) <- cfCourseId cform -> liftHandler $ do -- edit existing course
+      (Just cform)  | (Just cid) <- cfCourseId cform -> do -- edit existing course
-              _courseOld@Course{..} <- runDB $ get404 cid
+          _courseOld@Course{..} <- runDB $ get404 cid
-              mayEditTerm <- isAuthorized TermEditR True
+          mayEditTerm <- isAuthorized TermEditR True
-              mayDelete   <- isAuthorized (CourseR courseTerm courseSchool courseShorthand CDeleteR) True
+          mayDelete   <- isAuthorized (CourseR courseTerm courseSchool courseShorthand CDeleteR) True
-              return $ if
+          if
-                | (mayEditTerm == Authorized) || (mayDelete == Authorized) -> termsAllowedField
+            | (mayEditTerm == Authorized) || (mayDelete == Authorized)
-                | otherwise ->  termsSetField [cfTerm cform]
+              -> (termsAllowedField, ) <$> runDB (selectKeysList [TermActive ==. True] [])
-          _allOtherCases -> return termsAllowedField
+            | otherwise
+              -> return (termsSetField [cfTerm cform], [cfTerm cform])
+      _allOtherCases -> (termsAllowedField, ) <$> runDB (selectKeysList [TermActive ==. True] [])
 
     let miAdd :: ListPosition -> Natural -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
         miAdd _ _ nudge btn = Just $ \csrf -> do
@@ -258,13 +260,18 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
 
     -- let autoUnzipInfo = [|Entpackt hochgeladene Zip-Dateien (*.zip) automatisch und fügt den Inhalt dem Stamm-Verzeichnis der Abgabe hinzu. TODO|]
 
+    multipleSchoolsMsg <- messageI Warning MsgCourseSchoolMultipleTip
+    multipleTermsMsg <- messageI Warning MsgCourseSemesterMultipleTip
+
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
       <$> pure (cfCourseId =<< template)
       <*> areq (textField & cfStrip & cfCI) (fslI MsgCourseName)                             (cfName       <$> template)
       <*> areq (textField & cfStrip & cfCI) (fslpI MsgCourseShorthand "ProMo, LinAlg1, AlgoDat, Ana2, EiP, …"
             -- & addAttr "disabled" "disabled"
             & setTooltip MsgCourseShorthandUnique)                      (cfShort      <$> template)
+      <*  bool (pure ()) (aformMessage multipleSchoolsMsg) (length userSchools > 1)
       <*> areq (schoolFieldFor userSchools)   (fslI MsgCourseSchool)    (cfSchool     <$> template)
+      <*  bool (pure ()) (aformMessage multipleTermsMsg) (length userTerms > 1)
       <*> areq termsField                     (fslI MsgCourseSemester)  (cfTerm       <$> template)
       <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder)
                          & setTooltip MsgCourseDescriptionTip)          (cfDesc       <$> template)