fraport/fradrive-old
Archived
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 TableLmsIdent: Identifikation
TableLmsPin: E-Lernen Pin TableLmsPin: E-Lernen Pin
TableLmsResetPin: Pin zurücksetzen? TableLmsResetPin: Pin zurücksetzen?

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

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

24
src/Handler/LMS.hs
View File

@ -169,7 +169,7 @@ instance HasEntity LmsResultTableData LmsResult where
{- MaybeHasUser only! {- MaybeHasUser only!
instance HasUser LmsResultTableData where instance HasUser LmsResultTableData where
hasUser = _dbrOutput . _4 . _entityVal hasUser = resultUser . _entityVal
-} -}
resultQualification :: Lens' LmsResultTableData (Entity Qualification) resultQualification :: Lens' LmsResultTableData (Entity Qualification)
@ -204,23 +204,33 @@ mkLmsTable qid = do
dbtRowKey = queryLmsResult >>> (E.^. LmsResultId) dbtRowKey = queryLmsResult >>> (E.^. LmsResultId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat 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 csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ resultLmsResult . _entityVal . _lmsResultIdent . _getLmsIdent -> ident) -> textCell ident
, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dayCell success , sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dayCell success
] -- TODO: add more columns for manual debugging view !!! ] -- TODO: add more columns for manual debugging view !!!
dbtSorting = Map.fromList dbtSorting = Map.fromList
[ ("school" , SortColumn $ queryQualification >>> (E.^. QualificationSchool)) [ ("school" , SortColumn $ queryQualification >>> (E.^. QualificationSchool))
, (csvLmsIdent , SortColumn $ queryLmsResult >>> (E.^. LmsResultIdent)) , ("user" , SortColumn $ queryUser >>> (E.?. UserDisplayName))
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess)) , ("email" , SortColumn $ queryUser >>> (E.?. UserEmail))
, (csvLmsIdent , SortColumn $ queryLmsResult >>> (E.^. LmsResultIdent))
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
, (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess)) , (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
] ]
dbtFilter = Map.fromList dbtFilter = Map.fromList
[ ("school" , FilterColumn . E.mkExactFilter $ views (to queryQualification) (E.^. QualificationSchool)) [ ("school" , FilterColumn . E.mkExactFilter $ views (to queryQualification) (E.^. QualificationSchool))
, (csvLmsIdent , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsResult) (E.^. LmsResultIdent)) , ("user" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.?. UserDisplayName))
, (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess)) , ("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 dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter "school" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableCourseSchool) [ 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 csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
, prismAForm (singletonFilter csvLmsSuccess . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsSuccess) , 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 :: IsDBTable m a => Text -> Text -> DBCell m a
userCell displayName surname = cell $ nameWidget displayName surname 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 :: IsDBTable m a => CI Text -> DBCell m a
emailCell email = cell $(widgetFile "widgets/link-email") emailCell email = cell $(widgetFile "widgets/link-email")
where linkText= toWgt 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 class HasEntity c record where
hasEntity :: Lens' c (Entity record) 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. -- 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 a User) => Lens' a (Entity User)
hasEntityUser = hasEntity hasEntityUser = hasEntity
@ -156,8 +160,8 @@ hasEntityUser = hasEntity
-- hasUser = hasEntityUser -- hasUser = hasEntityUser
-- --
-- Possible, but rather useless: -- Possible, but rather useless:
-- instance (HasUser a) => HasUser (Entity a) where instance (HasUser a) => HasUser (Entity a) where
-- hasUser = _entityVal . hasUser hasUser = _entityVal . hasUser
makeLenses_ ''SheetCorrector makeLenses_ ''SheetCorrector