fraport/fradrive
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

11
src/Handler/LMS.hs
View File

@ -407,9 +407,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
cmpMap <- memcachedBy (Just . Right $ 5 * diffMinute) ("CompanyDictionary"::Text) $ do
cmps <- selectList [] [] -- [Asc CompanyShorthand]
return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
let
nowaday = utctDay now
-- mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
let
csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
dbtIdent :: Text
dbtIdent = "lms"
@ -726,8 +724,7 @@ getLmsIdentR sid qid ident = redirect (LmsR sid qid, [("lms-ident", toPathPiece
getLmsUserR :: CryptoUUIDUser -> Handler Html
getLmsUserR uuid = do
uid <- decrypt uuid
now <- liftIO getCurrentTime
let nowaday = utctDay now
now <- liftIO getCurrentTime
(user@User{userDisplayName}, quals, qblocks) <- runDB $ do
usr <- get404 uid
qs <- Ex.select $ do
@ -745,7 +742,7 @@ getLmsUserR uuid = do
E.||. E.isJust ( lmsUsr E.?. LmsUserUser)
Ex.orderBy [Ex.asc $ qual E.^. QualificationShorthand]
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
Nothing -> pure mempty
Just (Entity quid _) -> do
@ -755,7 +752,7 @@ getLmsUserR uuid = do
`Ex.on` (\(qBlock :& qbUsr) -> qBlock Ex.^. QualificationUserBlockBlocker Ex.==. qbUsr Ex.?. UserId)
Ex.where_ $ qBlock Ex.^. QualificationUserBlockQualificationUser Ex.==. Ex.val quid
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
) qs
return (usr,qs,bs)

16
templates/lms-user.hamlet
View File

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