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

chore(qualifications): fix #65 by adding a column with a bool indicator for validity

Browse Source
This commit is contained in:
Steffen Jost 2023-05-23 09:15:48 +00:00
parent 807cf4b3cf
commit c63d3b76dd
8 changed files with 34 additions and 15 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) $

13
src/Handler/LMS.hs
View File

@ -404,10 +404,11 @@ 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))
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal)) , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
, single ("ident" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserIdent)) , single ("ident" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserIdent))
, single ("pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin)) , single ("pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin))
, single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus)) , single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus))
@ -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
@ -676,8 +678,7 @@ postLmsR sid qsh = do
addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers
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