chore(cells): add links to qualifications cells
This commit is contained in:
parent
ab48e40ac7
commit
6683d5e4e8
@ -117,8 +117,9 @@ MenuLanguage: Sprache
|
||||
MenuQualifications: Qualifikationen
|
||||
MenuLms !ident-ok: E‑Learning
|
||||
MenuLmsEdit: Bearbeiten E‑Learning
|
||||
MenuLmsUser: Benutzer Qualifikationen
|
||||
MenuLmsUserAll: Alle Benutzer Qualifikationen
|
||||
MenuLmsUser: Benutzerqualifikationen
|
||||
MenuLmsUserSchool: Bereichs Benutzerqualifikationen
|
||||
MenuLmsUserAll: Alle Benutzerqualifikationen
|
||||
MenuLmsUsers: Export E‑Learning Benutzer
|
||||
MenuLmsUserlist: Melden E‑Learning Benutzer
|
||||
MenuLmsResult: Melden Ergebnisse E‑Learning
|
||||
|
||||
@ -119,6 +119,7 @@ MenuQualifications: Qualifications
|
||||
MenuLms: E‑Learning
|
||||
MenuLmsEdit: Edit E‑Learning
|
||||
MenuLmsUser: User Qualifications
|
||||
MenuLmsUserSchool: Institute User Qualifications
|
||||
MenuLmsUserAll: All User Qualifications
|
||||
MenuLmsUsers: Download E‑Learning Users
|
||||
MenuLmsUserlist: Upload E‑Learning Users
|
||||
|
||||
1
routes
1
routes
@ -283,6 +283,7 @@
|
||||
/lms/#SchoolId/#QualificationShorthand/ident/#LmsIdent LmsIdentR GET -- redirect to LmsR with filter-parameter
|
||||
/lms/#SchoolId/#QualificationShorthand/user/#CryptoUUIDUser LmsUserR GET
|
||||
/lmsuser/#CryptoUUIDUser LmsUserAllR GET
|
||||
/lmsuser/#CryptoUUIDUser/#SchoolId LmsUserSchoolR GET
|
||||
|
||||
/api ApiDocsR GET !free
|
||||
/swagger SwaggerR GET !free
|
||||
|
||||
@ -186,8 +186,9 @@ breadcrumb (LmsResultR ssh qsh) = i18nCrumb MsgMenuLmsResult $ Jus
|
||||
breadcrumb (LmsResultUploadR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh
|
||||
breadcrumb (LmsResultDirectR ssh qsh) = i18nCrumb MsgMenuLmsUpload $ Just $ LmsResultR ssh qsh -- never displayed
|
||||
breadcrumb (LmsIdentR ssh qsh _ ) = breadcrumb $ LmsR ssh qsh -- just a redirect
|
||||
breadcrumb (LmsUserR _ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserAllR u
|
||||
breadcrumb (LmsUserAllR _ ) = i18nCrumb MsgMenuLmsUserAll $ Just LmsAllR
|
||||
breadcrumb (LmsUserR ssh _qsh u ) = i18nCrumb MsgMenuLmsUser $ Just $ LmsUserSchoolR u ssh
|
||||
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 ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing
|
||||
|
||||
@ -561,29 +561,29 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
pure $ toWgt $ mconcat companies
|
||||
, 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 "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 ->
|
||||
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
|
||||
) $ \(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
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUser
|
||||
, single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson))
|
||||
, single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand))
|
||||
, single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson))
|
||||
, single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand))
|
||||
, single $ sortUserCompany queryUser
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh))
|
||||
, single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld))
|
||||
, single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom))
|
||||
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal))
|
||||
, single ("validity" , SortColumn $ queryQualUser >>> validQualification' now)
|
||||
]
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh))
|
||||
, single ("first-held" , SortColumn $ queryQualUser >>> (E.?. QualificationUserFirstHeld))
|
||||
, single ("blocked" , SortColumnNeverNull $ queryQualBlock >>> (E.?. QualificationUserBlockFrom))
|
||||
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.?. QualificationUserScheduleRenewal))
|
||||
-- , single ("validity" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
|
||||
]
|
||||
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
|
||||
@ -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 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) ->
|
||||
(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 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
|
||||
colUserQualificationBlocked isAdmin cutoff = sortable (Just "qualification-block") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $
|
||||
let qualNamedReasonCell (q,qu,qb) = textCell ((q ^. hasQualification . _qualificationShorthand . _CI) <> ": ") <> qualificationValidReasonCell' Nothing isAdmin cutoff qb qu
|
||||
in \(view _userCourseQualifications -> qualis) ->
|
||||
(cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell qualis $ qualNamedReasonCell
|
||||
|
||||
|
||||
@ -603,7 +603,7 @@ postLmsR sid qsh = do
|
||||
, 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 "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
|
||||
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
|
||||
, 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 = viewLmsUserR Nothing Nothing
|
||||
|
||||
getLmsUserSchoolR :: CryptoUUIDUser -> SchoolId -> Handler Html
|
||||
getLmsUserSchoolR uuid sid = viewLmsUserR (Just sid) Nothing uuid
|
||||
|
||||
getLmsUserR :: SchoolId -> QualificationShorthand -> CryptoUUIDUser -> Handler Html
|
||||
getLmsUserR sid qsh = viewLmsUserR (Just sid) (Just qsh)
|
||||
|
||||
|
||||
@ -584,11 +584,11 @@ postQualificationR sid qsh = do
|
||||
in wgtCell companies
|
||||
, guardMonoid isAdmin colUserMatriclenr
|
||||
-- , 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 "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 ->
|
||||
qualificationValidReasonCell isAdmin nowaday (row ^? resultQualBlock) row
|
||||
qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row
|
||||
, 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))
|
||||
|
||||
@ -165,16 +165,16 @@ markupCellLargeModal mup
|
||||
-----------------
|
||||
-- Datatype cells
|
||||
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 t = cell $ formatTime SelFormatDateTime t >>= toWidget
|
||||
dateTimeCell t = cell $ formatTimeW SelFormatDateTime t
|
||||
|
||||
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 utctDay = cell $ formatTime SelFormatDate UTCTime{..} >>= toWidget
|
||||
dayCell utctDay = cell $ formatTimeW SelFormatDate UTCTime{..}
|
||||
where utctDayTime = 0
|
||||
|
||||
-- | 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
|
||||
(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 d qb qu = do
|
||||
blockIcon $ isValidQualification d qu qb
|
||||
where
|
||||
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| |]
|
||||
|
||||
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
|
||||
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
|
||||
| showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason
|
||||
| qualificationUserBlockUnblock = mempty
|
||||
| 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 (view hasQualification -> Qualification{..}) = anchorCell link name
|
||||
|
||||
Loading…
Reference in New Issue
Block a user