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

Merge branch 'fradrive/avs-synch'

Browse Source
This commit is contained in:
Steffen Jost 2023-05-23 10:09:02 +00:00
commit 1d4d3acbe0
9 changed files with 35 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -5,6 +5,7 @@
QualificationShort: Kürzel QualificationShort: Kürzel
QualificationName: Qualifikation QualificationName: Qualifikation
QualificationDescription: Beschreibung QualificationDescription: Beschreibung
QualificationValidIndicator: Gültigkeit
QualificationValidDuration: Gültigkeitsdauer QualificationValidDuration: Gültigkeitsdauer
QualificationAuditDuration: Aufbewahrung Audit Log QualificationAuditDuration: Aufbewahrung Audit Log
QualificationRefreshWithin: Erneurerungszeitraum QualificationRefreshWithin: Erneurerungszeitraum

1
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -5,6 +5,7 @@
QualificationShort: Shorthand QualificationShort: Shorthand
QualificationName: Qualification QualificationName: Qualification
QualificationDescription: Description QualificationDescription: Description
QualificationValidIndicator: Validity
QualificationValidDuration: Validity period QualificationValidDuration: Validity period
QualificationAuditDuration: Audit log keept QualificationAuditDuration: Audit log keept
QualificationRefreshWithin: Refresh within QualificationRefreshWithin: Refresh within

2
src/Handler/Admin/Avs.hs
View File

@ -549,6 +549,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
icnSuper = text2markup " " <> icon IconSupervisor icnSuper = text2markup " " <> icon IconSupervisor
pure $ toWgt $ mconcat companies pure $ toWgt $ mconcat companies
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q , sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q
, sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (cellMaybe (qualificationValidIconCell nowaday) . preview resultQualUser)
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
@ -568,6 +569,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
, single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld)) , single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld))
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.?. QualificationUserBlockedDue)) , single ("blocked-due" , SortColumn $ queryQualUser >>> (E.?. QualificationUserBlockedDue))
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal)) , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal))
, single ("validity" , SortColumn $ queryQualUser >>> validQualification' nowaday)
] ]
dbtFilter = mconcat dbtFilter = mconcat

2
src/Handler/Course/Users.hs
View File

@ -185,7 +185,7 @@ colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns
colUserQualifications :: forall m c. IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) colUserQualifications :: forall m c. IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
colUserQualifications = sortable (Just "qualifications") (i18nCell MsgTableQualifications) $ colUserQualifications = sortable (Just "qualifications") (i18nCell MsgTableQualifications) $
\(view _userCourseQualifications -> qualis) -> \(view _userCourseQualifications -> qualis) ->
(cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualificationValidCell (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualificationValidUntilCell
colUserQualificationBlocked :: forall m c. IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) colUserQualificationBlocked :: forall m c. IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
colUserQualificationBlocked = sortable (Just "qualification-block") (i18nCell MsgTableQualificationBlockedDue) $ colUserQualificationBlocked = sortable (Just "qualification-block") (i18nCell MsgTableQualificationBlockedDue) $

9
src/Handler/LMS.hs
View File

@ -404,6 +404,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
, single $ sortUserEmail queryUser , single $ sortUserEmail queryUser
, single $ sortUserMatriclenr queryUser , single $ sortUserMatriclenr queryUser
, single ("valid-until" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil)) , single ("valid-until" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil))
, single ("validity" , SortColumn $ queryQualUser >>> validQualification nowaday)
, single ("last-refresh" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh)) , single ("last-refresh" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
, single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld)) , single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
, single ("blocked-due" , SortColumnNeverNull$ queryQualUser >>> (E.^. QualificationUserBlockedDue)) , single ("blocked-due" , SortColumnNeverNull$ queryQualUser >>> (E.^. QualificationUserBlockedDue))
@ -546,6 +547,8 @@ getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsR = postLmsR getLmsR = postLmsR
postLmsR sid qsh = do postLmsR sid qsh = do
isAdmin <- hasReadAccessTo AdminR isAdmin <- hasReadAccessTo AdminR
now <- liftIO getCurrentTime
let nowaday = utctDay now
msgRestartWarning <- messageIconI Warning IconWarning MsgLmsActRestartWarning msgRestartWarning <- messageIconI Warning IconWarning MsgLmsActRestartWarning
((lmsRes, lmsTable), Entity qid quali) <- runDB $ do ((lmsRes, lmsTable), Entity qid quali) <- runDB $ do
qent <- getBy404 $ SchoolQualificationShort sid qsh qent <- getBy404 $ SchoolQualificationShort sid qsh
@ -575,6 +578,7 @@ postLmsR sid qsh = do
(\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
in wgtCell companies in wgtCell companies
, colUserMatriclenr , colUserMatriclenr
, sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
@ -656,9 +660,7 @@ postLmsR sid qsh = do
void $ qualificationUserBlocking qid unblockUsers False Nothing void $ qualificationUserBlocking qid unblockUsers False Nothing
whenIsJust lmsActRestartExtend $ \extDays -> do whenIsJust lmsActRestartExtend $ \extDays -> do
now <- liftIO getCurrentTime let cutoff = addDays extDays nowaday
let nowaday = utctDay now
cutoff = addDays extDays nowaday
shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList
[ QualificationUserQualification ==. qid [ QualificationUserQualification ==. qid
, QualificationUserUser <-. usersList , QualificationUserUser <-. usersList
@ -677,7 +679,6 @@ postLmsR sid qsh = do
reloadKeepGetParams $ LmsR sid qsh reloadKeepGetParams $ LmsR sid qsh
(action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do
now <- liftIO getCurrentTime
numExaminees <- runDBJobs $ do numExaminees <- runDBJobs $ do
okUsers <- selectList [LmsUserUser <-. Set.toList selectedUsers, LmsUserQualification ==. qid] [] okUsers <- selectList [LmsUserUser <-. Set.toList selectedUsers, LmsUserQualification ==. qid] []
forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do

14
src/Handler/Qualification.hs
View File

@ -351,6 +351,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
E.orderBy [E.asc (comp E.^. CompanyName)] E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyName) return (comp E.^. CompanyName)
) )
, single ("validity", SortColumn $ queryQualUser >>> validQualification nowaday)
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser [ single $ fltrUserNameEmail queryUser
@ -513,15 +514,16 @@ postQualificationR sid qsh = do
(\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
in wgtCell companies in wgtCell companies
, guardMonoid isAdmin colUserMatriclenr , guardMonoid isAdmin colUserMatriclenr
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil))
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltipSimple , sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltipSimple
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> blockedDueCell b ) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> blockedDueCell b
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths)) , sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusCell isAdmin linkLmsUser) lu $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusCell isAdmin linkLmsUser) lu
, sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d , sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d
] ]
psValidator = def & defaultSorting [SortDescBy "last-refresh"] psValidator = def & defaultSorting [SortDescBy "last-refresh"]
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator

