fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Handler/Utils/LMS.hs
View File

@ -255,7 +255,7 @@ lmsStatusIcon LmsSuccess{} = IconOK
lmsStatusIcon LmsExpired{} = IconExpired lmsStatusIcon LmsExpired{} = IconExpired
lmsStatusIcon _other = IconNotOK 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 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
@ -296,6 +296,10 @@ lmsUserStatusWidget adminInfo mbLink luser = case luser of
| otherwise = mempty | otherwise = mempty
dateWgt :: Maybe UTCTime -> Widget dateWgt :: Maybe UTCTime -> Widget
dateWgt = maybe id (flip modal . Left ) mbLink . dateWgt =
maybe (text2widget "--.--.----") (formatTimeW SelFormatDateTime) 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

5
src/Handler/Utils/Table/Cells.hs
View File

@ -426,10 +426,7 @@ 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 Nothing lu lmsStatusCell extendedInfo mkLink = wgtCell . lmsUserStatusWidget extendedInfo mkLink
lmsStatusCell extendedInfo (Just toLink) lu = cell $ do
uuid <- liftHandler $ encrypt $ lu ^. _lmsUserUser
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