fix(course): fix #28 by allowing course deletion with inactive participants only

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

@@ -12,4 +12,6 @@ ParticipantsCsvSheetName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTerm
 CourseParticipants n@Int: Derzeit #{n} angemeldete Kursartteilnehmer:innen
 ParticipantsIntersectNotOne: Schnitt 
 AllUsersUnion: Vereinigung aller Teilnehmer:innen
-AllUsersIntersection: Schnitt aller Teilneher:innen
+AllUsersIntersection: Schnitt aller Teilneher:innen
+CourseDeleteActiveParticipants: Diese Kursart hat noch aktive Kursteilnehmer und kann deshalb nicht gelöscht werden. Bitte zuerst alle aktiven Kursteilnehmer entfernen.
+CourseDeleteExistExams: Diese Kursart kann nicht gelöscht werden, so lange Prüfungen damit assoziiert werden.

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

@@ -12,4 +12,6 @@ ParticipantsCsvSheetName tid ssh: #{foldCase (termToText (unTermKey tid))}-#{fol
 CourseParticipants n: Currently #{n} course type #{pluralEN n "participant" "participants"}
 ParticipantsIntersectNotOne: Intersection
 AllUsersUnion: Union of all participants 
-AllUsersIntersection: Intersection of all participants 
+AllUsersIntersection: Intersection of all participants
+CourseDeleteActiveParticipants: This course type still has active participants. Remove all active participants first if you really want to delete this course.
+CourseDeleteExistExams: This course type cannot be deleted, for as long as associated exams exist.

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -27,7 +27,8 @@ MenuHelp: Hilfe
 MenuProfile: Anpassen
 MenuLogin !ident-ok: Login
 MenuLogout !ident-ok: Logout
-MenuCourseList: Kurse
+MenuCourseList: Kursarten
+MenuCourseIcon: Kurse
 MenuCourseMembers: Kursartteilnehmer:innen
 MenuCourseAddMembers: Kursartteilnehmer:innen hinzufügen
 MenuTutorialAddMembers: Kursteilnehmer:innen hinzufügen

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -27,7 +27,8 @@ MenuHelp: Support
 MenuProfile: Settings
 MenuLogin: Login
 MenuLogout: Logout
-MenuCourseList: Courses
+MenuCourseList: Course types
+MenuCourseIcon: Courses
 MenuCourseMembers: Participants
 MenuCourseAddMembers: Add course type participants
 MenuTutorialAddMembers: Add course participants

models/courses.model

@@ -57,7 +57,7 @@ Lecturer                       -- course ownership
     UniqueLecturer user course -- note: multiple lecturers per course are allowed, but no duplicated rows in this table
     deriving Generic
 CourseParticipant                      -- course enrolement
-    course       CourseId
+    course       CourseId OnDeleteCascade OnUpdateCascade
     user         UserId
     registration UTCTime               -- time of last enrolement for this course
     field        StudyFeaturesId Maybe MigrationOnly
@@ -73,7 +73,7 @@ CourseParticipant                      -- course enrolement
 --     editor       UserId        -- who edited this note last
 --     UniqueCourseUserNote user course
 CourseUserNote                 -- lecturers of a specific course may share a text note on each enrolled student
-    course       CourseId
+    course       CourseId OnDeleteCascade OnUpdateCascade
     user         UserId
     note         StoredMarkup  -- arbitrary user-defined text; visible only to lecturer of this course
     UniqueCourseUserNote user course
@@ -85,14 +85,14 @@ CourseUserNoteEdit             -- who edited a participants course note when
     deriving Generic
 
 CourseUserExamOfficeOptOut
-    course       CourseId
+    course       CourseId OnDeleteCascade OnUpdateCascade
     user         UserId
     school       SchoolId
     UniqueCourseUserExamOfficeOptOut course user school
     deriving Generic
 
 CourseQualification
-    course        CourseId
+    course        CourseId OnDeleteCascade OnUpdateCascade
     qualification QualificationId
     sortOrder     Int             default=0        --TODO: not yet used in Handler.Course.Users.makeCourseUserTable
     UniqueCourseQualification course qualification

models/exams.model

@@ -3,7 +3,7 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 Exam
-  course CourseId
+  course CourseId OnDeleteCascade OnUpdateCascade
   name ExamName
   gradingRule ExamGradingRule Maybe
   bonusRule ExamBonusRule Maybe

src/Foundation/Navigation.hs

@@ -679,7 +679,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       { navHeaderRole = NavHeaderPrimary
       , navIcon       = IconMenuCourseList
       , navLink       = NavLink
-        { navLabel       = MsgMenuCourseList
+        { navLabel       = MsgMenuCourseIcon
         , navRoute       = CourseListR
         , navAccess'     = NavAccessTrue
         , navType        = NavTypeLink { navModal = False }

src/Handler/Course/Delete.hs

@@ -17,8 +17,20 @@ import qualified Data.Set as Set
 getCDeleteR, postCDeleteR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCDeleteR = postCDeleteR
 postCDeleteR tid ssh csh = do
-  Entity cId _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
-  deleteR $ (courseDeleteRoute $ Set.singleton cId)
-    { drAbort = SomeRoute $ CourseR tid ssh csh CShowR
-    , drSuccess = SomeRoute $ TermSchoolCourseListR tid ssh
-    }
+  (cId, activeParticipants, existExams) <- runDB $ do
+    Entity cId _ <- getBy404 $ TermSchoolCourseShort tid ssh csh
+    activeParticipants <- exists [CourseParticipantState ==. CourseParticipantActive, CourseParticipantCourse ==. cId]
+    existExams <- exists [ExamCourse ==. cId]
+    return (cId, activeParticipants, existExams)
+  if 
+    | activeParticipants -> do
+      addMessageI Error MsgCourseDeleteActiveParticipants
+      redirect $ CourseR tid ssh csh CUsersR
+    | existExams -> do
+      addMessageI Error MsgCourseDeleteExistExams
+      redirect $ CourseR tid ssh csh CExamListR
+    | otherwise ->
+        deleteR $ (courseDeleteRoute $ Set.singleton cId)
+          { drAbort = SomeRoute $ CourseR tid ssh csh CShowR
+          , drSuccess = SomeRoute $ TermSchoolCourseListR tid ssh
+          }

test/Database/Fill.hs

@@ -1104,7 +1104,8 @@ fillDb = do
           , tutorialTutorControlled = True
           , tutorialFirstDay        = Just $ succ $ succ $ firstDay
           }
-        void . insert' $ Exam
+        when (odd tyear) $
+          void . insert' $ Exam
             { examCourse = c
             , examName = mkName "Theorieprüfung"
             , examGradingRule = Nothing