chore(qualifications): show associated qualifications in course

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"}

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"}

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
 

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

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

templates/course.hamlet

@@ -78,6 +78,15 @@ $#                     #{summary}
   <dd .deflist__dd>
     #{schoolName}
 
+  $if length courseQualifications > 0
+    <dt .deflist__dt>_{MsgCourseQualifications (length courseQualifications)}
+    <dd .deflist__dd>
+      <ul .list--inline .list--comma-separated>
+        $forall Entity{entityVal=Qualification{qualificationName=qName,qualificationShorthand=qShort}} <- courseQualifications
+          <li>
+            <a href=@{QualificationR ssh qShort}>
+              #{qName}
+
   $with numlecs <- length lecturers
     $if numlecs /= 0
       $if numlecs > 1

templates/qualification.hamlet

@@ -4,38 +4,40 @@ $# SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen J
 $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
-<dl .deflist>
-  $maybe descr <- qualificationDescription quali
-    <dt .deflist__dt>_{MsgQualificationDescription}
-    <dd .deflist__dd>
-      <div>
-        #{descr}
-  $maybe dvalid <- qualificationValidDuration quali
-    <dt .deflist__dt>_{MsgQualificationValidDuration}
-    <dd .deflist__dd>_{MsgMonths (fromIntegral dvalid)}
+<section>
+  <dl .deflist>
+    $maybe descr <- qualificationDescription quali
+      <dt .deflist__dt>_{MsgQualificationDescription}
+      <dd .deflist__dd>
+        <div>
+          #{descr}
+    $maybe dvalid <- qualificationValidDuration quali
+      <dt .deflist__dt>_{MsgQualificationValidDuration}
+      <dd .deflist__dd>_{MsgMonths (fromIntegral dvalid)}
 
-  $maybe daudit <- qualificationAuditDuration quali
-    <dt .deflist__dt>_{MsgQualificationAuditDuration}
-    <dd .deflist__dd>_{MsgMonths (fromIntegral daudit)}      
+    $maybe daudit <- qualificationAuditDuration quali
+      <dt .deflist__dt>_{MsgQualificationAuditDuration}
+      <dd .deflist__dd>_{MsgMonths (fromIntegral daudit)}      
 
-  $maybe drefresh <- qualificationRefreshWithin quali
-    <dt .deflist__dt>_{MsgQualificationRefreshWithin} ^{iconTooltip (msg2widget MsgQualificationRefreshWithinTooltip) Nothing True}
-    <dd .deflist__dd>
-      $with drm <- cdMonths drefresh
-        $with drd <- cdDays drefresh
-          $if drm > 0
-            _{MsgMonths (fromIntegral drm)}
+    $maybe drefresh <- qualificationRefreshWithin quali
+      <dt .deflist__dt>_{MsgQualificationRefreshWithin} ^{iconTooltip (msg2widget MsgQualificationRefreshWithinTooltip) Nothing True}
+      <dd .deflist__dd>
+        $with drm <- cdMonths drefresh
+          $with drd <- cdDays drefresh
+            $if drm > 0
+              _{MsgMonths (fromIntegral drm)}
+              $if drd > 0
+                , #
             $if drd > 0
-              , #
-          $if drd > 0
-            _{MsgDays   (fromIntegral drd)}
+              _{MsgDays   (fromIntegral drd)}
 
-  <dt .deflist__dt>_{MsgQualificationElearningStart}
-  <dd .deflist__dd>#{boolSymbol (qualificationElearningStart quali)}
-    $if (qualificationElearningStart quali) && isNothing (qualificationRefreshWithin quali)
-      <p>
-        #{icon IconNotificationError}
-        _{MsgLmsErrorNoRefreshElearning}
-  
-^{qualificationTable}
+    <dt .deflist__dt>_{MsgQualificationElearningStart}
+    <dd .deflist__dd>#{boolSymbol (qualificationElearningStart quali)}
+      $if (qualificationElearningStart quali) && isNothing (qualificationRefreshWithin quali)
+        <p>
+          #{icon IconNotificationError}
+          _{MsgLmsErrorNoRefreshElearning}
+    
+<section>    
+  ^{qualificationTable}