refactor(lms): clean code for nicer links in lms status widget
This commit is contained in:
parent
81b821c88a
commit
f7b2f35421
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user