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

chore(lms): bette lms overview tables with filtering

Browse Source
This commit is contained in:
Steffen Jost 2022-03-21 18:26:11 +01:00
parent 8c48e52bda
commit 0d6bfaf099
5 changed files with 30 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,3 +1,4 @@
TableLmsUser: Prüfling
TableLmsIdent: Identifikation
TableLmsPin: E-Lernen Pin
TableLmsResetPin: Pin zurücksetzen?

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

@ -1,3 +1,4 @@
TableLmsUser: Examinee
TableLmsIdent: Identifier
TableLmsPin: E-learning pin
TableLmsResetPin: Reset pin?

24
src/Handler/LMS.hs
View File

@ -169,7 +169,7 @@ instance HasEntity LmsResultTableData LmsResult where
{- MaybeHasUser only!
instance HasUser LmsResultTableData where
hasUser = _dbrOutput . _4 . _entityVal
hasUser = resultUser . _entityVal
-}
resultQualification :: Lens' LmsResultTableData (Entity Qualification)
@ -204,23 +204,33 @@ mkLmsTable qid = do
dbtRowKey = queryLmsResult >>> (E.^. LmsResultId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat
[ sortable (Just "school") (i18nCell MsgTableSchool) $ \(view $ resultQualification . _entityVal . _qualificationSchool -> schoolShorthand) -> wgtCell $ toWgt schoolShorthand
[ sortable (Just "school") (i18nCell MsgTableSchool) $ \(view $ resultQualification . _entityVal . _qualificationSchool -> schoolShorthand) -> wgtCell $ toWgt schoolShorthand
, sortable (Just "user") (i18nCell MsgTableLmsUser) $ -- \(preview resultUser -> entuser) -> maybeCell entuser (cellHasUserLink AdminUserR)
foldMap (cellHasUserLink AdminUserR) . (^? resultUser)
, sortable (Just "email") (i18nCell MsgTableEmail) $ -- \(preview $ resultUser . _entityVal -> user) -> maybeCell user cellHasEMail
foldMap cellHasEMail . (^? resultUser)
, sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsResult . _entityVal . _lmsResultIdent . _getLmsIdent -> ident) -> textCell ident
, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dayCell success
] -- TODO: add more columns for manual debugging view !!!
dbtSorting = Map.fromList
[ ("school" , SortColumn $ queryQualification >>> (E.^. QualificationSchool))
, (csvLmsIdent , SortColumn $ queryLmsResult >>> (E.^. LmsResultIdent))
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
, ("user" , SortColumn $ queryUser >>> (E.?. UserDisplayName))
, ("email" , SortColumn $ queryUser >>> (E.?. UserEmail))
, (csvLmsIdent , SortColumn $ queryLmsResult >>> (E.^. LmsResultIdent))
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
, (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
]
dbtFilter = Map.fromList
[ ("school" , FilterColumn . E.mkExactFilter $ views (to queryQualification) (E.^. QualificationSchool))
, (csvLmsIdent , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsResult) (E.^. LmsResultIdent))
, (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess))
[ ("school" , FilterColumn . E.mkExactFilter $ views (to queryQualification) (E.^. QualificationSchool))
, ("user" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.?. UserDisplayName))
, ("email" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.?. UserEmail))
, (csvLmsIdent , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsResult) (E.^. LmsResultIdent))
, (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess))
]
dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter "school" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableCourseSchool)
, 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 csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
, prismAForm (singletonFilter csvLmsSuccess . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsSuccess)
]

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

@ -159,6 +159,11 @@ dateTimeCellVisible watershed t
userCell :: IsDBTable m a => Text -> Text -> DBCell m a
userCell displayName surname = cell $ nameWidget displayName surname
{- Recall:
userCell' :: IsDBTable m a => User -> DBCell m a
userCell' = cellHasUser
-}
emailCell :: IsDBTable m a => CI Text -> DBCell m a
emailCell email = cell $(widgetFile "widgets/link-email")
where linkText= toWgt email

8
src/Utils/Lens.hs
View File

@ -147,6 +147,10 @@ instance HasStudyDegree a => HasStudyDegree (Entity a) where
class HasEntity c record where
hasEntity :: Lens' c (Entity record)
--Trivial instance, usefull for lifting to maybes
instance HasEntity (Entity r) r where
hasEntity = id
-- Typed convenience to avoid type signatures, due to the missing FunctionalDepenency that we do not want.
hasEntityUser :: (HasEntity a User) => Lens' a (Entity User)
hasEntityUser = hasEntity
@ -156,8 +160,8 @@ hasEntityUser = hasEntity
-- hasUser = hasEntityUser
--
-- Possible, but rather useless:
-- instance (HasUser a) => HasUser (Entity a) where
-- hasUser = _entityVal . hasUser
instance (HasUser a) => HasUser (Entity a) where
hasUser = _entityVal . hasUser
makeLenses_ ''SheetCorrector