From c63d3b76dd6a376e092ff22b5d7608e613aaa738 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 23 May 2023 09:15:48 +0000 Subject: [PATCH] chore(qualifications): fix #65 by adding a column with a bool indicator for validity --- .../categories/qualification/de-de-formal.msg | 1 + .../uniworx/categories/qualification/en-eu.msg | 1 + src/Handler/Admin/Avs.hs | 2 ++ src/Handler/Course/Users.hs | 2 +- src/Handler/LMS.hs | 13 +++++++------ src/Handler/Qualification.hs | 14 ++++++++------ src/Handler/Utils/Qualification.hs | 6 ++++++ src/Handler/Utils/Table/Cells.hs | 10 ++++++++-- 8 files changed, 34 insertions(+), 15 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 5f8a15c73..22379aa46 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -5,6 +5,7 @@ QualificationShort: Kürzel QualificationName: Qualifikation QualificationDescription: Beschreibung +QualificationValidIndicator: Gültigkeit QualificationValidDuration: Gültigkeitsdauer QualificationAuditDuration: Aufbewahrung Audit Log QualificationRefreshWithin: Erneurerungszeitraum diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 21445a418..0557da13a 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -5,6 +5,7 @@ QualificationShort: Shorthand QualificationName: Qualification QualificationDescription: Description +QualificationValidIndicator: Validity QualificationValidDuration: Validity period QualificationAuditDuration: Audit log keept QualificationRefreshWithin: Refresh within diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 746a89a7f..99751e95c 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -549,6 +549,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do icnSuper = text2markup " " <> icon IconSupervisor pure $ toWgt $ mconcat companies , 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 "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 @@ -568,6 +569,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do , single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld)) , single ("blocked-due" , SortColumn $ queryQualUser >>> (E.?. QualificationUserBlockedDue)) , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal)) + , single ("validity" , SortColumn $ queryQualUser >>> validQualification' nowaday) ] dbtFilter = mconcat diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 6dbef6268..250bc640f 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -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 = sortable (Just "qualifications") (i18nCell MsgTableQualifications) $ \(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 = sortable (Just "qualification-block") (i18nCell MsgTableQualificationBlockedDue) $ diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index ecfaca1ae..a96c3a839 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -404,10 +404,11 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do , single $ sortUserEmail queryUser , single $ sortUserMatriclenr queryUser , single ("valid-until" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil)) + , single ("validity" , SortColumn $ queryQualUser >>> validQualification nowaday) , single ("last-refresh" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh)) , single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld)) , 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 ("pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin)) , single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus)) @@ -546,6 +547,8 @@ getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html getLmsR = postLmsR postLmsR sid qsh = do isAdmin <- hasReadAccessTo AdminR + now <- liftIO getCurrentTime + let nowaday = utctDay now msgRestartWarning <- messageIconI Warning IconWarning MsgLmsActRestartWarning ((lmsRes, lmsTable), Entity qid quali) <- runDB $ do qent <- getBy404 $ SchoolQualificationShort sid qsh @@ -575,6 +578,7 @@ postLmsR sid qsh = do (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs in wgtCell companies , 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 "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> 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 whenIsJust lmsActRestartExtend $ \extDays -> do - now <- liftIO getCurrentTime - let nowaday = utctDay now - cutoff = addDays extDays nowaday + let cutoff = addDays extDays nowaday shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList [ QualificationUserQualification ==. qid , QualificationUserUser <-. usersList @@ -676,8 +678,7 @@ postLmsR sid qsh = do addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers reloadKeepGetParams $ LmsR sid qsh - (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do - now <- liftIO getCurrentTime + (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do numExaminees <- runDBJobs $ do okUsers <- selectList [LmsUserUser <-. Set.toList selectedUsers, LmsUserQualification ==. qid] [] forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 9d57be2b9..39fd2dd33 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -351,6 +351,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do E.orderBy [E.asc (comp E.^. CompanyName)] return (comp E.^. CompanyName) ) + , single ("validity", SortColumn $ queryQualUser >>> validQualification nowaday) ] dbtFilter = mconcat [ single $ fltrUserNameEmail queryUser @@ -513,15 +514,16 @@ postQualificationR sid qsh = do (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs in wgtCell companies , guardMonoid isAdmin colUserMatriclenr - , 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 "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser) + , 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 - ) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> blockedDueCell b + ) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> blockedDueCell b , 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)) - $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusCell isAdmin linkLmsUser) lu - , sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d + $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusCell isAdmin linkLmsUser) lu + , sortable (Just "last-notified") (i18nCell MsgTableQualificationLastNotified) $ \( view $ resultQualUser . _entityVal . _qualificationUserLastNotified -> d) -> dateTimeCell d ] psValidator = def & defaultSorting [SortDescBy "last-refresh"] tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index e0f55bf6c..4f386659f 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -16,6 +16,12 @@ import qualified Database.Esqueleto.Utils as E 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 -- ------------------ diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index f45b07508..e8e723bc8 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -14,6 +14,7 @@ import Handler.Utils.DateTime import Handler.Utils.Widgets import Handler.Utils.Occurrences import Handler.Utils.LMS (lmsUserStatusWidget) +import Handler.Utils.Qualification (isValidQualification) 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 = 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 True = iconCell ifIconCell False = const iconSpacerCell @@ -316,12 +320,14 @@ qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualific Nothing -> mempty (Just descr) -> spacerCell <> markupCellLargeModal descr -qualificationValidCell :: (IsDBTable m c, HasQualification a, HasQualificationUser a) => a -> DBCell m c -qualificationValidCell q = textCell (qsh <> ": ") <> dayCell vtd +qualificationValidUntilCell :: (IsDBTable m c, HasQualification a, HasQualificationUser a) => a -> DBCell m c +qualificationValidUntilCell q = textCell (qsh <> ": ") <> dayCell vtd where qsh = q ^. hasQualification . _qualificationShorthand . _CI 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 (view hasQualification -> Qualification{..}) = anchorCell link name