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

chore(cells): add links to qualifications cells

Browse Source
This commit is contained in:
Steffen Jost 2023-06-30 15:03:56 +00:00
parent ab48e40ac7
commit 6683d5e4e8
9 changed files with 62 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -117,8 +117,9 @@ MenuLanguage: Sprache
MenuQualifications: Qualifikationen MenuQualifications: Qualifikationen
MenuLms !ident-ok: E‑Learning MenuLms !ident-ok: E‑Learning
MenuLmsEdit: Bearbeiten E‑Learning MenuLmsEdit: Bearbeiten E‑Learning
MenuLmsUser: Benutzer Qualifikationen MenuLmsUser: Benutzerqualifikationen
MenuLmsUserAll: Alle Benutzer Qualifikationen MenuLmsUserSchool: Bereichs Benutzerqualifikationen
MenuLmsUserAll: Alle Benutzerqualifikationen
MenuLmsUsers: Export E‑Learning Benutzer MenuLmsUsers: Export E‑Learning Benutzer
MenuLmsUserlist: Melden E‑Learning Benutzer MenuLmsUserlist: Melden E‑Learning Benutzer
MenuLmsResult: Melden Ergebnisse E‑Learning MenuLmsResult: Melden Ergebnisse E‑Learning

1
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -119,6 +119,7 @@ MenuQualifications: Qualifications
MenuLms: E‑Learning MenuLms: E‑Learning
MenuLmsEdit: Edit E‑Learning MenuLmsEdit: Edit E‑Learning
MenuLmsUser: User Qualifications MenuLmsUser: User Qualifications
MenuLmsUserSchool: Institute User Qualifications
MenuLmsUserAll: All User Qualifications MenuLmsUserAll: All User Qualifications
MenuLmsUsers: Download E‑Learning Users MenuLmsUsers: Download E‑Learning Users
MenuLmsUserlist: Upload E‑Learning Users MenuLmsUserlist: Upload E‑Learning Users

1
routes
View File

@ -283,6 +283,7 @@
/lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter /lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter
/lms/#SchoolId/#QualificationShorthand/user/#CryptoUUIDUser LmsUserR GET /lms/#SchoolId/#QualificationShorthand/user/#CryptoUUIDUser LmsUserR GET
/lmsuser/#CryptoUUIDUser LmsUserAllR GET /lmsuser/#CryptoUUIDUser LmsUserAllR GET
/lmsuser/#CryptoUUIDUser/#SchoolId LmsUserSchoolR GET
/api ApiDocsR GET !free /api ApiDocsR GET !free
/swagger SwaggerR GET !free /swagger SwaggerR GET !free

5
src/Foundation/Navigation.hs
View File

