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

refactor(qualifications): reformat lms-user widget

Browse Source
This commit is contained in:
Steffen Jost 2023-06-27 15:27:00 +00:00
parent 9abf8b69bf
commit 8a6af742d5
2 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/LMS.hs
View File

@ -408,8 +408,6 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
cmps <- selectList [] [] -- [Asc CompanyShorthand] cmps <- selectList [] [] -- [Asc CompanyShorthand]
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
let let
nowaday = utctDay now
-- mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName) csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
dbtIdent :: Text dbtIdent :: Text
dbtIdent = "lms" dbtIdent = "lms"
@ -727,7 +725,6 @@ getLmsUserR :: CryptoUUIDUser -> Handler Html
getLmsUserR uuid = do getLmsUserR uuid = do
uid <- decrypt uuid uid <- decrypt uuid
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
let nowaday = utctDay now
(user@User{userDisplayName}, quals, qblocks) <- runDB $ do (user@User{userDisplayName}, quals, qblocks) <- runDB $ do
usr <- get404 uid usr <- get404 uid
qs <- Ex.select $ do qs <- Ex.select $ do
@ -745,7 +742,7 @@ getLmsUserR uuid = do
E.||. E.isJust ( lmsUsr E.?. LmsUserUser) E.||. E.isJust ( lmsUsr E.?. LmsUserUser)
Ex.orderBy [Ex.asc $ qual E.^. QualificationShorthand] Ex.orderBy [Ex.asc $ qual E.^. QualificationShorthand]
pure (qual, qualUsr, lmsUsr, validQualification' now qualUsr) pure (qual, qualUsr, lmsUsr, validQualification' now qualUsr)
bs :: Map.Map QualificationUserId [(Entity QualificationUserBlock, Ex.Value (Maybe UserDisplayName), Ex.Value (Maybe UserSurname))] bs :: Map.Map QualificationUserId [(Entity QualificationUserBlock, Ex.Value (Maybe UserDisplayName))]
<- foldMapM (\(_, mbqu, _, _) -> case mbqu of <- foldMapM (\(_, mbqu, _, _) -> case mbqu of
Nothing -> pure mempty Nothing -> pure mempty
Just (Entity quid _) -> do Just (Entity quid _) -> do
@ -755,7 +752,7 @@ getLmsUserR uuid = do
`Ex.on` (\(qBlock :& qbUsr) -> qBlock Ex.^. QualificationUserBlockBlocker Ex.==. qbUsr Ex.?. UserId) `Ex.on` (\(qBlock :& qbUsr) -> qBlock Ex.^. QualificationUserBlockBlocker Ex.==. qbUsr Ex.?. UserId)
Ex.where_ $ qBlock Ex.^. QualificationUserBlockQualificationUser Ex.==. Ex.val quid Ex.where_ $ qBlock Ex.^. QualificationUserBlockQualificationUser Ex.==. Ex.val quid
Ex.orderBy [Ex.desc (qBlock Ex.^. QualificationUserBlockFrom)] Ex.orderBy [Ex.desc (qBlock Ex.^. QualificationUserBlockFrom)]
pure (qBlock, qbUsr Ex.?. UserDisplayName, qbUsr Ex.?. UserSurname) pure (qBlock, qbUsr Ex.?. UserDisplayName)
return $ Map.singleton quid blocks return $ Map.singleton quid blocks
) qs ) qs
return (usr,qs,bs) return (usr,qs,bs)

12
templates/lms-user.hamlet
View File

@ -25,19 +25,15 @@ $else
<dt .deflist__dt>_{MsgTableQualificationBlockedDue} <dt .deflist__dt>_{MsgTableQualificationBlockedDue}
<dd .deflist__dd> <dd .deflist__dd>
<ul> <ul>
$forall (Entity _ block, blockerDN, blockerSN) <- qblock $forall (Entity _ block, blockerDN) <- qblock
<li> <li>
^{formatTimeW SelFormatDateTime (view _qualificationUserBlockFrom block)} #{iconQualificationBlock (view _qualificationUserBlockUnblock block)}
\ #{iconQualificationBlock (view _qualificationUserBlockUnblock block)}
\ #{view _qualificationUserBlockReason block} \ #{view _qualificationUserBlockReason block}
<p> <p>
$maybe bdn <- E.unValue blockerDN $maybe bdn <- E.unValue blockerDN
$maybe bsn <- E.unValue blockerSN ^{editedByW SelFormatDateTime (view _qualificationUserBlockFrom block) bdn}
^{nameWidget bdn bsn}
$nothing
^{text2widget bdn}
$nothing $nothing
? ^{formatTimeW SelFormatDateTime (view _qualificationUserBlockFrom block)}
<dt .deflist__dt>_{MsgTableQualificationLastRefresh} <dt .deflist__dt>_{MsgTableQualificationLastRefresh}
<dd .deflist__dd>^{formatTimeW SelFormatDate (qualificationUserLastRefresh qualUsr)} <dd .deflist__dd>^{formatTimeW SelFormatDate (qualificationUserLastRefresh qualUsr)}
<dt .deflist__dt>_{MsgTableQualificationFirstHeld} <dt .deflist__dt>_{MsgTableQualificationFirstHeld}