diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index 6d349743c..939bb0659 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -242,3 +242,5 @@ CourseAdministrator: Kursadministrator:in CourseAvsRegisterTitle: Teilnehmer:innen anmelden CourseAvsRegisterParticipants: Teilnehmer:innen CourseAvsRegisterParticipantsTip: Mehrere Teilnehmer:innen mit Komma separieren + +CourseQualifications n@Int: Assoziierte #{pluralDE n "Qualifikation" "Qualifikationen"} \ No newline at end of file diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index b2d0a823d..0625c9ccc 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -241,3 +241,5 @@ CourseAdministrator: Course administrator CourseAvsRegisterTitle: Register participants CourseAvsRegisterParticipants: Participants CourseAvsRegisterParticipantsTip: Separate multiple participants with comma + +CourseQualifications n: Associated #{pluralENs n "Qualification"} \ No newline at end of file diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index 618a7559c..f7f81c5f8 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -31,7 +31,7 @@ getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCShowR tid ssh csh = do mbAid <- maybeAuthId now <- liftIO getCurrentTime - (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,_mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial)) <- runDB . maybeT notFound $ do + (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,_mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial),courseQualifications) <- runDB . maybeT notFound $ do [(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration)] <- lift . E.select . E.from $ \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do @@ -128,7 +128,9 @@ getCShowR tid ssh csh = do return $ material E.^. MaterialName mayViewAnyMaterial <- lift . anyM materials $ \(E.Value mnm) -> hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR - return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,mayReRegister, (mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial)) + courseQualifications <- lift $ getCourseQualifications cid + + return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,mayReRegister, (mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial), courseQualifications) mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 163c8df38..f3438d599 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -12,6 +12,7 @@ import Import import Utils.Form import Handler.Utils +import Handler.Utils.Course import Handler.Utils.Tutorial import Database.Persist.Sql (deleteWhereCount) @@ -62,16 +63,8 @@ postTUsersR tid ssh csh tutn = do showSex <- getShowSex (Entity tutid Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh - tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn - -- qualifications <- selectList [QualificationSchool ==. ssh] [Asc QualificationShorthand] - qualifications <- E.select $ do - (qual :& courseQual) <- - E.from $ E.table @Qualification - `E.innerJoin` E.table @CourseQualification - `E.on` (\(qual :& courseQual) -> qual E.^. QualificationId E.==. courseQual E.^. CourseQualificationQualification) - E.where_ $ courseQual E.^. CourseQualificationCourse E.==. E.val cid - E.orderBy [E.asc $ courseQual E.^. CourseQualificationSortOrder] - pure qual + tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn + qualifications <- getCourseQualifications cid now <- liftIO getCurrentTime let minDur :: Maybe Int = minimumMaybe $ catMaybes (view _qualificationValidDuration <$> qualifications) -- no instance Ord CalendarDiffDays dayExpiry = flip addGregorianDurationClip (utctDay now) . fromMonths <$> minDur diff --git a/src/Handler/Utils/Course.hs b/src/Handler/Utils/Course.hs index 437e56561..c0d31a0d5 100644 --- a/src/Handler/Utils/Course.hs +++ b/src/Handler/Utils/Course.hs @@ -2,6 +2,8 @@ -- -- SPDX-License-Identifier: AGPL-3.0-or-later +{-# LANGUAGE TypeApplications #-} + module Handler.Utils.Course where import Import @@ -10,6 +12,8 @@ import Handler.Utils.Memcached import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E +import Database.Esqueleto.Experimental ((:&)(..)) +import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma import qualified Data.Set as Set @@ -103,3 +107,16 @@ showCourseEventRoom uid courseEvent = E.or E.where_ $ lecturer E.^. LecturerUser E.==. uid E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (lecturer E.^. LecturerCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse ] + +getCourseQualifications :: ( MonadHandler m + , backend ~ SqlBackend + ) + => CourseId -> ReaderT backend m [Entity Qualification] +getCourseQualifications cid = Ex.select $ do + (qual :& courseQual) <- + Ex.from $ Ex.table @Qualification + `Ex.innerJoin` Ex.table @CourseQualification + `Ex.on` (\(qual :& courseQual) -> qual E.^. QualificationId E.==. courseQual E.^. CourseQualificationQualification) + Ex.where_ $ courseQual E.^. CourseQualificationCourse E.==. E.val cid + Ex.orderBy [E.asc $ courseQual E.^. CourseQualificationSortOrder] + pure qual \ No newline at end of file diff --git a/templates/course.hamlet b/templates/course.hamlet index 82af915d9..21fc03fa5 100644 --- a/templates/course.hamlet +++ b/templates/course.hamlet @@ -78,6 +78,15 @@ $# #{summary}
#{schoolName} + $if length courseQualifications > 0 +
_{MsgCourseQualifications (length courseQualifications)} +
+