From 9abf8b69bf3149cce6eac6a01fba95801b3bc9ee Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 27 Jun 2023 15:15:32 +0000 Subject: [PATCH] refactor(qualification): rework lms view and user lms modal --- .../categories/qualification/de-de-formal.msg | 3 + .../categories/qualification/en-eu.msg | 3 + src/Handler/LMS.hs | 150 ++++++++++-------- src/Handler/Qualification.hs | 34 ++-- src/Handler/Utils/Qualification.hs | 32 ++-- src/Handler/Utils/Table/Cells.hs | 19 +-- src/Utils.hs | 9 +- src/Utils/Icon.hs | 6 + src/Utils/Lens.hs | 2 +- templates/lms-user.hamlet | 31 +++- 10 files changed, 173 insertions(+), 116 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index b77bd3416..39f4286d6 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -25,6 +25,8 @@ TableQualificationFirstHeld: Erstmalig TableQualificationBlockedDue: Entzogen TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst? TableQualificationBlockedTooltipSimple: Falls die Qualifikation aus besonderem Grund vorzeitig widerrufen wurde, so wird das Datum des Widerrufs angezeigt +InfoQualificationBlockStatus: Besteht aktuell ein Entzug? Falsch bedeutet, dass ein Entzug zuletzt aufgehoben wurde +InfoQualificationBlockFrom: Datum der letzten Änderungen eines Entzugs oder der Aufhebung eines Entzugs TableQualificationNoRenewal: Auslaufend TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch weiterhin gültig sein. QualificationScheduleRenewalTooltip: Wird eine Benachrichtigung versendet, falls diese Qualikation bald ablaufen sollte? @@ -96,6 +98,7 @@ QualificationActGrant: Qualifikation vergeben QualificationActGrantWarning: Diese Funktion ist nur für seltene Ausnahmefälle vorgesehen! Ein Entzug wird ggf. aufgehoben. QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} entzogen QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert +LmsInactive: Aktuell kein E‑Learning aktiv LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach. LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden. LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index ada108cca..587f18d11 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -26,6 +26,8 @@ TableQualificationBlockedDue: Revoked TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended? TableQualificationBlockedTooltipSimple: If a date is shown, this qualification has been revoked on that date due to extraordinary reasons TableQualificationNoRenewal: Discontinued +InfoQualificationBlockStatus: Is the qualification currently revoked? False indicates, that a revocation had been lifted +InfoQualificationBlockFrom: Date of last revocation or lifting of a revocation TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid. QualificationScheduleRenewalTooltip: Will there be a notification, if this qualification is about to expire soon? QualificationUserNoRenewal: Expires without further notification @@ -96,6 +98,7 @@ QualificationActGrant: Grant qualification QualificationActGrantWarning: Use with caution in rare exceptional cases only! Any revocation will be undone. QualificationStatusBlock l n m: #{n}/#{m} #{l} revoked QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated +LmsInactive: Currently no active e‑learning LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter. LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only. LmsActNotify: Resend e‑learning notification by post or email diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index b08c16cce..e6513ccd4 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -207,11 +207,12 @@ data LmsTableCsv = LmsTableCsv -- L..T..C.. -> ltc.. , ltcValidUntil :: Day , ltcLastRefresh :: Day , ltcFirstHeld :: Day - , ltcBlockedDue :: Maybe QualificationBlocked - , ltcLmsIdent :: Maybe LmsIdent + , ltcBlockStatus :: Maybe Bool + , ltcBlockFrom :: Maybe UTCTime + , ltcLmsIdent :: LmsIdent , ltcLmsStatus :: Maybe LmsStatus - , ltcLmsStarted :: Maybe UTCTime - , ltcLmsDatePin :: Maybe UTCTime + , ltcLmsStarted :: UTCTime + , ltcLmsDatePin :: UTCTime , ltcLmsReceived :: Maybe UTCTime , ltcLmsNotified :: Maybe UTCTime , ltcLmsEnded :: Maybe UTCTime @@ -228,11 +229,12 @@ ltcExample = LmsTableCsv , ltcValidUntil = compDay , ltcLastRefresh = compDay , ltcFirstHeld = compDay - , ltcBlockedDue = Nothing - , ltcLmsIdent = Nothing + , ltcBlockStatus = Nothing + , ltcBlockFrom = Nothing + , ltcLmsIdent = LmsIdent "abcdefgh" , ltcLmsStatus = Nothing - , ltcLmsStarted = Just compTime - , ltcLmsDatePin = Nothing + , ltcLmsStarted = compTime + , ltcLmsDatePin = compTime , ltcLmsReceived = Nothing , ltcLmsNotified = Nothing , ltcLmsEnded = Nothing @@ -269,6 +271,8 @@ instance CsvColumnsExplained LmsTableCsv where , ('ltcValidUntil , SomeMessage MsgLmsQualificationValidUntil) , ('ltcLastRefresh , SomeMessage MsgTableQualificationLastRefresh) , ('ltcFirstHeld , SomeMessage MsgTableQualificationFirstHeld) + , ('ltcBlockStatus , SomeMessage MsgInfoQualificationBlockStatus) + , ('ltcBlockFrom , SomeMessage MsgInfoQualificationBlockFrom) , ('ltcLmsIdent , SomeMessage MsgTableLmsIdent) , ('ltcLmsStatus , SomeMessage MsgTableLmsStatus) , ('ltcLmsStarted , SomeMessage MsgTableLmsStarted) @@ -278,21 +282,25 @@ instance CsvColumnsExplained LmsTableCsv where ] -type LmsTableExpr = E.SqlExpr (Entity QualificationUser) - `E.InnerJoin` E.SqlExpr (Entity User) - `E.InnerJoin` E.SqlExpr (Entity LmsUser) +type LmsTableExpr = ( E.SqlExpr (Entity QualificationUser) + `E.InnerJoin` E.SqlExpr (Entity User) + `E.InnerJoin` E.SqlExpr (Entity LmsUser) + ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity QualificationUserBlock)) queryQualUser :: LmsTableExpr -> E.SqlExpr (Entity QualificationUser) -queryQualUser = $(sqlIJproj 3 1) +queryQualUser = $(sqlIJproj 3 1) . $(sqlLOJproj 2 1) queryUser :: LmsTableExpr -> E.SqlExpr (Entity User) -queryUser = $(sqlIJproj 3 2) +queryUser = $(sqlIJproj 3 2) . $(sqlLOJproj 2 1) queryLmsUser :: LmsTableExpr -> E.SqlExpr (Entity LmsUser) -queryLmsUser = $(sqlIJproj 3 3) +queryLmsUser = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1) + +queryQualBlock :: LmsTableExpr -> E.SqlExpr (Maybe (Entity QualificationUserBlock)) +queryQualBlock = $(sqlLOJproj 2 2) -type LmsTableData = DBRow (Entity QualificationUser, Entity User, Entity LmsUser, E.Value (Maybe [Maybe UTCTime]), [Entity UserCompany]) +type LmsTableData = DBRow (Entity QualificationUser, Entity User, Entity LmsUser, Maybe (Entity QualificationUserBlock), E.Value (Maybe [Maybe UTCTime]), [Entity UserCompany]) resultQualUser :: Lens' LmsTableData (Entity QualificationUser) resultQualUser = _dbrOutput . _1 @@ -303,11 +311,14 @@ resultUser = _dbrOutput . _2 resultLmsUser :: Lens' LmsTableData (Entity LmsUser) resultLmsUser = _dbrOutput . _3 +resultQualBlock :: Traversal' LmsTableData (Entity QualificationUserBlock) +resultQualBlock = _dbrOutput . _4 . _Just + resultPrintAck :: Traversal' LmsTableData [Maybe UTCTime] -resultPrintAck = _dbrOutput . _4 . _unValue . _Just +resultPrintAck = _dbrOutput . _5 . _unValue . _Just resultCompanyUser :: Lens' LmsTableData [Entity UserCompany] -resultCompanyUser = _dbrOutput . _5 +resultCompanyUser = _dbrOutput . _6 instance HasEntity LmsTableData User where hasEntity = resultUser @@ -315,6 +326,12 @@ instance HasEntity LmsTableData User where instance HasUser LmsTableData where hasUser = resultUser . _entityVal +instance HasEntity LmsTableData QualificationUser where + hasEntity = resultQualUser + +instance HasQualificationUser LmsTableData where + hasQualificationUser = resultQualUser . _entityVal + data LmsTableAction = LmsActNotify | LmsActRenewNotify | LmsActRenewPin @@ -333,6 +350,7 @@ data LmsTableActionData = LmsActNotifyData | LmsActRestartData { lmsActRestartExtend :: Maybe Integer , lmsActRestartUnblock :: Maybe Bool + , lmsActRestartNotify :: Maybe Bool } deriving (Eq, Ord, Read, Show, Generic) @@ -350,18 +368,20 @@ lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) , E.SqlExpr (Entity User) , E.SqlExpr (Entity LmsUser) + , E.SqlExpr (Maybe (Entity QualificationUserBlock)) , E.SqlExpr (E.Value (Maybe [Maybe UTCTime])) -- outer maybe indicates, whether a printJob exists, inner maybe indicates all acknowledged printJobs ) -lmsTableQuery qid (qualUser `E.InnerJoin` user `E.InnerJoin` lmsUser) = do +lmsTableQuery qid (qualUser `E.InnerJoin` user `E.InnerJoin` lmsUser `E.LeftOuterJoin` qualBlock) = do -- RECALL: another outer join on PrintJob did not work out well, since -- - E.distinctOn [E.don $ printJob E.?. PrintJobLmsUser] $ do -- types, but destroys the ability to sort interactively, since distinctOn requires sorting; - -- - using notExists on printJob join condition works, but only deliver single value, aggregation can deliver all; + -- - using notExists on printJob join condition works, but only delivers single value, while aggregation can deliver all; -- experiments with separate sub-query showed that we would need two subqueries to learn whether the request was indeed the latest + E.on $ qualUser E.^. QualificationUserId E.=?. qualBlock E.?. QualificationUserBlockQualificationUser E.on $ user E.^. UserId E.==. lmsUser E.^. LmsUserUser E.&&. E.val qid E.==. lmsUser E.^. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause, which does not work E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification - -- TODO: decide whether to use subSelect or LeftOuterJoin and delete the other! + E.&&. qualBlock `isLatestBlockBefore` E.now_ -- Letztes Datum anzeigen, wenn mehrere, dann diese in klickbaren Tooltip verstecken! let printAcknowledged = E.subSelectMaybe . E.from $ \pj -> do E.where_ $ E.isJust (pj E.^. PrintJobLmsUser) @@ -369,7 +389,7 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.InnerJoin` lmsUser) = do let pjOrder = [E.desc $ pj E.^. PrintJobCreated, E.desc $ pj E.^. PrintJobAcknowledged] -- latest created comes first! This is assumed to be the case later on! pure $ --(E.arrayAggWith E.AggModeAll (pj E.^. PrintJobCreated ) pjOrder, -- return two aggregates only works with select, the restricted typr of subSelect does not seem to support this! E.arrayAggWith E.AggModeAll (pj E.^. PrintJobAcknowledged) pjOrder - return (qualUser, user, lmsUser, printAcknowledged) + return (qualUser, user, lmsUser, qualBlock, printAcknowledged) mkLmsTable :: ( Functor h, ToSortable h @@ -395,20 +415,20 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do dbtIdent = "lms" dbtSQLQuery = lmsTableQuery qid dbtRowKey = queryUser >>> (E.^. UserId) - dbtProj = dbtProjSimple $ \(qualUsr, usr, lmsUsr, printAcks) -> do + dbtProj = dbtProjSimple $ \(qualUsr, usr, lmsUsr, qUsrBlock, printAcks) -> do cmpUsr <- selectList [UserCompanyUser ==. entityKey usr] [Asc UserCompanyCompany] - return (qualUsr, usr, lmsUsr, printAcks, cmpUsr) + return (qualUsr, usr, lmsUsr, qUsrBlock, printAcks, cmpUsr) dbtColonnade = cols cmpMap dbtSorting = mconcat [ single $ sortUserNameLink queryUser , single $ sortUserEmail queryUser , single $ sortUserMatriclenr queryUser - , single ("valid-until" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil)) - , single ("validity" , SortColumn $ queryQualUser >>> validQualification nowaday) - , single ("last-refresh" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh)) - , single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld)) - , single ("blocked-due" , SortColumnNeverNull$ queryQualUser >>> (E.^. QualificationUserBlockedDue)) - , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal)) + , single ("valid-until" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil)) + -- , single ("validity" , SortColumn $ queryQualUser >>> validQualification nowaday) + , single ("last-refresh" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh)) + , single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld)) + , single ("blocked" , SortColumnNeverNull$ queryQualBlock >>> (E.?. QualificationUserBlockFrom)) + , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal)) , single ("ident" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserIdent)) , single ("pin" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserPin)) , single ("status" , SortColumnNullsInv $ views (to queryLmsUser) (E.^. LmsUserStatus)) @@ -417,7 +437,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do , single ("received" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserReceived)) , single ("notified" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserNotified)) -- cannot include printJob acknowledge date , single ("ended" , SortColumnNullsInv $ queryLmsUser >>> (E.^. LmsUserEnded)) - , single ( "user-company" , SortColumn $ \row -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do + , single ("user-company", SortColumn $ \row -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.orderBy [E.asc (comp E.^. CompanyName)] @@ -429,7 +449,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do , single ("ident" , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsUser) (E.^. LmsUserIdent)) -- , single ("status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB -- , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil))) - , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification nowaday)) + , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification now)) -- , single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion -> -- if | Just renewal <- mbRenewal -- , Just True <- getLast criterion -> quser E.^. QualificationUserValidUntil E.<=. E.val renewal @@ -496,14 +516,15 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do <*> view (resultQualUser . _entityVal . _qualificationUserValidUntil) <*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh) <*> view (resultQualUser . _entityVal . _qualificationUserFirstHeld) - <*> view (resultQualUser . _entityVal . _qualificationUserBlockedDue) - <*> preview (resultLmsUser . _entityVal . _lmsUserIdent) - <*> (join . preview (resultLmsUser . _entityVal . _lmsUserStatus)) - <*> preview (resultLmsUser . _entityVal . _lmsUserStarted) - <*> preview (resultLmsUser . _entityVal . _lmsUserDatePin) - <*> (join . preview (resultLmsUser . _entityVal . _lmsUserReceived)) - <*> (join . preview (resultLmsUser . _entityVal . _lmsUserNotified)) -- TODO: only exports last email date / print job sending date, not print acknowledge - <*> (join . preview (resultLmsUser . _entityVal . _lmsUserEnded)) + <*> preview (resultQualBlock . _entityVal . _qualificationUserBlockUnblock . _not) + <*> preview (resultQualBlock . _entityVal . _qualificationUserBlockFrom) + <*> view (resultLmsUser . _entityVal . _lmsUserIdent) + <*> view (resultLmsUser . _entityVal . _lmsUserStatus) + <*> view (resultLmsUser . _entityVal . _lmsUserStarted) + <*> view (resultLmsUser . _entityVal . _lmsUserDatePin) + <*> view (resultLmsUser . _entityVal . _lmsUserReceived) + <*> view (resultLmsUser . _entityVal . _lmsUserNotified) -- TODO: only exports last email date / print job sending date, not print acknowledge + <*> view (resultLmsUser . _entityVal . _lmsUserEnded) getCompanies cmps = case mapMaybe (flip Map.lookup cmpMap . view (_entityVal . _userCompanyCompany)) cmps of [] -> pure Nothing somecmps -> pure $ Just $ intercalate ", " $ fmap (view (_companyName . _CI)) somecmps @@ -560,12 +581,13 @@ postLmsR sid qsh = do , singletonMap LmsActRestart $ LmsActRestartData <$> aopt intField (fslI MsgLmsActRestartExtend) Nothing <*> aopt checkBoxField (fslI MsgLmsActRestartUnblock) Nothing + <*> aopt checkBoxField (fslI MsgLmsActNotify) Nothing -- <*> aopt (commentField MsgQualificationActBlockSupervisor) (fslI MsgMessageWarning) Nothing <* aformMessage msgRestartWarning ] -- lmsStatusLink = toMaybe isAdmin LmsUserR colChoices cmpMap = mconcat - [ if not isAdmin then mempty else dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using function "is" + [ if not isAdmin then mempty else dbSelect (applying _2) id (return . view (resultUser . _entityKey)) , colUserNameModalHdr MsgLmsUser AdminUserR , colUserEmail , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) -> @@ -578,12 +600,12 @@ postLmsR sid qsh = do (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs in wgtCell companies , colUserMatriclenr - , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser) + -- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser) , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d - , sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltip - ) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCell b + , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row -> + qualificationValidReasonCell isAdmin nowaday row (row ^? resultQualBlock) , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification , sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> textCell lid @@ -650,34 +672,26 @@ postLmsR sid qsh = do (LmsActRestartData{..}, selectedUsers) -> do let usersList = Set.toList selectedUsers + numUsers = Set.size selectedUsers delUsers <- runDB $ do - when (lmsActRestartUnblock == Just True && ) $ do - authBy <- maybeAuthId - TODO - let unblock = toMaybe (lmsActRestartUnblock == Just True) (nowaday, "Manueller LMS Neustart", authBy) - unblockUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList - [ QualificationUserQualification ==. qid - , QualificationUserUser <-. usersList - , QualificationUserBlockedDue !=. Nothing - ] [] - void $ qualificationUserBlocking qid unblockUsers False Nothing + when (lmsActRestartUnblock == Just True) $ do + oks <- qualificationUserBlocking qid usersList True (Left "Manueller LMS Neustart") (fromMaybe True lmsActRestartNotify) + addMessageI Success $ MsgQualificationStatusUnblock qsh oks numUsers whenIsJust lmsActRestartExtend $ \extDays -> do let cutoff = addDays extDays nowaday shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList [ QualificationUserQualification ==. qid - , QualificationUserUser <-. usersList - , QualificationUserBlockedDue ==. Nothing + , QualificationUserUser <-. usersList , QualificationUserValidUntil <. cutoff ] [] - forM_ shortUsers $ upsertQualificationUser qid nowaday cutoff Nothing Nothing + forM_ shortUsers $ upsertQualificationUser qid nowaday cutoff Nothing fromIntegral <$> deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList] runDBJobs $ forM_ selectedUsers $ \uid -> queueDBJob $ JobLmsEnqueueUser { jQualification = qid, jUser = uid } - let numUsers = length selectedUsers - mStatus = bool Success Warning $ delUsers < numUsers + let mStatus = bool Success Warning $ delUsers < numUsers addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers reloadKeepGetParams $ LmsR sid qsh @@ -714,7 +728,7 @@ getLmsUserR uuid = do uid <- decrypt uuid now <- liftIO getCurrentTime let nowaday = utctDay now - (user@User{userDisplayName}, quals) <- runDB $ do + (user@User{userDisplayName}, quals, qblocks) <- runDB $ do usr <- get404 uid qs <- Ex.select $ do (qual :& qualUsr :& lmsUsr) <- @@ -730,9 +744,21 @@ getLmsUserR uuid = do Ex.where_ $ E.isJust (qualUsr E.?. QualificationUserUser) E.||. E.isJust ( lmsUsr E.?. LmsUserUser) Ex.orderBy [Ex.asc $ qual E.^. QualificationShorthand] - pure (qual, qualUsr, lmsUsr, validQualification' nowaday qualUsr) - return (usr,qs) - + pure (qual, qualUsr, lmsUsr, validQualification' now qualUsr) + bs :: Map.Map QualificationUserId [(Entity QualificationUserBlock, Ex.Value (Maybe UserDisplayName), Ex.Value (Maybe UserSurname))] + <- foldMapM (\(_, mbqu, _, _) -> case mbqu of + Nothing -> pure mempty + Just (Entity quid _) -> do + blocks <- Ex.select $ do + (qBlock :& qbUsr) <- Ex.from $ Ex.table @QualificationUserBlock + `Ex.leftJoin` Ex.table @User + `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) + return $ Map.singleton quid blocks + ) qs + return (usr,qs,bs) let heading = [whamlet|_{MsgMenuLmsUser} ^{userWidget user}|] siteLayout heading $ do setTitle $ toHtml userDisplayName diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index c8a693e13..0e19a441c 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -30,7 +30,7 @@ import Database.Persist.Sql (updateWhereCount) import Database.Esqueleto.Experimental ((:&)(..)) import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma import qualified Database.Esqueleto.Legacy as E --- import qualified Database.Esqueleto.PostgreSQL as E +import qualified Database.Esqueleto.PostgreSQL as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH @@ -152,7 +152,8 @@ data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc.. , qtcCompanyNumbers :: CsvSemicolonList Int , qtcValidUntil :: Day , qtcLastRefresh :: Day - , qtcBlocked :: Maybe UTCTime + , qtcBlockStatus :: Maybe Bool + , qtcBlockFrom :: Maybe UTCTime , qtcScheduleRenewal:: Bool , qtcLmsStatusTxt :: Maybe Text , qtcLmsStatusDay :: Maybe Day @@ -168,7 +169,8 @@ qtcExample = QualificationTableCsv , qtcCompanyNumbers = CsvSemicolonList [27,69] , qtcValidUntil = compDay , qtcLastRefresh = compDay - , qtcBlocked = Nothing + , qtcBlockStatus = Nothing + , qtcBlockFrom = Nothing , qtcScheduleRenewal= True , qtcLmsStatusTxt = Just "Success" , qtcLmsStatusDay = Just compDay @@ -201,7 +203,9 @@ instance CsvColumnsExplained QualificationTableCsv where , ('qtcCompany , SomeMessage MsgTableCompanies) , ('qtcCompanyNumbers , SomeMessage MsgTableCompanyNos) , ('qtcValidUntil , SomeMessage MsgLmsQualificationValidUntil) - , ('qtcLastRefresh , SomeMessage MsgTableQualificationLastRefresh) + , ('qtcLastRefresh , SomeMessage MsgTableQualificationLastRefresh) + , ('qtcBlockStatus , SomeMessage MsgInfoQualificationBlockStatus) + , ('qtcBlockFrom , SomeMessage MsgInfoQualificationBlockFrom) , ('qtcScheduleRenewal, SomeMessage MsgQualificationScheduleRenewalTooltip) , ('qtcLmsStatusTxt , SomeMessage MsgTableLmsStatus) , ('qtcLmsStatusDay , SomeMessage MsgTableLmsStatusDay) @@ -249,6 +253,16 @@ instance HasEntity QualificationTableData User where instance HasUser QualificationTableData where hasUser = resultUser . _entityVal +instance HasEntity QualificationTableData QualificationUser where + hasEntity = resultQualUser + +instance HasQualificationUser QualificationTableData where + hasQualificationUser = resultQualUser . _entityVal + +-- instance HasEntity QualificationUserBlock where +-- hasQualificationUserBlock = resultQualBlock + + data QualificationTableAction = QualificationActExpire | QualificationActUnexpire @@ -325,10 +339,7 @@ qualificationTableQuery qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJoin` E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser E.where_ $ fltr qualUser E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification) - E.&&. E.notExists (E.from $ \earlierBlock -> - E.where_ $ earlierBlock E.^. QualificationUserBlockQualificationUser E.=?. qualBlock E.?. QualificationUserBlockQualificationUser - E.&&. E.just (earlierBlock E.^. QualificationUserBlockFrom) E.>. qualBlock E.?. QualificationUserBlockFrom - ) + E.&&. qualBlock `isLatestBlockBefore` E.now_ return (qualUser, user, lmsUser, qualBlock) @@ -378,7 +389,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do , single ("lms-status-plus",SortColumnNeverNull $ \row -> E.coalesce [E.explicitUnsafeCoerceSqlExprValue "timestamp" $ (queryLmsUser row E.?. LmsUserStatus) E.#>>. "{day}" , queryLmsUser row E.?. LmsUserStarted]) , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal)) - , single ( "user-company" , SortColumn $ \row -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do + , single ("user-company" , SortColumn $ \row -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId E.where_ $ usrComp E.^. UserCompanyUser E.==. queryUser row E.^. UserId E.orderBy [E.asc (comp E.^. CompanyName)] @@ -450,6 +461,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do <*> (view resultCompanyUser >>= getCompanyNos) <*> view (resultQualUser . _entityVal . _qualificationUserValidUntil) <*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh) + <*> preview (resultQualBlock. _entityVal . _qualificationUserBlockUnblock . _not) <*> preview (resultQualBlock. _entityVal . _qualificationUserBlockFrom) <*> view (resultQualUser . _entityVal . _qualificationUserScheduleRenewal) <*> getStatusPlusTxt @@ -573,7 +585,7 @@ postQualificationR sid qsh = do , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil)) , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row -> - qualificationValidReasonCell isAdmin nowaday (row ^. resultQualUser) (row ^? resultQualBlock) + qualificationValidReasonCell isAdmin nowaday row (row ^? resultQualBlock) , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification , sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths)) @@ -590,7 +602,7 @@ postQualificationR sid qsh = do addMessageI (if noks > 0 && noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks reloadKeepGetParams $ QualificationR sid qsh (QualificationActGrantData grantValidday, selectedUsers) | isAdmin -> do - runDB . forM_ selectedUsers $ upsertQualificationUser qid nowaday grantValidday Nothing Nothing + runDB . forM_ selectedUsers $ upsertQualificationUser qid nowaday grantValidday Nothing addMessageI (if 0 < Set.size selectedUsers then Success else Warning) . MsgTutorialUserGrantedQualification $ Set.size selectedUsers reloadKeepGetParams $ QualificationR sid qsh (action, selectedUsers) | isExpiryAct action -> do diff --git a/src/Handler/Utils/Qualification.hs b/src/Handler/Utils/Qualification.hs index 6c27ba64f..821679e27 100644 --- a/src/Handler/Utils/Qualification.hs +++ b/src/Handler/Utils/Qualification.hs @@ -65,31 +65,37 @@ quserToNotify quser cutoff = ) ) +-- condition to ensure that the lastes QualificationUserBlock was picked +isLatestBlockBefore :: E.SqlExpr (Maybe (Entity QualificationUserBlock)) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Bool) +isLatestBlockBefore qualBlock cutoff = E.notExists $ do + newerBlock <- E.from $ E.table @QualificationUserBlock + E.where_ $ newerBlock E.^. QualificationUserBlockFrom E.<=. cutoff + E.&&. E.just (newerBlock E.^. QualificationUserBlockFrom) E.>. qualBlock E.?. QualificationUserBlockFrom + E.&&. newerBlock E.^. QualificationUserBlockQualificationUser E.=?. qualBlock E.?. QualificationUserBlockQualificationUser --- TODO: consider replacing `cutoff` by `Database.Esqueleto.PostgreSQL.now_`? - -quserBlockAux :: Bool -> UTCTime -> (E.SqlExpr (E.Value QualificationUserId) -> E.SqlExpr (E.Value Bool)) -> Maybe (E.SqlExpr (Entity QualificationUserBlock) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool) +-- cutoff can be `E.val now` or even `Database.Esqueleto.PostgreSQL.now_` +quserBlockAux :: Bool -> E.SqlExpr (E.Value UTCTime) -> (E.SqlExpr (E.Value QualificationUserId) -> E.SqlExpr (E.Value Bool)) -> Maybe (E.SqlExpr (Entity QualificationUserBlock) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool) quserBlockAux negCond cutoff checkQualUserId mbBlockCondition = bool E.notExists E.exists negCond $ do qualUserBlock <- E.from $ E.table @QualificationUserBlock E.where_ $ E.not_ (qualUserBlock E.^. QualificationUserBlockUnblock) - E.&&. (qualUserBlock E.^. QualificationUserBlockFrom E.<=. E.val cutoff) + E.&&. (qualUserBlock E.^. QualificationUserBlockFrom E.<=. cutoff) E.&&. checkQualUserId (qualUserBlock E.^. QualificationUserBlockQualificationUser) E.&&. E.notExists (do qualUserUnblock <- E.from $ E.table @QualificationUserBlock E.where_ $ (qualUserUnblock E.^. QualificationUserBlockUnblock) E.&&. checkQualUserId (qualUserUnblock E.^. QualificationUserBlockQualificationUser) - E.&&. qualUserUnblock E.^. QualificationUserBlockFrom E.<=. E.val cutoff + E.&&. qualUserUnblock E.^. QualificationUserBlockFrom E.<=. cutoff E.&&. qualUserUnblock E.^. QualificationUserBlockFrom E.>. qualUserBlock E.^. QualificationUserBlockFrom ) whenIsJust mbBlockCondition (E.where_ . ($ qualUserBlock)) -- | Test whether a QualificationUser was blocked/unblocked at a given day; negCond: True:isBlocked False:isUnblocked quserBlock :: Bool -> UTCTime -> E.SqlExpr (Entity QualificationUser) -> E.SqlExpr (E.Value Bool) -quserBlock negCond cutoff qualUser = quserBlockAux negCond cutoff (E.==. (qualUser E.^. QualificationUserId)) Nothing +quserBlock negCond cutoff qualUser = quserBlockAux negCond (E.val cutoff) (E.==. (qualUser E.^. QualificationUserId)) Nothing -- | Variant of `isBlocked` for outer joins quserBlock' :: Bool -> UTCTime -> E.SqlExpr (Maybe (Entity QualificationUser)) -> E.SqlExpr (E.Value Bool) -quserBlock' negCond cutoff qualUser = quserBlockAux negCond cutoff (E.=?. (qualUser E.?. QualificationUserId)) Nothing +quserBlock' negCond cutoff qualUser = quserBlockAux negCond (E.val cutoff) (E.=?. (qualUser E.?. QualificationUserId)) Nothing qualificationValid :: E.SqlExpr (Entity QualificationUser) -> UTCTime -> E.SqlExpr (E.Value Bool) qualificationValid = flip validQualification @@ -127,8 +133,8 @@ selectRelevantBlock cutoff quid = ------------------------ -upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> Maybe (UTCTime, Text, Maybe UserId) -> UserId -> DB () -- may also unblock -upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal mbUnblockBecause qualificationUserUser = do +upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB () -- ignores blocking +upsertQualificationUser qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do Entity quid _ <- upsert QualificationUser { qualificationUserFirstHeld = qualificationUserLastRefresh @@ -144,12 +150,6 @@ upsertQualificationUser qualificationUserQualification qualificationUserLastRef ] ) - whenIsJust mbUnblockBecause $ \(qualificationUserBlockFrom, qualificationUserBlockReason, qualificationUserBlockBlocker) -> do - block <- selectFirst [ QualificationUserBlockQualificationUser ==. quid ] [ Desc QualificationUserBlockFrom ] - whenIsJust block $ \qub -> - unless (qub ^. _entityVal . _qualificationUserBlockUnblock) $ - insert_ QualificationUserBlock{ qualificationUserBlockQualificationUser = quid, qualificationUserBlockUnblock = True, ..} - audit TransactionQualificationUserEdit { transactionQualificationUser = quid , transactionQualification = qualificationUserQualification @@ -264,6 +264,6 @@ qualificationUserUnblockByReason qid uids (qualificationBlockReasonText -> reaso quser <- E.from $ E.table @QualificationUser E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid E.&&. quser E.^. QualificationUserUser `E.in_` E.valList uids - E.&&. quserBlockAux True now (E.==. (quser E.^. QualificationUserId)) (Just (\qblock -> (qblock E.^. QualificationUserBlockReason) E.==. E.val reason)) + E.&&. quserBlockAux True (E.val now) (E.==. (quser E.^. QualificationUserId)) (Just (\qblock -> (qblock E.^. QualificationUserBlockReason) E.==. E.val reason)) return $ quser E.^. QualificationUserUser qualificationUserBlocking qid (E.unValue <$> toUnblock) True undo_reason notify diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 879358cf2..5b3da66ed 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -333,29 +333,20 @@ qualificationValidUntilCell q = textCell (qsh <> ": ") <> dayCell vtd vtd = q ^. hasQualificationUser . _qualificationUserValidUntil qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> a -> Maybe b -> DBCell m c -qualificationValidIconCell d qu qb = iconBoolCell $ isValidQualification d qu qb +qualificationValidIconCell d qu qb = blockIcon $ isValidQualification d qu qb + where + blockIcon = cell . toWidget . iconQualificationBlock qualificationValidReasonCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Bool -> Day -> a -> Maybe b -> DBCell m c qualificationValidReasonCell showReason d qu qb = ic <> foldMap blc qb - where - ic = iconBoolCell $ isValidQualification d qu qb + where + ic = cell . toWidget . iconQualificationBlock $ isValidQualification d qu qb blc (view hasQualificationUserBlock -> QualificationUserBlock{..}) | showReason = spacerCell <> dateCell qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason -- TODO: add anchorLink to block history, if user is allowed | qualificationUserBlockUnblock = mempty | otherwise = spacerCell <> dateCell qualificationUserBlockFrom --- qualificationBlockedCellNoReason :: IsDBTable m a => QualificationUserBlock -> DBCell m a --- qualificationBlockedCellNoReason QualificationUserBlock{qualificationUserBlockFrom=t, qualificationUserBlockUnblock=unblock} = --- iconBoolCell unblock <> spacerCell <> dateCell d - --- qualificationBlockedCell :: IsDBTable m a => QualificationUserBlock -> DBCell m a --- qualificationBlockedCell QualificationUserBlock{..} --- | 32 >= length qualificationUserBlockReason = mkCellWith textCell --- | otherwise = mkCellWith modalCell --- where --- mkCellWith c = c qualificationUserBlockReason <> spacerCell <> iconCell IconBlocked <> spacerCell <> dayCell qualificationUserBlockFrom - lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name where diff --git a/src/Utils.hs b/src/Utils.hs index 9b3390c5c..226b84bbc 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -1209,11 +1209,12 @@ partitionM crit = ofoldlM dist mempty | okay -> acc `mappend` (opoint x, mempty) | otherwise -> acc `mappend` (mempty, opoint x) -mconcatMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b -mconcatMapM f = foldM (\x my -> mappend x <$> my) mempty . map f . Fold.toList +-- use `foldMapM` instead +-- mconcatMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b +-- mconcatMapM f = foldM (\x my -> mappend x <$> my) mempty . map f . Fold.toList -mconcatForM :: (Monoid b, Monad m, Foldable f) => f a -> (a -> m b) -> m b -mconcatForM = flip mconcatMapM +-- mconcatForM :: (Monoid b, Monad m, Foldable f) => f a -> (a -> m b) -> m b +-- mconcatForM = flip mconcatMapM findM :: (Monad m, Foldable f) => (a -> MaybeT m b) -> f a -> m (Maybe b) findM f = runMaybeT . Fold.foldr (\x as -> f x <|> as) mzero diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index eda59372c..260e0e03b 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -104,6 +104,7 @@ data Icon | IconRemoveUser | IconReset | IconBlocked + | IconCertificate | IconPrintCenter | IconLetter | IconAt @@ -191,6 +192,7 @@ iconText = \case IconSubmissionNoUsers -> "user-slash" IconReset -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left" IconBlocked -> "ban" + IconCertificate -> "badge-check" IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk" IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well IconAt -> "at" @@ -295,6 +297,10 @@ iconLetterOrEmail :: Bool -> Markup iconLetterOrEmail True = icon IconLetter iconLetterOrEmail False = icon IconAt +iconQualificationBlock :: Bool -> Markup +iconQualificationBlock True = icon IconCertificate +iconQualificationBlock False = icon IconBlocked + ---------------- -- For documentation on how to avoid these unneccessary functions -- we implement them here just once for the first icon: diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 9c3791c30..9bab8bda5 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -166,7 +166,7 @@ instance HasQualificationUser a => HasQualificationUser (Entity a) where -- hasQualificationUser = _2 . hasQualificationUser instance HasQualificationUserBlock a => HasQualificationUserBlock (Entity a) where - hasQualificationUser = _entityVal . hasQualificationUserBlock + hasQualificationUserBlock = _entityVal . hasQualificationUserBlock instance HasLmsUser a => HasLmsUser (Entity a) where hasLmsUser = _entityVal . hasLmsUser diff --git a/templates/lms-user.hamlet b/templates/lms-user.hamlet index 842013fc4..c039d4c93 100644 --- a/templates/lms-user.hamlet +++ b/templates/lms-user.hamlet @@ -11,19 +11,33 @@ $else

