From f7ad2900532614c0765e172c86d98db538bb4310 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 31 Aug 2023 09:55:42 +0200 Subject: [PATCH] chore(lms): clean learner icons and sorting --- .../categories/qualification/de-de-formal.msg | 2 +- .../categories/qualification/en-eu.msg | 2 +- src/Handler/LMS/Learners.hs | 29 ++++---- src/Handler/Utils/LMS.hs | 68 +++++++++++++------ src/Utils/Icon.hs | 4 +- 5 files changed, 66 insertions(+), 39 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 52e7e4c82..4f19265a3 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -66,7 +66,7 @@ TableLmsResetTries: E‑Learning Versuche zurücksetzen LmsStatusBlocked: Durchgefallen wegen zu vieler Fehlversuche LmsStatusExpired: Durchgefallen nach Fristablauf LmsStatusSuccess: E#{nonBreakableDash}Learning bestanden -LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade eröffnet (nur für Admin sichtbar) +LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade noch eröffnet (nur für Admin sichtbar) LmsStatusDelay: Hinweis: Statusänderung können in seltenen Fällen mehrere Stunden bis zur Anzeige benötigen. FilterLmsValid: Aktuell gültig FilterLmsRenewal: Erneuerung anstehend diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index ec62d8ac6..b6ff31013 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -66,7 +66,7 @@ TableLmsResetTries: Reset e‑learning attempts LmsStatusBlocked: Failed after too many attempts LmsStatusExpired: Failed due to expiry LmsStatusSuccess: Passed -LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened (visible to Admins only) +LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened soon (visible to Admins only) LmsStatusDelay: Note that status changes may occassionaly require more than a hour to be displayed here. FilterLmsValid: Currently valid FilterLmsRenewal: Renewal due diff --git a/src/Handler/LMS/Learners.hs b/src/Handler/LMS/Learners.hs index 98761461c..00779d2c4 100644 --- a/src/Handler/LMS/Learners.hs +++ b/src/Handler/LMS/Learners.hs @@ -105,20 +105,23 @@ mkUserTable _sid qsh qid = do dbtRowKey = (E.^. LmsUserId) dbtProj = dbtProjId dbtColonnade = dbColonnade $ mconcat - [ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident + [ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident , sortable (Just csvLmsPin) (i18nCell MsgTableLmsPin & cellAttrs <>~ [("uw-hide-column-default-hidden",mempty)] - ) $ \(view $ _dbrOutput . _entityVal . _lmsUserPin -> pin ) -> textCell pin - , sortable (Just csvLmsResetPin) (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin -> reset) -> ifIconCell reset IconReset - , sortable (Just csvLmsDelete) (i18nCell MsgTableLmsDelete) $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete cutoff -> del ) -> ifIconCell del IconRemoveUser - , sortable Nothing (i18nCell MsgTableLmsStaff) $ \(view $ _dbrOutput . _entityVal -> lu) -> iconBoolCell (lmsUserStaff lu) - , sortable Nothing (i18nCell MsgTableLmsResetTries) $ \(view $ _dbrOutput . _entityVal -> lu) -> iconBoolCell (lmsUserToResetTries lu) - , sortable Nothing (i18nCell MsgTableLmsLock) $ \(view $ _dbrOutput . _entityVal -> lu) -> ifIconCell (lmsUserToLock lu) IconLocked + ) $ \(view $ _dbrOutput . _entityVal . _lmsUserPin -> pin ) -> textCell pin + , sortable (Just csvLmsResetPin) (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin -> reset) -> ifIconCell reset IconReset + , sortable (Just csvLmsDelete) (i18nCell MsgTableLmsDelete) $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete cutoff -> del ) -> ifIconCell del IconRemoveUser + , sortable Nothing (i18nCell MsgTableLmsStaff) $ \(view $ _dbrOutput . _entityVal . _lmsUserStaff -> staff) -> ifIconCell staff IconOK + , sortable (Just csvLmsResetTries)(i18nCell MsgTableLmsResetTries) $ \(view $ _dbrOutput . _entityVal . _lmsUserToResetTries -> reset) -> ifIconCell reset IconResetTries + , sortable (Just csvLmsLock) (i18nCell MsgTableLmsLock) $ \(view $ _dbrOutput . _entityVal . _lmsUserToLock -> lock ) -> ifIconCell lock IconLocked ] dbtSorting = Map.fromList - [ (csvLmsIdent , SortColumn (E.^. LmsUserIdent)) - , (csvLmsPin , SortColumn (E.^. LmsUserPin)) - , (csvLmsResetPin , SortColumn (E.^. LmsUserResetPin)) - , (csvLmsDelete , SortColumn (lmsUserToDeleteExpr cutoff)) + [ (csvLmsIdent , SortColumn (E.^. LmsUserIdent)) + , (csvLmsPin , SortColumn (E.^. LmsUserPin)) + , (csvLmsResetPin , SortColumn (E.^. LmsUserResetPin)) + , (csvLmsDelete , SortColumn (lmsUserToDeleteExpr cutoff)) + -- , (csvLmsStaff , E.false) -- currently always false + , (csvLmsResetTries , SortColumn lmsUserToResetTriesExpr) + , (csvLmsLock , SortColumn lmsUserToLockExpr) ] dbtFilter = Map.fromList [ (csvLmsIdent , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserIdent )) @@ -160,8 +163,8 @@ getLmsLearnersR sid qsh = do lmsTable <- runDB $ do qid <- getKeyBy404 $ SchoolQualificationShort sid qsh view _2 <$> mkUserTable sid qsh qid - siteLayoutMsg MsgMenuLmsUsers $ do - setTitleI MsgMenuLmsUsers + siteLayoutMsg MsgMenuLmsLearners $ do + setTitleI MsgMenuLmsLearners lmsTable getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index 56be1763b..64328a8d3 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -23,11 +23,10 @@ module Handler.Utils.LMS , csvFilenameLmsResult , csvFilenameLmsReport , lmsDeletionDate - , lmsUserToDelete, _lmsUserToDelete - , lmsUserToDeleteExpr - , lmsUserToResetTries - , lmsUserToLock - , lmsUserStaff + , lmsUserToDelete , _lmsUserToDelete , lmsUserToDeleteExpr + , lmsUserToResetTries , _lmsUserToResetTries , lmsUserToResetTriesExpr + , lmsUserToLock , _lmsUserToLock , lmsUserToLockExpr + , lmsUserStaff , _lmsUserStaff , lmsStatusInfoCell , lmsStatusIcon, lmsUserStatusWidget , randomLMSIdent, randomLMSIdentBut @@ -152,20 +151,35 @@ lmsUserToDelete _ _ = False _lmsUserToDelete :: Day -> Getter LmsUser Bool _lmsUserToDelete cutoff = to $ lmsUserToDelete cutoff +lmsUserToResetTriesExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool) +lmsUserToResetTriesExpr luser = (luser E.^. LmsUserResetTries) E.&&. (luser E.^. LmsUserLocked) E.&&. + ((luser E.^. LmsUserStatus) `E.in_` E.justValList [LmsBlocked, LmsExpired]) lmsUserToResetTries :: LmsUser -> Bool lmsUserToResetTries LmsUser{..} = lmsUserResetTries && lmsUserLocked && (lmsUserStatus == Just LmsBlocked || lmsUserStatus == Just LmsExpired) -- only reset blocked learners +_lmsUserToResetTries :: Getter LmsUser Bool +_lmsUserToResetTries = to lmsUserToResetTries + -- | Answers "Should the LMS lock a user out?" -- Note that LmsUserLocked only logs the current LMS state, not what it should be. +lmsUserToLockExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool) +lmsUserToLockExpr luser = E.isJust (luser E.^. LmsUserStatus) + lmsUserToLock :: LmsUser -> Bool lmsUserToLock LmsUser{..} = isJust lmsUserStatus -- only open LMS should be accessible +_lmsUserToLock :: Getter LmsUser Bool +_lmsUserToLock = to lmsUserToLock + lmsUserStaff :: LmsUser -> Bool lmsUserStaff = const False -- legacy, currently ignored +_lmsUserStaff :: Getter LmsUser Bool +_lmsUserStaff = to lmsUserStaff + -- random generation of LmsIdentifiers, maybe this should be in Model.Types.Lms since length specifications are type-y? lengthIdent :: Int @@ -230,7 +244,7 @@ lmsStatusInfoCell extendedInfo auditMonths =
_{MsgLmsStatusLocked}
^{icon IconUnlocked}
_{MsgLmsStatusUnlocked} -
^{icon IconUndo} +
^{icon IconResetTries}
_{MsgLmsStatusResetTries}

