fix(course): fix #149 course cloning proposes associated qualifications

This commit required a massInput form, using massInputAccumEditA, which turned out to difficult to use.

messages/uniworx/categories/courses/courses/de-de-formal.msg

@@ -72,6 +72,7 @@ CourseEditOk       tid@TermId ssh@SchoolId csh@CourseShorthand: Kursart #{tid}-#
 CourseEditDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kursart #{tid}-#{ssh}-#{csh} konnte nicht geändert werden: Es gibt bereits einen andere Kursart mit dem selben Kürzel oder Titel in diesem Jahr und Bereich.
 CourseEditQualificationFail: Eine Qualifikation konnte uas unbekanntem Grund nicht mit diesem Kurs assoziert werden.
 CourseEditQualificationFailRights qsh@QualificationShorthand ssh@SchoolId: Qualifikation #{qsh} konnte nicht mit diesem Kurs assoziert werden, da Ihre Berechtigungen für Bereich #{ssh} dazu nicht ausreichen.
+CourseEditQualificationFailExists: Diese Qualifikation ist bereits assoziert
 CourseLecturer: Kursverwalter:in
 MailSubjectParticipantInvitation tid@TermId ssh@SchoolId csh@CourseShorthand: [#{tid}-#{ssh}-#{csh}] Einladung zur Kursartteilnahme
 CourseParticipantInviteHeading courseName@Text: Einladung zum Kursartteilnahmer für #{courseName}

messages/uniworx/categories/courses/courses/en-eu.msg

@@ -72,6 +72,7 @@ CourseEditOk tid ssh csh: Successfully edited course type #{tid}-#{ssh}-#{csh}
 CourseEditDupShort tid ssh csh: Could not edit course type #{tid}-#{ssh}-#{csh}. Another course type with the same shorthand or title already exists for the given year and school.
 CourseEditQualificationFail: A qualifikation could not be associated with this course for unknown reasons.
 CourseEditQualificationFailRights qsh ssh: Qualification #{qsh} could not be associated with this course, due to your insufficient rights for department #{ssh}.
+CourseEditQualificationFailExists: This qualification is already associated
 CourseLecturer: Course administrator
 MailSubjectParticipantInvitation tid ssh csh: [#{tid}-#{ssh}-#{csh}] Invitaion to join the course
 CourseParticipantInviteHeading courseName: Invitation to enrol for #{courseName}

messages/uniworx/misc/de-de-formal.msg

@@ -30,3 +30,4 @@ PaginationPage: Angzeigte Seite
 PaginationError: Paginierung Parameter dürfen nicht negativ sein
 
 NullDeletes: Zum Löschen NULL eingeben.
+SortPriority: Sortierungspriorität

messages/uniworx/misc/en-eu.msg

@@ -30,3 +30,4 @@ PaginationPage: Page to show
 PaginationError: Pagination parameter must not be negative
 
 NullDeletes:  Enter NULL to delete.
+SortPriority: Sort order priority

src/Handler/Course/Edit.hs

@@ -85,13 +85,23 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
     MsgRenderer mr <- getMsgRenderer
 
     uid <- liftHandler requireAuthId
-    (lecturerSchools, adminSchools, oldSchool) <- liftHandler . runDB $ do
+    (userSchools, elegibleQualifications) :: ([SchoolId], OptionList QualificationId) <- liftHandler . runDB $ do
-      lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] []
+      lecturerSchools   <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] []
-      protoAdminSchools  <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] []
+      protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]]    []
       adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
       oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust
-      return (lecturerSchools, adminSchools, oldSchool)
+      let elegibleSchools = Set.fromList $ lecturerSchools ++ adminSchools
-    let userSchools = nubOrd . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
+          userSchools = Set.toList $ maybe id Set.insert oldSchool elegibleSchools
+          q2opt :: Entity Qualification -> Option QualificationId
+          q2opt (Entity qid Qualification{..}) =
+            let qsh = CI.original $ unSchoolKey qualificationSchool
+            in  Option{ optionDisplay       =        CI.original qualificationName      <> " ("  <> qsh <> ")"
+                      , optionExternalValue = "(" <> CI.original qualificationShorthand <> "___" <> qsh <> ")"
+                      , optionInternalValue = qid
+                      }
+      elegibleQualifications <- selectList [QualificationSchool <-. Set.toList elegibleSchools] [Asc QualificationName, Asc QualificationSchool]
+      return (userSchools, mkOptionList (map q2opt elegibleQualifications))
+
 
     (termsField, userTerms) <- liftHandler $ case template of
       -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
