chore(lms): better links in lms status widget

This commit is contained in:
Steffen Jost 2023-09-25 15:25:38 +00:00
parent 50e4f297b8
commit 81b821c88a
3 changed files with 14 additions and 12 deletions

View File

@ -255,23 +255,20 @@ lmsStatusIcon LmsSuccess{} = IconOK
lmsStatusIcon LmsExpired{} = IconExpired lmsStatusIcon LmsExpired{} = IconExpired
lmsStatusIcon _other = IconNotOK lmsStatusIcon _other = IconNotOK
lmsUserStatusWidget :: Bool -> LmsUser -> Widget lmsUserStatusWidget :: Bool -> Maybe (SomeRoute UniWorX) -> LmsUser -> Widget
lmsUserStatusWidget adminInfo luser = case luser of lmsUserStatusWidget adminInfo mbLink luser = case luser of
LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=mbDay} -> LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=mbDay} ->
[whamlet|$newline never [whamlet|$newline never
$maybe aday <- mbDay ^{dateWgt mbDay}
^{formatTimeW SelFormatDateTime aday}
$nothing
--.--.----
\ ^{iconFixed (lmsStatusIcon lStat)} \ ^{iconFixed (lmsStatusIcon lStat)}
$if adminInfo $if adminInfo
\ ^{lockIcon} \ ^{lockIcon}
\ ^{resetIcon} \ ^{resetIcon}
|] |]
LmsUser{lmsUserNotified=Just d} -> LmsUser{lmsUserNotified=mbDay@(Just _)} ->
[whamlet|$newline never [whamlet|$newline never
^{formatTimeW SelFormatDateTime d} ^{dateWgt mbDay}
\ ^{iconFixed IconNotificationSent} \ ^{iconFixed IconNotificationSent}
$if adminInfo $if adminInfo
\ ^{lockIcon} \ ^{lockIcon}
@ -280,7 +277,7 @@ lmsUserStatusWidget adminInfo luser = case luser of
LmsUser{lmsUserStarted=dstart} | adminInfo -> -- E-Learning started, but not yet notified; only intended for Admins; LmsUser{lmsUserStarted=dstart} | adminInfo -> -- E-Learning started, but not yet notified; only intended for Admins;
[whamlet|$newline never [whamlet|$newline never
^{formatTimeW SelFormatDateTime dstart} ^{dateWgt (Just dstart)}
\ ^{iconFixed IconPlanned} \ ^{iconFixed IconPlanned}
$if adminInfo $if adminInfo
\ ^{resetIcon} \ ^{resetIcon}
@ -297,3 +294,8 @@ lmsUserStatusWidget adminInfo luser = case luser of
resetIcon resetIcon
| lmsUserResetTries luser = iconFixed IconResetTries | lmsUserResetTries luser = iconFixed IconResetTries
| otherwise = mempty | otherwise = mempty
dateWgt :: Maybe UTCTime -> Widget
dateWgt = maybe id (flip modal . Left ) mbLink .
maybe (text2widget "--.--.----") (formatTimeW SelFormatDateTime)

View File

@ -426,10 +426,10 @@ cryptoidCell :: (IsDBTable m a, PathPiece cid) => cid -> DBCell m a
cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece
lmsStatusCell :: IsDBTable m a => Bool -> Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a lmsStatusCell :: IsDBTable m a => Bool -> Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a
lmsStatusCell extendedInfo Nothing lu = wgtCell $ lmsUserStatusWidget extendedInfo lu lmsStatusCell extendedInfo Nothing lu = wgtCell $ lmsUserStatusWidget extendedInfo Nothing lu
lmsStatusCell extendedInfo (Just toLink) lu = cell $ do lmsStatusCell extendedInfo (Just toLink) lu = cell $ do
uuid <- liftHandler $ encrypt $ lu ^. _lmsUserUser uuid <- liftHandler $ encrypt $ lu ^. _lmsUserUser
modal (lmsUserStatusWidget extendedInfo lu) (Left $ SomeRoute $ toLink uuid) lmsUserStatusWidget extendedInfo (Just $ SomeRoute $ toLink uuid) lu
lmsStateCell :: IsDBTable m a => LmsState -> DBCell m a lmsStateCell :: IsDBTable m a => LmsState -> DBCell m a
lmsStateCell LmsFailed = iconBoolCell False lmsStateCell LmsFailed = iconBoolCell False

View File

@ -43,7 +43,7 @@ $else
<dd .deflist__dd>^{formatTimeW SelFormatDateTime (lmsUserStarted lmsUsr)} <dd .deflist__dd>^{formatTimeW SelFormatDateTime (lmsUserStarted lmsUsr)}
$maybe _ <- lmsUserStatus lmsUsr $maybe _ <- lmsUserStatus lmsUsr
<dt .deflist__dt>_{MsgTableLmsStatus} <dt .deflist__dt>_{MsgTableLmsStatus}
<dd .deflist__dd>^{lmsUserStatusWidget True lmsUsr} <dd .deflist__dd>^{lmsUserStatusWidget True Nothing lmsUsr}
<dt .deflist__dt>_{MsgTableLmsIdent} <dt .deflist__dt>_{MsgTableLmsIdent}
<dd .deflist__dd> <dd .deflist__dd>
<a href=@{LmsIdentR (qualificationSchool quali) (qualificationShorthand quali) (lmsUserIdent lmsUsr)}> <a href=@{LmsIdentR (qualificationSchool quali) (qualificationShorthand quali) (lmsUserIdent lmsUsr)}>