- #{qualificationShorthand quali} - #{qualificationName quali} (#{qualificationSchool quali})   #{boolSymbol (E.unValue validity)} + #{qualificationShorthand quali} - #{qualificationName quali} (#{qualificationSchool quali})   + + #{iconQualificationBlock (E.unValue validity)}
- $maybe (Entity _ qualUsr) <- mbQualUsr + $maybe (Entity quid qualUsr) <- mbQualUsr
_{MsgLmsQualificationValidUntil}
^{formatTimeW SelFormatDate (qualificationUserValidUntil qualUsr)} $if not (qualificationUserScheduleRenewal qualUsr) \ #{icon IconNoNotification} - $maybe (qblock) <- qualificationUserBlockedDue qualUsr + $maybe qblock <- Map.lookup quid qblocks
_{MsgTableQualificationBlockedDue} -
^{formatTimeW SelFormatDate (qualificationBlockedDay qblock)} - \ #{icon IconBlocked} - \ #{qualificationBlockedReason qblock} +
+
    + $forall (Entity _ block, blockerDN, blockerSN) <- qblock +
  • + ^{formatTimeW SelFormatDateTime (view _qualificationUserBlockFrom block)} + \ #{iconQualificationBlock (view _qualificationUserBlockUnblock block)} + \ #{view _qualificationUserBlockReason block} +

    + $maybe bdn <- E.unValue blockerDN + $maybe bsn <- E.unValue blockerSN + ^{nameWidget bdn bsn} + $nothing + ^{text2widget bdn} + $nothing + ?

    _{MsgTableQualificationLastRefresh}
    ^{formatTimeW SelFormatDate (qualificationUserLastRefresh qualUsr)}
    _{MsgTableQualificationFirstHeld} @@ -57,5 +71,6 @@ $else $maybe ts <- lmsUserEnded lmsUsr
    _{MsgTableLmsEnded}
    ^{formatTimeW SelFormatDateTime ts} - - + $nothing +
    _{MsgLmsInactive} +