fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(qualifications): show associated qualifications in course

Browse Source
This commit is contained in:
Steffen Jost 2023-03-17 10:01:33 +00:00
parent bb9c2259e9
commit 825e4271c1
7 changed files with 69 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/courses/courses/de-de-formal.msg
View File

@ -242,3 +242,5 @@ CourseAdministrator: Kursadministrator:in
CourseAvsRegisterTitle: Teilnehmer:innen anmelden CourseAvsRegisterTitle: Teilnehmer:innen anmelden
CourseAvsRegisterParticipants: Teilnehmer:innen CourseAvsRegisterParticipants: Teilnehmer:innen
CourseAvsRegisterParticipantsTip: Mehrere Teilnehmer:innen mit Komma separieren CourseAvsRegisterParticipantsTip: Mehrere Teilnehmer:innen mit Komma separieren
CourseQualifications n@Int: Assoziierte #{pluralDE n "Qualifikation" "Qualifikationen"}

2
messages/uniworx/categories/courses/courses/en-eu.msg
View File

@ -241,3 +241,5 @@ CourseAdministrator: Course administrator
CourseAvsRegisterTitle: Register participants CourseAvsRegisterTitle: Register participants
CourseAvsRegisterParticipants: Participants CourseAvsRegisterParticipants: Participants
CourseAvsRegisterParticipantsTip: Separate multiple participants with comma CourseAvsRegisterParticipantsTip: Separate multiple participants with comma
CourseQualifications n: Associated #{pluralENs n "Qualification"}

6
src/Handler/Course/Show.hs
View File

@ -31,7 +31,7 @@ getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCShowR tid ssh csh = do getCShowR tid ssh csh = do
mbAid <- maybeAuthId mbAid <- maybeAuthId
now <- liftIO getCurrentTime 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)] [(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
<- lift . E.select . E.from $ <- lift . E.select . E.from $
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
@ -128,7 +128,9 @@ getCShowR tid ssh csh = do
return $ material E.^. MaterialName return $ material E.^. MaterialName
mayViewAnyMaterial <- lift . anyM materials $ \(E.Value mnm) -> hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR 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 mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course

13
src/Handler/Tutorial/Users.hs
View File

@ -12,6 +12,7 @@ import Import
import Utils.Form import Utils.Form
import Handler.Utils import Handler.Utils
import Handler.Utils.Course
import Handler.Utils.Tutorial import Handler.Utils.Tutorial
import Database.Persist.Sql (deleteWhereCount) import Database.Persist.Sql (deleteWhereCount)
@ -62,16 +63,8 @@ postTUsersR tid ssh csh tutn = do
showSex <- getShowSex showSex <- getShowSex
(Entity tutid Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do (Entity tutid Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn tut@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
-- qualifications <- selectList [QualificationSchool ==. ssh] [Asc QualificationShorthand] qualifications <- getCourseQualifications cid
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
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let minDur :: Maybe Int = minimumMaybe $ catMaybes (view _qualificationValidDuration <$> qualifications) -- no instance Ord CalendarDiffDays let minDur :: Maybe Int = minimumMaybe $ catMaybes (view _qualificationValidDuration <$> qualifications) -- no instance Ord CalendarDiffDays
dayExpiry = flip addGregorianDurationClip (utctDay now) . fromMonths <$> minDur dayExpiry = flip addGregorianDurationClip (utctDay now) . fromMonths <$> minDur

17
src/Handler/Utils/Course.hs
View File

@ -2,6 +2,8 @@
-- --
-- SPDX-License-Identifier: AGPL-3.0-or-later -- SPDX-License-Identifier: AGPL-3.0-or-later
{-# LANGUAGE TypeApplications #-}
module Handler.Utils.Course where module Handler.Utils.Course where
import Import import Import
@ -10,6 +12,8 @@ import Handler.Utils.Memcached
import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils 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 import qualified Data.Set as Set
@ -103,3 +107,16 @@ showCourseEventRoom uid courseEvent = E.or
E.where_ $ lecturer E.^. LecturerUser E.==. uid E.where_ $ lecturer E.^. LecturerUser E.==. uid
E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (lecturer E.^. LecturerCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse 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

9
templates/course.hamlet
View File

@ -78,6 +78,15 @@ $# #{summary}
<dd .deflist__dd> <dd .deflist__dd>
#{schoolName} #{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 $with numlecs <- length lecturers
$if numlecs /= 0 $if numlecs /= 0
$if numlecs > 1 $if numlecs > 1

62
templates/qualification.hamlet
View File

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