diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index a6ec9bc28..f558a6707 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -94,6 +94,8 @@ CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Kurs mit diesem Na CourseParticipantsRegisterNoneGiven: Es wurden keine anzumeldenden Personen angegeben! CourseParticipantsRegisterNotFoundInAvs n@Int: Zu #{n} #{pluralDE n "Angabe konnte keine übereinstimmende Person" "Angaben konnten keine übereinstimmenden Personen"} im AVS gefunden werden CourseParticipantsRegisterTutorialFirstDayTip: Wenn ein neuer Kurs gemäß einer Vorlage erstellt wird, werden die Zeiten gemäß dem Starttag angepasst +CourseParticipantsTutorialType: Typ der Vorlage +CourseParticipantsTutorialTypeTooltip: Ein neuer Kurs wird wie ein Kurs namens "Vorlage_[typ]" erstellt, wobei zuerst in der aktuellen Kursart, danach in Kursarten gleichen Namens und möglichst neuem Datum gesucht wird. CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt CourseParticipantsAlreadyRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits zur Kursart angemeldet diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index 841f064a4..02645c395 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -95,6 +95,8 @@ CourseParticipantsRegisterNoneGiven: No persons given to register! CourseParticipantsRegisterNotFoundInAvs n: For #{n} #{pluralEN n "entry no corresponding person" "entries no corresponding persons"} could be found in AVS CourseParticipantsRegisterTutorialFirstDayTip: If a new course is created and a template exists, its dates are adjusted according to the start date CourseParticipantsRegisterUnnecessary: All requested registrations have already been saved. No actions have been performed. +CourseParticipantsTutorialType: Template type +CourseParticipantsTutorialTypeTooltip: A new course creation copies a course named "Template_[typ]", preferably from the same course category or another having the same name, the most recent being preferred. CourseParticipantsInvited n: #{n} #{pluralEN n "invitation" "invitations"} sent via email CourseParticipantsAlreadyRegistered n: #{n} #{pluralEN n "participant is" "participants are"} already course category #{pluralEN n "member" "members"} diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index c7ef4d8a8..25fbca7e0 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -45,9 +45,11 @@ defaultTutorialType = "Schulung" tutorialTypeSeparator :: TutorialType tutorialTypeSeparator = "_" -tutorialTemplateNames :: Maybe TutorialType -> [TutorialType] -tutorialTemplateNames Nothing = ["Vorlage", "Template"] -tutorialTemplateNames (Just name) = [prefixes <> suffixes | prefixes <- tutorialTemplateNames Nothing, suffixes <- [mempty, tutorialTypeSeparator <> name]] +tutorialTypeSeparators :: [TutorialType] +tutorialTypeSeparators = tutorialTypeSeparator : ["-"] + +tutorialTemplateNames :: [TutorialType] +tutorialTemplateNames = ["Vorlage", "Template"] tutorialDefaultName :: Maybe TutorialType -> Day -> TutorialName tutorialDefaultName Nothing = formatDayForTutName @@ -166,7 +168,6 @@ postTAddUserR tid ssh csh tutn = handleAddUserR tid ssh csh (Left tutn) Nothing handleAddUserR :: TermId -> SchoolId -> CourseShorthand -> Either TutorialName Day -> Maybe TutorialType -> Handler Html handleAddUserR tid ssh csh tdesc ttyp = do (cEnt@Entity{entityKey=cid}, tutTypes, tutNameSuggestions) <- runDB $ do - let plainTemplates = tutorialTemplateNames Nothing cEnt@Entity{entityKey=cid} <- getBy404 $ TermSchoolCourseShort tid ssh csh tutTypes <- E.select $ E.distinct $ do tutorial <- E.from $ E.table @Tutorial @@ -174,18 +175,16 @@ handleAddUserR tid ssh csh tdesc ttyp = do E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid E.orderBy [E.asc tuTyp] return tuTyp - let typeSet = Set.fromList [ maybe t CI.mk $ Text.stripPrefix temp_sep $ CI.original t - | temp <- plainTemplates - , let temp_sep = CI.original (temp <> tutorialTypeSeparator) - , E.Value t <- tutTypes + let typeSet = Set.fromList [ maybe t CI.mk $ firstJust (`Text.stripPrefix` s) [CI.original $ tpl <> sep | sep <- tutorialTypeSeparators, tpl <- tutorialTemplateNames] + | E.Value t <- tutTypes, let s = CI.original t, t `notElem` tutorialTemplateNames ] tutNames <- E.select $ do tutorial <- E.from $ E.table @Tutorial let tuName = tutorial E.^. TutorialName E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid E.&&. E.isJust (tutorial E.^. TutorialFirstDay) - E.&&. E.not_ (E.any (E.hasPrefix_ (tutorial E.^. TutorialType) . E.val) plainTemplates) - E.orderBy $ [E.asc $ tutorial E.^. TutorialName `E.hasInfix` E.val tn | tn <- tutorialTemplateNames Nothing] -- avoid template names, if possible + E.&&. E.not_ (E.any (E.hasPrefix_ (tutorial E.^. TutorialType) . E.val) tutorialTemplateNames) + E.orderBy $ [E.asc $ tutorial E.^. TutorialName `E.hasInfix` E.val tn | tn <- tutorialTemplateNames] -- avoid template names, if possible ++ [E.desc $ tutorial E.^. TutorialFirstDay, E.asc tuName] E.limit 7 return tuName @@ -231,7 +230,7 @@ handleAddUserR tid ssh csh tdesc ttyp = do (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just $ maybeLeft tdesc) <*> aopt (selectFieldList tutTypesMsg) - (fslI MsgTableTutorialType) + (fslI MsgCourseParticipantsTutorialType & setTooltip MsgCourseParticipantsTutorialTypeTooltip) (Just tutDefType) <*> aopt dayField (fslI MsgTableTutorialFirstDay & setTooltip MsgCourseParticipantsRegisterTutorialFirstDayTip) @@ -356,18 +355,18 @@ upsertNewTutorial Entity{entityKey=cid, entityVal=crse} newTutorialName newTutor `E.on` (\(tut :& crs) -> tut E.^. TutorialCourse E.==. crs E.^. CourseId) `E.innerJoin` E.table @Term `E.on` (\(_ :& crs :& trm) -> trm E.^. TermId E.==. crs E.^. CourseTerm) - E.where_ $ crs E.^. CourseSchool E.==. E.val (crse & courseSchool) -- filter by School - -- E.&&. tut E.^. TutorialName `E.in_` E.vals (tutorialTemplateNames newTutorialType) -- filter TutorialName being a template + E.where_ $ crs E.^. CourseSchool E.==. E.val (crse & courseSchool) -- filter by School + -- E.&&. tut E.^. TutorialName `E.in_` E.vals (tutorialTemplateNames newTutorialType) -- filter TutorialName being a template E.orderBy $ -- NOTE: E.desc to have true before false, only works for non-nullable columns! - (:) (E.desc $ tut E.^. TutorialName `E.in_` E.vals (tutorialTemplateNames newTutorialType)) $ -- prefer template names above all else - mcons ((\ttyp -> E.desc $ tut E.^. TutorialName `E.hasInfix` E.val ttyp) <$> newTutorialType) -- prefer ttype, if given. - [ E.desc $ tut E.^. TutorialCourse E.==. E.val cid -- prefer current course - , E.desc $ crs E.^. CourseName E.==. E.val (crse & courseName) -- prefer courses with identical name - , E.desc $ crs E.^. CourseShorthand E.==. E.val (crse & courseShorthand) -- prefer courses with identical shortcut - , E.desc $ crs E.^. CourseTerm E.==. E.val (crse & courseTerm) -- prefer courses from current term - , E.desc $ trm E.^. TermStart -- prefer most recently started term + [ E.desc $ tut E.^. TutorialName `E.hasInfix` E.val pfx | pfx <- tutorialTemplateNames] -- prefer template names above all else + ++ mcons ((\ttyp -> E.desc $ tut E.^. TutorialName `E.hasInfix` E.val ttyp) <$> newTutorialType) -- prefer ttype, if given. + [ E.desc $ tut E.^. TutorialCourse E.==. E.val cid -- prefer current course + , E.desc $ crs E.^. CourseName E.==. E.val (crse & courseName) -- prefer courses with identical name + , E.desc $ crs E.^. CourseShorthand E.==. E.val (crse & courseShorthand) -- prefer courses with identical shortcut + , E.desc $ crs E.^. CourseTerm E.==. E.val (crse & courseTerm) -- prefer courses from current term + , E.desc $ trm E.^. TermStart -- prefer most recently started term -- , E.desc $ tut E.^. tutorialRegisterFrom - , E.asc $ tut E.^. TutorialName -- prefer tutorial name in alpahbetical order + , E.asc $ tut E.^. TutorialName -- prefer tutorial name in alpahbetical order ] return tut case (existingTut, newFirstDay, templateEnt) of @@ -379,7 +378,7 @@ upsertNewTutorial Entity{entityKey=cid, entityVal=crse} newTutorialName newTutor dayDiff = maybe 0 (diffDays moveDay) tutorialFirstDay mvTime = fmap $ addLocalDays dayDiff newType0 = CI.map (snd . Text.breakOnEnd (CI.original tutorialTypeSeparator)) tutorialType - newType = if newType0 `elem` tutorialTemplateNames Nothing + newType = if newType0 `elem` tutorialTemplateNames then fromMaybe defaultTutorialType newTutorialType else newType0 Entity tutId _ <- upsert