chore(lms): clean learner icons and sorting
This commit is contained in:
parent
9a63bebe1b
commit
f7ad290053
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =
|
||||
<dd>_{MsgLmsStatusLocked}
|
||||
<dt>^{icon IconUnlocked}
|
||||
<dd>_{MsgLmsStatusUnlocked}
|
||||
<dt>^{icon IconUndo}
|
||||
<dt>^{icon IconResetTries}
|
||||
<dd>_{MsgLmsStatusResetTries}
|
||||
<p>
|
||||
_{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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user