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

chore(lms): continue work on qualification overview page

Browse Source
This commit is contained in:
Steffen Jost 2022-04-13 11:54:12 +02:00
parent 1e4b8137e3
commit 265107859e
4 changed files with 27 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -9,6 +9,9 @@ QualificationElearningStart: E-Lernen automatisch starten
TableQualificationCountActive: Aktive TableQualificationCountActive: Aktive
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifkation TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifkation
TableQualificationCountTotal: Gesamt TableQualificationCountTotal: Gesamt
TableQualificationValidUntil: Gültig bis
TableQualificationLastRefresh: Zuletzt erneuert
TableQualificationFirstHeld: Erstmalig
TableLmsUser: Prüfling TableLmsUser: Prüfling
TableLmsIdent: Identifikation TableLmsIdent: Identifikation
TableLmsElearning: E-Lernen TableLmsElearning: E-Lernen

3
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -9,6 +9,9 @@ QualificationElearningStart: Start e-learning automatically
TableQualificationCountActive: Active TableQualificationCountActive: Active
TableQualificationCountActiveTooltip: Number of currently valid qualifcation holders TableQualificationCountActiveTooltip: Number of currently valid qualifcation holders
TableQualificationCountTotal: Total TableQualificationCountTotal: Total
TableQualificationValidUntil: Valid until
TableQualificationLastRefresh: Last renewed
TableQualificationFirstHeld: First held
TableLmsUser: Examinee TableLmsUser: Examinee
TableLmsIdent: Identifier TableLmsIdent: Identifier
TableLmsPin: E-learning pin TableLmsPin: E-learning pin

21
src/Handler/LMS.hs
View File

@ -187,23 +187,24 @@ mkLmsTable qid = do
dbtColonnade = dbColonnade $ mconcat dbtColonnade = dbColonnade $ mconcat
[ colUserNameLinkHdr MsgTableLmsUser AdminUserR [ colUserNameLinkHdr MsgTableLmsUser AdminUserR
, colUserEmail , colUserEmail
, sortable (Just "user") (i18nCell MsgTableLmsUser) $ cellHasUserLink AdminUserR , sortable (Just "valid-until") (i18nCell MsgTableQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "email") (i18nCell MsgTableEmail) cellHasEMail , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
--, sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
--, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dayCell success , sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid
, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
] -- TODO: add more columns for manual debugging view !!! ] -- TODO: add more columns for manual debugging view !!!
dbtSorting = mconcat dbtSorting = mconcat
[ single $ sortUserNameLink queryUser [ single $ sortUserNameLink queryUser
, single $ sortUserEmail queryUser , single $ sortUserEmail queryUser
, singletonMap "user" ( SortColumn $ queryUser >>> (E.^. UserDisplayName) ) , single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
, single ("email" , SortColumn $ queryUser >>> (E.^. UserEmail) ) , single ("last-refresh", SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
-- TODO: Use ready sorts and ready colonnades for user see Course.Users , single ("first-held" , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
-- , (csvLmsIdent , SortColumn $ queryLmsUser >>> (E.^. LmsResultIdent)) -- , single (csvLmsIdent , SortColumn $ queryLmsUser >>> (E.?. LmsResultIdent))
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess)) -- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
-- , (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess)) -- , (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrUserNameLink queryUser [ single $ fltrUserNameEmail queryUser
-- , single $ fltrUserNameEmail queryUser -- , single $ fltrUserNameEmail queryUser
--("user" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.^. UserDisplayName)) --("user" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.^. UserDisplayName))
-- , ("email" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.^. UserEmail)) -- , ("email" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.^. UserEmail))
@ -211,7 +212,7 @@ mkLmsTable qid = do
-- , (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess)) -- , (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess))
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameLinkHdrUI MsgTableLmsUser mPrev [ fltrUserNameEmailHdrUI MsgTableLmsUser mPrev
-- , fltrUserNameEmailUI mPrev -- , fltrUserNameEmailUI mPrev
-- prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsUser) -- prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsUser)
--, prismAForm (singletonFilter "email" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableEmail) --, prismAForm (singletonFilter "email" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableEmail)

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

@ -35,6 +35,10 @@ indicatorCell = writerCell . tell $ Any True
writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
writerCell act = mempty & cellContents %~ (<* act) writerCell act = mempty & cellContents %~ (<* act)
-- for documentation purposes
cellMaybe :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
cellMaybe = foldMap
maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b
maybeCell = flip foldMap maybeCell = flip foldMap
@ -293,3 +297,9 @@ roomReferenceCell = cell . roomReferenceWidget
cryptoidCell :: (IsDBTable m a, PathPiece cid) => cid -> DBCell m a cryptoidCell :: (IsDBTable m a, PathPiece cid) => cid -> DBCell m a
cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece
lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
lmsStatusCell ls = iconCell ic <> dayCell (lmsStatusDay ls)
where
ic | isLmsSuccess ls = IconOK
| otherwise = IconNotOK