6
src/Handler/Utils/Qualification.hs
View File

@ -16,6 +16,12 @@ import qualified Database.Esqueleto.Utils as E
import Handler.Utils.DateTime (toMidnight) import Handler.Utils.DateTime (toMidnight)
isValidQualification :: HasQualificationUser a => Day -> a -> Bool
isValidQualification d q = d `inBetween` (q ^. hasQualificationUser . _qualificationUserFirstHeld
,q ^. hasQualificationUser . _qualificationUserValidUntil)
&& isNothing (q ^. hasQualificationUser . _qualificationUserBlockedDue)
------------------ ------------------
-- SQL Snippets -- -- SQL Snippets --
------------------ ------------------

10
src/Handler/Utils/Table/Cells.hs
View File

@ -14,6 +14,7 @@ import Handler.Utils.DateTime
import Handler.Utils.Widgets import Handler.Utils.Widgets
import Handler.Utils.Occurrences import Handler.Utils.Occurrences
import Handler.Utils.LMS (lmsUserStatusWidget) import Handler.Utils.LMS (lmsUserStatusWidget)
import Handler.Utils.Qualification (isValidQualification)
type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles ! type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles !
@ -93,6 +94,9 @@ guardAuthCell mkParams = over cellContents $ \act -> do
iconCell :: IsDBTable m a => Icon -> DBCell m a iconCell :: IsDBTable m a => Icon -> DBCell m a
iconCell = cell . toWidget . icon iconCell = cell . toWidget . icon
iconBoolCell :: IsDBTable m a => Bool -> DBCell m a
iconBoolCell = cell . toWidget . boolSymbol
ifIconCell :: IsDBTable m a => Bool -> Icon -> DBCell m a ifIconCell :: IsDBTable m a => Bool -> Icon -> DBCell m a
ifIconCell True = iconCell ifIconCell True = iconCell
ifIconCell False = const iconSpacerCell ifIconCell False = const iconSpacerCell
@ -316,12 +320,14 @@ qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualific
Nothing -> mempty Nothing -> mempty
(Just descr) -> spacerCell <> markupCellLargeModal descr (Just descr) -> spacerCell <> markupCellLargeModal descr
qualificationValidCell :: (IsDBTable m c, HasQualification a, HasQualificationUser a) => a -> DBCell m c qualificationValidUntilCell :: (IsDBTable m c, HasQualification a, HasQualificationUser a) => a -> DBCell m c
qualificationValidCell q = textCell (qsh <> ": ") <> dayCell vtd qualificationValidUntilCell q = textCell (qsh <> ": ") <> dayCell vtd
where where
qsh = q ^. hasQualification . _qualificationShorthand . _CI qsh = q ^. hasQualification . _qualificationShorthand . _CI
vtd = q ^. hasQualificationUser . _qualificationUserValidUntil vtd = q ^. hasQualificationUser . _qualificationUserValidUntil
qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a) => Day -> a -> DBCell m c
qualificationValidIconCell = (iconBoolCell .) . isValidQualification
lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name

8
templates/letter/fraport_qualification.md
View File

@ -79,21 +79,15 @@ $endif$
$if(is-de)$ $if(is-de)$
Mit Aushändigung der Teilnahmebescheinigung wird der erfolgreiche Abschluss des Kurses bestätigt. Mit Aushändigung der Teilnahmebescheinigung wird der erfolgreiche Abschluss des Kurses bestätigt.
Dieses Zertifikat wurde maschinell erstellt.
$else$ $else$
The successful completion of the course is confirmed The successful completion of the course is confirmed
by handing out this certificate. by handing out this certificate.
This is machine generated certificate requires no signature.
$endif$ $endif$
\medskip \medskip
Frankfurt am Main, $date$ Frankfurt am Main, $date$
Fraport College Fraport Fahrerausbildung
\vspace{\fill} \vspace{\fill}
\vspace{\fill} \vspace{\fill}