@ -186,8 +186,9 @@ breadcrumb (LmsResultR ssh qsh) = i18nCrumb MsgMenuLmsResult $ Jus
breadcrumb (LmsResultUploadR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh breadcrumb (LmsResultUploadR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh
breadcrumb (LmsResultDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh -- never displayed breadcrumb (LmsResultDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh -- never displayed
breadcrumb (LmsIdentR ssh qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect breadcrumb (LmsIdentR ssh qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect
breadcrumb (LmsUserR _ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserAllR u breadcrumb (LmsUserR ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserSchoolR u ssh
breadcrumb (LmsUserAllR _ ) = i18nCrumb MsgMenuLmsUserAll $ Just LmsAllR breadcrumb (LmsUserSchoolR u _ ) = i18nCrumb MsgMenuLmsUserSchool $ Just $ LmsUserAllR u
breadcrumb (LmsUserAllR _ ) = i18nCrumb MsgMenuLmsUserAll $ Just LmsAllR
-- breadcrumb (LmsFakeR ssh qsh) = i18nCrumb MsgMenuLmsFake $ Just $ LmsR ssh qsh -- TODO: remove in production -- breadcrumb (LmsFakeR ssh qsh) = i18nCrumb MsgMenuLmsFake $ Just $ LmsR ssh qsh -- TODO: remove in production
breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing

26
src/Handler/Admin/Avs.hs
View File

@ -561,29 +561,29 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
icnSuper = text2markup " " <> icon IconSupervisor icnSuper = text2markup " " <> icon IconSupervisor
pure $ toWgt $ mconcat companies pure $ toWgt $ mconcat companies
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q , sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q
-- , sortable (Just "validity") (i18nCell MsgQualificationValidIndicator) $ \row ->
-- cellMaybe (qualificationValidIconCell nowaday (row ^? resultQualBlock)) (row ^? resultQualUser)
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d -- , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \row ->
cellMaybe (qualificationValidUntilCell nowaday (row ^? resultQualBlock)) (row ^? resultQualUser)
, sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row -> , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row ->
cellMaybe (qualificationValidReasonCell True nowaday (row ^? resultQualBlock)) (row ^? resultQualUser) cellMaybe (qualificationValidReasonCell' Nothing True nowaday (row ^? resultQualBlock)) (row ^? resultQualUser)
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \(preview $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> cellMaybe (flip ifIconCell IconNoNotification . not) b ) $ \(preview $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> cellMaybe (flip ifIconCell IconNoNotification . not) b
, sortable Nothing (i18nCell MsgTableAvsActiveCards) $ \(view $ resultUserAvs . _userAvsPersonId -> apid) -> foldMap avsPersonCardCell $ Map.lookup apid apidStatus , sortable Nothing (i18nCell MsgTableAvsActiveCards) $ \(view $ resultUserAvs . _userAvsPersonId -> apid) -> foldMap avsPersonCardCell $ Map.lookup apid apidStatus
] ]
dbtSorting = mconcat dbtSorting = mconcat
[ single $ sortUserNameLink queryUser [ single $ sortUserNameLink queryUser
, single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson)) , single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson))
, single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand)) , single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand))
, single $ sortUserCompany queryUser , single $ sortUserCompany queryUser
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil)) , single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh)) , single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh))
, single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld)) , single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld))
, single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom)) , single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom))
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal)) , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal))
, single ("validity" , SortColumn $ queryQualUser >>> validQualification' now) -- , single ("validity" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser [ single $ fltrUserNameEmail queryUser

6
src/Handler/Course/Users.hs
View File

@ -187,13 +187,13 @@ colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns
colUserQualifications :: forall m c. IsDBTable m c => Day -> Colonnade Sortable UserTableData (DBCell m c) colUserQualifications :: forall m c. IsDBTable m c => Day -> Colonnade Sortable UserTableData (DBCell m c)
colUserQualifications cutoff = sortable (Just "qualifications") (i18nCell MsgTableQualifications) $ colUserQualifications cutoff = sortable (Just "qualifications") (i18nCell MsgTableQualifications) $
let qualNamedValidCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidIconCell cutoff qb qu <> spacerCell <> dayCell (qu ^. _qualificationUserValidUntil) let qualNamedValidCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidUntilCell cutoff qb qu
in \(view _userCourseQualifications -> qualis) -> in \(view _userCourseQualifications -> qualis) ->
(cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedValidCell (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedValidCell
colUserQualificationBlocked :: forall m c. IsDBTable m c => Bool -> Day -> Colonnade Sortable UserTableData (DBCell m c) colUserQualificationBlocked :: forall m c. IsDBTable m c => Bool -> Day -> Colonnade Sortable UserTableData (DBCell m c)
colUserQualificationBlocked isAdmin cutoff = sortable (Just "qualification-block") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ colUserQualificationBlocked isAdmin cutoff = sortable (Just "qualification-block") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $
let qualNamedReasonCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidReasonCell isAdmin cutoff qb qu let qualNamedReasonCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidReasonCell' Nothing isAdmin cutoff qb qu
in \(view _userCourseQualifications -> qualis) -> in \(view _userCourseQualifications -> qualis) ->
(cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedReasonCell (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedReasonCell

5
src/Handler/LMS.hs
View File

@ -603,7 +603,7 @@ postLmsR sid qsh = do
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row -> , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltip) $ \row ->
qualificationValidReasonCell isAdmin nowaday (row ^? resultQualBlock) row qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
, sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> textCell lid , sortable (Just "ident") (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> textCell lid
@ -724,6 +724,9 @@ getLmsIdentR sid qid ident = redirect (LmsR sid qid, [("lms-ident", toPathPiece
getLmsUserAllR :: CryptoUUIDUser -> Handler Html getLmsUserAllR :: CryptoUUIDUser -> Handler Html
getLmsUserAllR = viewLmsUserR Nothing Nothing getLmsUserAllR = viewLmsUserR Nothing Nothing
getLmsUserSchoolR :: CryptoUUIDUser -> SchoolId -> Handler Html
getLmsUserSchoolR uuid sid = viewLmsUserR (Just sid) Nothing uuid
getLmsUserR :: SchoolId -> QualificationShorthand -> CryptoUUIDUser -> Handler Html getLmsUserR :: SchoolId -> QualificationShorthand -> CryptoUUIDUser -> Handler Html
getLmsUserR sid qsh = viewLmsUserR (Just sid) (Just qsh) getLmsUserR sid qsh = viewLmsUserR (Just sid) (Just qsh)

6
src/Handler/Qualification.hs
View File

@ -584,11 +584,11 @@ postQualificationR sid qsh = do
in wgtCell companies in wgtCell companies
, guardMonoid isAdmin colUserMatriclenr , guardMonoid isAdmin 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) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil))
, 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 "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil))
, sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row -> , sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row ->
qualificationValidReasonCell isAdmin nowaday (row ^? resultQualBlock) row qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip , sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths)) , sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))

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

@ -165,16 +165,16 @@ markupCellLargeModal mup
----------------- -----------------
-- Datatype cells -- Datatype cells
timeCell :: IsDBTable m a => UTCTime -> DBCell m a timeCell :: IsDBTable m a => UTCTime -> DBCell m a
timeCell t = cell $ formatTime SelFormatTime t >>= toWidget timeCell t = cell $ formatTimeW SelFormatTime t
dateTimeCell :: IsDBTable m a => UTCTime -> DBCell m a dateTimeCell :: IsDBTable m a => UTCTime -> DBCell m a
dateTimeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget dateTimeCell t = cell $ formatTimeW SelFormatDateTime t
dateCell :: IsDBTable m a => UTCTime -> DBCell m a dateCell :: IsDBTable m a => UTCTime -> DBCell m a
dateCell t = cell $ formatTime SelFormatDate t >>= toWidget dateCell t = cell $ formatTimeW SelFormatDate t
dayCell :: IsDBTable m a => Day -> DBCell m a dayCell :: IsDBTable m a => Day -> DBCell m a
dayCell utctDay = cell $ formatTime SelFormatDate UTCTime{..} >>= toWidget dayCell utctDay = cell $ formatTimeW SelFormatDate UTCTime{..}
where utctDayTime = 0 where utctDayTime = 0
-- | Show a date, and highlight date earlier than given watershed with an icon and cell class Warning -- | Show a date, and highlight date earlier than given watershed with an icon and cell class Warning
@ -326,28 +326,45 @@ qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualific
Nothing -> mempty Nothing -> mempty
(Just descr) -> spacerCell <> markupCellLargeModal descr (Just descr) -> spacerCell <> markupCellLargeModal descr
-- DEPRECATED
-- qualificationValidUntilCell :: (IsDBTable m c, HasQualification a, HasQualificationUser a) => a -> DBCell m c
-- qualificationValidUntilCell q = textCell (qsh <> ": ") <> dayCell vtd
-- where
-- qsh = q ^. hasQualification . _qualificationShorthand . _CI
-- vtd = q ^. hasQualificationUser . _qualificationUserValidUntil
qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c
qualificationValidIconCell d qb qu = do qualificationValidIconCell d qb qu = do
blockIcon $ isValidQualification d qu qb blockIcon $ isValidQualification d qu qb
where where
blockIcon = cell . toWidget . iconQualificationBlock blockIcon = cell . toWidget . iconQualificationBlock
qualificationValidUntilCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c
qualificationValidUntilCell = qualificationValidUntilCell' (Just LmsUserAllR)
qualificationValidUntilCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Day -> Maybe b -> a -> DBCell m c
qualificationValidUntilCell' mbToLink d qb qu = cell $ case mbToLink of
Nothing -> headWgt <> dateWgt
Just toLink -> do
uuid <- liftHandler $ encrypt $ qu ^. hasQualificationUser . _qualificationUserUser
let modalWgt = modal blockWgt (Left $ SomeRoute $ toLink uuid)
headWgt <> modalWgt
where
dateWgt = formatTimeW SelFormatDate (qu ^. hasQualificationUser . _qualificationUserValidUntil)
iconWgt = toWidget $ iconQualificationBlock $ isValidQualification d qu qb
headWgt = iconWgt <> [whamlet|&emsp;|]
qualificationValidReasonCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Bool -> Day -> Maybe b -> a -> DBCell m c qualificationValidReasonCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Bool -> Day -> Maybe b -> a -> DBCell m c
qualificationValidReasonCell showReason d qb qu = ic <> foldMap blc qb qualificationValidReasonCell = qualificationValidReasonCell' (Just LmsUserAllR)
qualificationValidReasonCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Bool -> Day -> Maybe b -> a -> DBCell m c
qualificationValidReasonCell' mbToLink showReason d qb qu = ic <> foldMap blc qb
where where
ic = cell . toWidget . iconQualificationBlock $ isValidQualification d qu qb ic = cell . toWidget . iconQualificationBlock $ isValidQualification d qu qb
blc (view hasQualificationUserBlock -> QualificationUserBlock{..}) blc (view hasQualificationUserBlock -> QualificationUserBlock{..})
| showReason = spacerCell <> dateCell qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason
-- TODO: add anchorLink to block history, if user is allowed
| qualificationUserBlockUnblock = mempty | qualificationUserBlockUnblock = mempty
| otherwise = spacerCell <> dateCell qualificationUserBlockFrom | otherwise = spacerCell <> dateCell qualificationUserBlockFrom
dc tstamp
| Just toLink <- mbToLink = cell $ do
uuid <- liftHandler $ encrypt uid
modal (formatTimeW SelFormatDate tstamp) (Left $ SomeRoute $ toLink uuid)
-- anchorCellM (toLink <$> encrypt uid)
| otherwise = dateCell tstamp
uid = qu ^. hasQualificationUser . _qualificationUserUser
lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c lmsShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name lmsShortCell (view hasQualification -> Qualification{..}) = anchorCell link name