@@ -166,6 +176,31 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
             miIdent :: Text
             miIdent = "lecturers"
 
+        qualificationsForm :: Maybe [(QualificationId, Int)] -> AForm Handler [(QualificationId, Int)] -- filter by admin school done later through upsertCourseQualifications
+        qualificationsForm = massInputAccumEditA miAdd miEdit miButtonAction miLayout miIdent (fslI $ MsgCourseQualifications 9) False
+          where
+            miIdent :: Text
+            miIdent = "qualifications"
+
+            miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([(QualificationId,Int)] -> FormResult [(QualificationId,Int)])
+            miAdd  nudge submitView csrf = do
+              (formRes, formView) <- aCourseQualiForm nudge Nothing csrf
+              let addRes = formRes <&> \newDat (Set.fromList -> oldDat) -> if
+                    | newDat `Set.member` oldDat -> FormFailure [mr MsgCourseEditQualificationFailExists]
+                    | otherwise -> FormSuccess $ pure newDat
+              return (addRes, $(widgetFile "widgets/massinput/courseQualifications/add"))
+
+            miEdit :: (Text -> Text) -> (QualificationId, Int) -> Form (QualificationId,Int)
+            miEdit nudge  = aCourseQualiForm nudge . Just
+
+            miLayout :: MassInputLayout ListLength (QualificationId,Int) (QualificationId, Int)
+            miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/courseQualifications/layout")
+
+            aCourseQualiForm :: (Text -> Text) -> Maybe (QualificationId, Int) -> Form (QualificationId, Int)
+            aCourseQualiForm nudge mTemplate csrf = do
+              (cquRes, cquView) <- mpreq (selectField $ pure elegibleQualifications) ("" & addName (nudge "cquali")) (view _1 <$> mTemplate)
+              (ordRes, ordView) <- mpreq     intField                                ("" & addName (nudge "cqordr")) (view _2 <$> mTemplate)
+              return ((,) <$> cquRes <*> ordRes, $(widgetFile "widgets/massinput/courseQualifications/form"))
 
     (newVisFrom,newRegFrom,newRegTo,newDeRegUntil) <- case template of
         (Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing,Nothing)
@@ -212,7 +247,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
             & setTooltip MsgCourseDeregisterUntilTip)                   (deepAlt (cfDeRegUntil <$> template) newDeRegUntil)
       <*  aformSection MsgCourseFormSectionAdministration
       <*> lecturerForm
-      <*> pure mempty -- TODO: continue here !!! -- TODO: Filterung nach aktueller Schule, da ansonsten ein Sicherheitleck droht! Siehe #150
+      <*> qualificationsForm (cfQualis <$> template)
     return (result, widget)
 
 

templates/widgets/massinput/courseQualifications/add.hamlet

@@ -0,0 +1,9 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+^{formView}
+<td .table__td>
+  ^{fvWidget submitView}

templates/widgets/massinput/courseQualifications/form.hamlet

@@ -0,0 +1,11 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<td .table__td>
+  #{csrf}
+  ^{fvWidget cquView}
+<td .table__td>
+  ^{fvWidget ordView}

templates/widgets/massinput/courseQualifications/layout.hamlet

@@ -0,0 +1,21 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2024 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<table .table .table--striped .table--hover>
+  <thead>
+    <tr .table__row .table__row--head>
+      <th .table__th>_{MsgTableQualification}
+      <th .table__th>_{MsgSortPriority}
+      <td>
+  <tbody>
+    $forall coord <- review liveCoords lLength
+      <tr .massinput__cell .table__row>
+        ^{cellWdgts ! coord}
+        <td>
+          ^{fvWidget (delButtons ! coord)}
+  <tfoot>
+    <tr .massinput__cell.massinput__cell--add>
+      ^{addWdgts ! (0, 0)}