refactor(lms): clean code for nicer links in lms status widget

This commit is contained in:
Steffen Jost 2023-09-25 15:39:09 +00:00
parent 81b821c88a
commit f7b2f35421
2 changed files with 9 additions and 8 deletions

View File

@ -255,7 +255,7 @@ lmsStatusIcon LmsSuccess{} = IconOK
lmsStatusIcon LmsExpired{} = IconExpired
lmsStatusIcon _other = IconNotOK
lmsUserStatusWidget :: Bool -> Maybe (SomeRoute UniWorX) -> LmsUser -> Widget
lmsUserStatusWidget :: Bool -> Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> Widget
lmsUserStatusWidget adminInfo mbLink luser = case luser of
LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=mbDay} ->
[whamlet|$newline never
@ -296,6 +296,10 @@ lmsUserStatusWidget adminInfo mbLink luser = case luser of
| otherwise = mempty
dateWgt :: Maybe UTCTime -> Widget
dateWgt = maybe id (flip modal . Left ) mbLink .
maybe (text2widget "--.--.----") (formatTimeW SelFormatDateTime)
dateWgt =
let mkDayWgt = maybe (text2widget "--.--.----") (formatTimeW SelFormatDateTime)
in case mbLink of
Nothing -> mkDayWgt
(Just mkLink) -> \mbDay -> do
uuid <- liftHandler $ encrypt $ luser ^. _lmsUserUser
modal (mkDayWgt mbDay) $ Left $ SomeRoute $ mkLink uuid

View File

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