From cb00de7960c91d87f5f8fb7ecb29dd15cb61a5a3 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 28 Dec 2021 20:42:32 +0100 Subject: [PATCH] feat(course): study modules as new course property --- .../courses/courses/de-de-formal.msg | 2 + .../categories/courses/courses/en-eu.msg | 2 + messages/uniworx/utils/utils/de-de-formal.msg | 4 +- messages/uniworx/utils/utils/en-eu.msg | 4 +- models/courses.model | 1 + src/Handler/Course/Edit.hs | 60 ++++++++++--------- src/Handler/Utils/Form.hs | 4 ++ src/Model/Types.hs | 1 + src/Model/Types/StudyModules.hs | 29 +++++++++ test/Database/Fill.hs | 9 +++ 10 files changed, 86 insertions(+), 30 deletions(-) create mode 100644 src/Model/Types/StudyModules.hs diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index 2e1880882..6bb2edfc1 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -40,6 +40,8 @@ CourseDescriptionPlaceholder: Bitte mindestens die Modulbeschreibung angeben CourseHomepageExternal: Externe Homepage 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. CourseHomepageExternalPlaceholder: Optionale externe URL +CourseStudyModules: Anrechenbare Module +CourseStudyModulesTip: Komma-separierte Liste an Modulen, für welche sich Studierende diesen Kurs anrechnen lassen können. Bitte nach Möglichkeit Modulbezeichnung (z.B. WP1) und Studienordnung (z.B. Bachelor Informatik Hauptfach) angeben. CourseVisibleFrom: Sichtbar ab CourseVisibleTo: Sichtbar bis CourseVisibleFromTip: Ab diesem Zeitpunkt ist der Kurs für andere Nutzer:innen sichtbar. Ohne Datum ist der Kurs nie für andere Nutzer:innen sichtbar. Dozierende, Assistent:innen, Tutor:innen, Korrektor:innen, angemeldete Teilnehmer:innen sowie Bewerber:innen dieses Kurses sind nicht betroffen. Nimmt der Kurs an einer Zentralanmeldung teil wird die Kurssichtbarkeit während der Bewerbungsphase forciert. diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index c4eda4efc..21a3981f5 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -39,6 +39,8 @@ CourseSemester: Semester CourseDescriptionPlaceholder: Please include the module description CourseHomepageExternalPlaceholder: Optional external URL CourseHomepageExternal: External homepage +CourseStudyModules: Accountable study modules +CourseStudyModulesTip: Comma-separated list of study modules for which students may account this course. If possible, please specify module identifier (e.g. WP1) and study regulation (e.g. Bachelor Informatics Major). CourseSemesterMultipleTip: You are currently allowed to select from among multiple semesters. Please ensure that you select the appropriate semester for your course. CourseVisibleFrom: Visible from CourseVisibleTo: Visible to diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index 1464f36ae..4ccb9cc9e 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -139,4 +139,6 @@ SheetGradingPassPoints': Bestehen nach Punkten SheetGradingPassBinary': Bestanden/Nicht bestanden SheetGradingPassAlways': Automatisch bestanden, sobald korrigiert SheetTypeNormal !ident-ok: Normal -SheetTypeBonus !ident-ok: Bonus \ No newline at end of file +SheetTypeBonus !ident-ok: Bonus + +StudyModulesEmpty: Liste von anrechenbaren Modulen darf nicht leer sein \ No newline at end of file diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index 1539fdf4c..9ce640e24 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -139,4 +139,6 @@ SheetGradingPassPoints': Passing by points SheetGradingPassBinary': Pass/Fail SheetGradingPassAlways': Automatically passed when corrected SheetTypeNormal: Normal -SheetTypeBonus: Bonus \ No newline at end of file +SheetTypeBonus: Bonus + +StudyModulesEmpty: List of accountable study modules may not be empty \ No newline at end of file diff --git a/models/courses.model b/models/courses.model index 6ea7c5a40..38923b9c0 100644 --- a/models/courses.model +++ b/models/courses.model @@ -11,6 +11,7 @@ Course -- Information about a single course; contained info is always visible shorthand (CI Text) -- practical shorthand of course name, used for identification term TermId -- semester this course is taught school SchoolId + studyModules StudyModules -- study modules this course may be credited for capacity Int Maybe -- number of allowed enrolements, if restricted -- canRegisterNow = maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo visibleFrom UTCTime Maybe default=now() -- course may be visible from a given day onwards or always hidden diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index fb426ca94..6aaff8054 100644 --- a/src/Handler/Course/Edit.hs +++ b/src/Handler/Course/Edit.hs @@ -29,29 +29,30 @@ import qualified Data.Conduit.List as C data CourseForm = CourseForm - { cfCourseId :: Maybe CourseId - , cfName :: CourseName - , cfShort :: CourseShorthand - , cfSchool :: SchoolId - , cfTerm :: TermId - , cfDesc :: Maybe StoredMarkup - , cfLink :: Maybe URI - , cfVisFrom :: Maybe UTCTime - , cfVisTo :: Maybe UTCTime - , cfMatFree :: Bool - , cfAllocation :: Maybe AllocationCourseForm + { cfCourseId :: Maybe CourseId + , cfName :: CourseName + , cfShort :: CourseShorthand + , cfSchool :: SchoolId + , cfTerm :: TermId + , cfDesc :: Maybe StoredMarkup + , cfLink :: Maybe URI + , cfStudyModules :: StudyModules + , cfVisFrom :: Maybe UTCTime + , cfVisTo :: Maybe UTCTime + , cfMatFree :: Bool + , cfAllocation :: Maybe AllocationCourseForm , cfAppRequired :: Bool , cfAppInstructions :: Maybe StoredMarkup , cfAppInstructionFiles :: Maybe FileUploads , cfAppText :: Bool , cfAppFiles :: UploadMode , cfAppRatingsVisible :: Bool - , cfCapacity :: Maybe Int - , cfSecret :: Maybe Text - , cfRegFrom :: Maybe UTCTime - , cfRegTo :: Maybe UTCTime - , cfDeRegUntil :: Maybe UTCTime - , cfLecturers :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)] + , cfCapacity :: Maybe Int + , cfSecret :: Maybe Text + , cfRegFrom :: Maybe UTCTime + , cfRegTo :: Maybe UTCTime + , cfDeRegUntil :: Maybe UTCTime + , cfLecturers :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)] } data AllocationCourseForm = AllocationCourseForm @@ -73,6 +74,7 @@ courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm , cfShort = courseShorthand , cfTerm = courseTerm , cfSchool = courseSchool + , cfStudyModules = courseStudyModules , cfCapacity = courseCapacity , cfSecret = courseRegisterSecret , cfMatFree = courseMaterialFree @@ -278,30 +280,30 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB hoist (censorM $ traverseOf _head addTip) $ optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate) (is _Just . cfAllocation <$> template) - -- 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 (cfCourseId =<< template) - <$> areq (textField & cfStrip & cfCI) (fslI MsgCourseName) (cfName <$> 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) + & setTooltip MsgCourseShorthandUnique) (cfShort <$> template) <* bool (pure ()) (aformMessage multipleSchoolsMsg) (length userSchools > 1) - <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template) + <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template) <* bool (pure ()) (aformMessage multipleTermsMsg) (length userTerms > 1) - <*> areq termsField (fslI MsgCourseSemester) (cfTerm <$> template) + <*> areq termsField (fslI MsgCourseSemester) (cfTerm <$> template) <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder)) - (cfDesc <$> template) + (cfDesc <$> template) <*> aopt urlField (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder)) - (cfLink <$> template) + (cfLink <$> template) + <*> apopt studyModulesSimpleField (fslI MsgCourseStudyModules & setTooltip MsgCourseStudyModulesTip) + (cfStudyModules <$> template) <*> aopt utcTimeField (fslpI MsgCourseVisibleFrom (mr MsgCourseDate) - & setTooltip MsgCourseVisibleFromTip) (deepAlt (cfVisFrom <$> template) newVisFrom) + & setTooltip MsgCourseVisibleFromTip) (deepAlt (cfVisFrom <$> template) newVisFrom) <*> aopt utcTimeField (fslpI MsgCourseVisibleTo (mr MsgCourseDate) - & setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template) - <*> apopt checkBoxField (fslI MsgCourseMaterialFree) (cfMatFree <$> template) + & setTooltip MsgCourseVisibleToTip) (cfVisTo <$> template) + <*> apopt checkBoxField (fslI MsgCourseMaterialFree) (cfMatFree <$> template) <* aformSection MsgCourseFormSectionRegistration <*> allocationForm <*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template) @@ -496,6 +498,7 @@ courseEditHandler miButtonAction mbCourseForm = do , courseShorthand = cfShort , courseTerm = cfTerm , courseSchool = cfSchool + , courseStudyModules = cfStudyModules , courseCapacity = cfCapacity , courseRegisterSecret = cfSecret , courseMaterialFree = cfMatFree @@ -547,6 +550,7 @@ courseEditHandler miButtonAction mbCourseForm = do , courseShorthand = cfShort , courseTerm = cfTerm -- dangerous , courseSchool = cfSchool + , courseStudyModules = cfStudyModules , courseCapacity = cfCapacity , courseRegisterSecret = cfSecret , courseMaterialFree = cfMatFree diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 34a372192..0c7e53638 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -2529,3 +2529,7 @@ i18nFieldW :: forall a ident handler. -> Maybe (Maybe (I18n a)) -> WForm handler (FormResult (Maybe (I18n a))) i18nFieldW strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' = aFormToWForm $ i18nFieldA strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' + + +studyModulesSimpleField :: Field Handler StudyModules +studyModulesSimpleField = convertField (Set.fromList . map (StudyModuleFreeModule . CI.mk) . filter (not . Text.null) . map Text.strip . Text.splitOn ",") (intercalate ", " . map (CI.original . stdModFreeModule) . Set.toList) textField diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 5b5562675..92963e789 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -23,3 +23,4 @@ import Model.Types.Markup as Types import Model.Types.Room as Types import Model.Types.Csv as Types import Model.Types.Upload as Types +import Model.Types.StudyModules as Types diff --git a/src/Model/Types/StudyModules.hs b/src/Model/Types/StudyModules.hs new file mode 100644 index 000000000..d016b9bb4 --- /dev/null +++ b/src/Model/Types/StudyModules.hs @@ -0,0 +1,29 @@ +module Model.Types.StudyModules + where + +import Import.NoModel + + +data StudyModule + = StudyModuleModule -- full (i.e. unambiguous) study module specification + { stdModRegulation :: CI Text -- TODO: Reference StudyDegree and StudyTerms instead? + , stdModRegVersion :: UTCTime + , stdModModule :: CI Text + } + | StudyModuleFreeModule -- allows for arbitrary module specifications + { stdModFreeModule :: CI Text + } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + deriving anyclass (NFData) + +deriveJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 2 + , constructorTagModifier = camelToPathPiece' 2 + } ''StudyModule + +derivePersistFieldJSON ''StudyModule + +instance Binary StudyModule + + +type StudyModules = Set StudyModule diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index b57095456..1f53dcdf5 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -660,6 +660,7 @@ fillDb = do , courseShorthand = "FFP" , courseTerm = TermKey $ seasonTerm True Summer , courseSchool = ifi + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor Informatik HF P16", "Bachelor (Medien-)Informatik HF P17", "Bachelor Medieninformatik HF P18", "Master Informatik HF WP8/WP9", "Master Medieninformatik HF P2/P6", "Master Informatik NF WP20" ] , courseCapacity = Just 20 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -813,6 +814,7 @@ fillDb = do , courseShorthand = "EIP" , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor (Medien-)Informatik HF P1" ] , courseCapacity = Just 20 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -839,6 +841,7 @@ fillDb = do , courseShorthand = "IXD" , courseTerm = TermKey $ seasonTerm True Summer , courseSchool = ifi + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor Medieninformatik HF WP16.1 + WP16.2" ] , courseCapacity = Just 20 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -866,6 +869,7 @@ fillDb = do , courseTerm = TermKey $ seasonTerm True Winter , courseSchool = ifi , courseCapacity = Just 30 + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor Medieninformatik HF WP16.3" ] , courseVisibleFrom = Just now , courseVisibleTo = Nothing , courseRegisterFrom = Nothing @@ -891,6 +895,7 @@ fillDb = do , courseShorthand = "ProMo" , courseTerm = TermKey $ seasonTerm True Summer , courseSchool = ifi + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor Informatik HF P4", "Bachelor Medieninformatik HF P2", "Bachelor Informatik NF WP1" ] , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -1064,6 +1069,7 @@ fillDb = do , courseShorthand = "DBS" , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor Informatik HF P15", "Bachelor Medieninformatik HF P10", "Bachelor Informatik NF WP10" ] , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -1197,6 +1203,7 @@ fillDb = do , courseShorthand = "BS" , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi + , courseStudyModules = Set.fromList $ (StudyModuleFreeModule . CI.mk) <$> [ "Bachelor Informatik HF P8", "Bachelor Medieninformatik HF P5", "Bachelor Informatik NF WP6" ] , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -1273,6 +1280,7 @@ fillDb = do , courseShorthand = CI.mk csh , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi + , courseStudyModules = Set.empty , courseCapacity = Just 50 , courseVisibleFrom = Just now , courseVisibleTo = Nothing @@ -1335,6 +1343,7 @@ fillDb = do , courseShorthand = CI.mk csh , courseTerm = TermKey $ seasonTerm False Winter , courseSchool = ifi + , courseStudyModules = Set.empty , courseCapacity = Just cap , courseVisibleFrom = Just now , courseVisibleTo = Nothing