_{MsgLmsStatusDelay} @@ -242,34 +256,44 @@ lmsStatusIcon LmsExpired{} = IconExpired lmsStatusIcon _other = IconNotOK lmsUserStatusWidget :: Bool -> LmsUser -> Widget -lmsUserStatusWidget isAdmin luser - | isAdmin = lmsUserStatusWidgetAux isAdmin luser <> toWidget lockIcon <> toWidget resetIcon - | otherwise = lmsUserStatusWidgetAux isAdmin luser - where - lmsUserStatusWidgetAux _ LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=Just aday} = +lmsUserStatusWidget adminInfo luser = case luser of + LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=mbDay} -> [whamlet|$newline never - ^{formatTimeW SelFormatDate aday} + $maybe aday <- mbDay + ^{formatTimeW SelFormatDate aday} + $nothing + --.--.---- \ ^{iconFixed (lmsStatusIcon lStat)} + $if adminInfo + \ ^{lockIcon} + \ ^{resetIcon} |] - -- previously: IconWaitingForUser for lmsUserStatus==Nothing - lmsUserStatusWidgetAux _ LmsUser{lmsUserNotified=Just d} = + + LmsUser{lmsUserNotified=Just d} -> [whamlet|$newline never ^{formatTimeW SelFormatDate d} \ ^{iconFixed IconNotificationSent} + $if adminInfo + \ ^{lockIcon} + \ ^{resetIcon} |] - lmsUserStatusWidgetAux True LmsUser{lmsUserStarted} = -- E-Learning started, but not yet notified; only intended for Admins - [whamlet|$newline never - ^{formatTimeW SelFormatDate lmsUserStarted} - \ ^{iconFixed IconPlanned} - |] - lmsUserStatusWidgetAux _ _ = mempty + LmsUser{lmsUserStarted=dstart} | adminInfo -> -- E-Learning started, but not yet notified; only intended for Admins; + [whamlet|$newline never + ^{formatTimeW SelFormatDate dstart} + \ ^{iconFixed IconPlanned} + $if adminInfo + \ ^{resetIcon} + |] -- would always display Iconlocked + + _ -> mempty + + where lockIcon | lmsUserLocked luser == lmsUserToLock luser = mempty | lmsUserLocked luser = iconFixed IconLocked | otherwise = iconFixed IconUnlocked resetIcon - | lmsUserResetTries luser = iconFixed IconUndo + | lmsUserResetTries luser = iconFixed IconResetTries | otherwise = mempty - diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index ec27e5c53..2c8d9de6a 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -113,7 +113,7 @@ data Icon | IconExpired | IconLocked | IconUnlocked - | IconUndo -- also see IconReset + | IconResetTries -- also see IconReset deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving anyclass (Universe, Finite, NFData) @@ -204,7 +204,7 @@ iconText = \case IconExpired -> "hourglass-end" IconLocked -> "lock" IconUnlocked -> "lock-open-alt" - IconUndo -> "trash-undo" + IconResetTries -> "trash-undo" nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon