From 9dfd91b2f864424cf940259890afb8bf8cb0fdcf Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Jun 2023 14:39:55 +0000 Subject: [PATCH] fix(course): fix #28 by allowing course deletion with inactive participants only --- .../courses/participants/de-de-formal.msg | 4 +++- .../categories/courses/participants/en-eu.msg | 4 +++- .../utils/navigation/menu/de-de-formal.msg | 3 ++- .../uniworx/utils/navigation/menu/en-eu.msg | 3 ++- models/courses.model | 8 +++---- models/exams.model | 2 +- src/Foundation/Navigation.hs | 2 +- src/Handler/Course/Delete.hs | 22 ++++++++++++++----- test/Database/Fill.hs | 3 ++- 9 files changed, 35 insertions(+), 16 deletions(-) diff --git a/messages/uniworx/categories/courses/participants/de-de-formal.msg b/messages/uniworx/categories/courses/participants/de-de-formal.msg index c6c6f894b..3df5414d9 100644 --- a/messages/uniworx/categories/courses/participants/de-de-formal.msg +++ b/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 \ No newline at end of file +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. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/participants/en-eu.msg b/messages/uniworx/categories/courses/participants/en-eu.msg index aef9a3ae1..5c98bb4e4 100644 --- a/messages/uniworx/categories/courses/participants/en-eu.msg +++ b/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 \ No newline at end of file +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. \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 492791412..abc748e02 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 4ac9d668e..81ca762a8 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/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 diff --git a/models/courses.model b/models/courses.model index 95fb7cf60..ded2013dd 100644 --- a/models/courses.model +++ b/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 diff --git a/models/exams.model b/models/exams.model index 969b85455..e7dae4212 100644 --- a/models/exams.model +++ b/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 diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 6524a442a..5f91b778b 100644 --- a/src/Foundation/Navigation.hs +++ b/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 } diff --git a/src/Handler/Course/Delete.hs b/src/Handler/Course/Delete.hs index eae56855a..5fc16849f 100644 --- a/src/Handler/Course/Delete.hs +++ b/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 + } diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index dbcc97c35..3f5567400 100644 --- a/test/Database/Fill.hs +++ b/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