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

chore(lms): attempts to use standard columns working now after refactoring

Browse Source
This commit is contained in:
Steffen Jost 2022-04-12 17:12:15 +02:00
parent 2326b077c9
commit 8af8526e61
2 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Handler/LMS.hs
View File

@ -33,6 +33,9 @@ import Handler.LMS.Users as Handler.LMS
import Handler.LMS.Userlist as Handler.LMS import Handler.LMS.Userlist as Handler.LMS
import Handler.LMS.Result as Handler.LMS import Handler.LMS.Result as Handler.LMS
-- avoids repetition of local definitions
single :: (k,a) -> Map k a
single = uncurry Map.singleton
getLmsSchoolR :: SchoolId -> Handler Html getLmsSchoolR :: SchoolId -> Handler Html
getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-overview-school", toPathPiece ssh)]) getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-overview-school", toPathPiece ssh)])
@ -182,30 +185,34 @@ mkLmsTable qid = do
dbtRowKey = queryUser >>> (E.^. UserId) dbtRowKey = queryUser >>> (E.^. UserId)
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 "user") (i18nCell MsgTableLmsUser) $ cellHasUserLink AdminUserR [ colUserNameLinkHdr MsgTableLmsUser AdminUserR
, colUserEmail
, sortable (Just "user") (i18nCell MsgTableLmsUser) $ cellHasUserLink AdminUserR
, sortable (Just "email") (i18nCell MsgTableEmail) cellHasEMail , sortable (Just "email") (i18nCell MsgTableEmail) cellHasEMail
--, sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident --, sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _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 = mconcat
[ ("user" , SortColumn $ queryUser >>> (E.^. UserDisplayName)) [ single $ sortUserNameLink queryUser
, ("email" , SortColumn $ queryUser >>> (E.^. UserEmail)) , single $ sortUserEmail queryUser
-- , singletonMap "user" ( SortColumn $ queryUser >>> (E.^. UserDisplayName) )
, single ("email" , SortColumn $ queryUser >>> (E.^. UserEmail) )
-- TODO: Use ready sorts and ready colonnades for user see Course.Users
-- , (csvLmsIdent , SortColumn $ queryLmsUser >>> (E.^. LmsResultIdent)) -- , (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))
] ]
-- where single = uncurry Map.singleton
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser [ single $ fltrUserNameLink 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))
-- , (csvLmsIdent , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsResult) (E.^. LmsResultIdent)) -- , (csvLmsIdent , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsResult) (E.^. LmsResultIdent))
-- , (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess)) -- , (csvLmsSuccess, FilterColumn . E.mkExactFilter $ views (to queryLmsResult) (E.^. LmsResultSuccess))
] ]
where single = uncurry Map.singleton
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ fltrUserNameEmailUI mPrev [ fltrUserNameLinkUI 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)
-- , prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) -- , prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)

3
src/Handler/Utils/Table/Columns.hs
View File

@ -476,6 +476,9 @@ colUserName = sortable (Just "user-name") (i18nCell MsgTableCourseMembers) cellH
colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c) colUserNameLink :: (IsDBTable m c, HasEntity a User) => (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
colUserNameLink userLink = sortable (Just "user-name") (i18nCell MsgTableCourseMembers) (cellHasUserLink userLink) colUserNameLink userLink = sortable (Just "user-name") (i18nCell MsgTableCourseMembers) (cellHasUserLink userLink)
colUserNameLinkHdr :: (IsDBTable m c, HasEntity a User, RenderMessage UniWorX msg) => msg -> (CryptoUUIDUser -> Route UniWorX) -> Colonnade Sortable a (DBCell m c)
colUserNameLinkHdr colHeader userLink = sortable (Just "user-name") (i18nCell colHeader) (cellHasUserLink userLink)
-- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname -- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname
sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r') sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r')
sortUserName queryUser = ("user-name", SortColumns $ queryUser >>> \user -> sortUserName queryUser = ("user-name", SortColumns $ queryUser >>> \user ->