chore(lms): lmsUser Overview reworked to newfound purpose. work in progress, compiles
This commit is contained in:
Steffen Jost
parent
06201bc22e
commit
2326b077c9
@ -31,7 +31,7 @@ Qualification
|
|||||||
-- - Flag "interner Mitarbeiter" wird von Know-How ignoriert / nicht ausgewertet (legacy)
|
-- - Flag "interner Mitarbeiter" wird von Know-How ignoriert / nicht ausgewertet (legacy)
|
||||||
|
|
||||||
QualificationPrecondition
|
QualificationPrecondition
|
||||||
qualification QualificationId -- AND: not unique, ie. qualification can have multiple required preconditions
|
qualification QualificationId OnDeleteCascade OnUpdateCascade -- AND: not unique, ie. qualification can have multiple required preconditions
|
||||||
required [QualificationId] -- OR : alternatives, any one will suffice
|
required [QualificationId] -- OR : alternatives, any one will suffice
|
||||||
continuous Bool -- expiring precondition removes qualification
|
continuous Bool -- expiring precondition removes qualification
|
||||||
deriving Generic
|
deriving Generic
|
||||||
@ -45,7 +45,7 @@ QualificationEdit
|
|||||||
deriving Generic
|
deriving Generic
|
||||||
|
|
||||||
QualificationUser
|
QualificationUser
|
||||||
user UserId
|
user UserId OnDeleteCascade OnUpdateCascade
|
||||||
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
||||||
validUntil Day
|
validUntil Day
|
||||||
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
|
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
|
||||||
@ -90,7 +90,7 @@ QualificationUser
|
|||||||
|
|
||||||
LmsUser
|
LmsUser
|
||||||
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
||||||
user UserId
|
user UserId OnDeleteCascade OnUpdateCascade
|
||||||
ident LmsIdent -- must be unique accross all LMS courses!
|
ident LmsIdent -- must be unique accross all LMS courses!
|
||||||
pin Text
|
pin Text
|
||||||
resetPin Bool default=false -- should pin be reset?
|
resetPin Bool default=false -- should pin be reset?
|
||||||
@ -123,7 +123,7 @@ LmsResult
|
|||||||
|
|
||||||
-- Logs all processed rows from LmsUserlist and LmsResult
|
-- Logs all processed rows from LmsUserlist and LmsResult
|
||||||
LmsAudit
|
LmsAudit
|
||||||
qualification QualificationId
|
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
||||||
ident LmsIdent
|
ident LmsIdent
|
||||||
notificationType LmsStatus -- LmsBlocked Day | LmsSuccess Day
|
notificationType LmsStatus -- LmsBlocked Day | LmsSuccess Day
|
||||||
received UTCTime -- timestamp from LmsUserlist/LmsResult
|
received UTCTime -- timestamp from LmsUserlist/LmsResult
|
||||||
|
|||||||
@ -133,45 +133,35 @@ getLmsEditR = postLmsEditR
|
|||||||
postLmsEditR = error "TODO"
|
postLmsEditR = error "TODO"
|
||||||
|
|
||||||
|
|
||||||
type LmsResultTableExpr = ( E.SqlExpr (Entity Qualification)
|
type LmsTableExpr = ( E.SqlExpr (Entity QualificationUser)
|
||||||
`E.InnerJoin` E.SqlExpr (Entity LmsResult)
|
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||||
) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser))
|
) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser))
|
||||||
`E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
|
|
||||||
|
|
||||||
queryQualification :: LmsResultTableExpr -> E.SqlExpr (Entity Qualification)
|
queryQualUser :: LmsTableExpr -> E.SqlExpr (Entity QualificationUser)
|
||||||
queryQualification = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1)
|
||||||
|
|
||||||
queryLmsResult :: LmsResultTableExpr -> E.SqlExpr (Entity LmsResult)
|
queryUser :: LmsTableExpr -> E.SqlExpr (Entity User)
|
||||||
queryLmsResult = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
|
queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 2 1)
|
||||||
|
|
||||||
queryLmsUser :: LmsResultTableExpr -> E.SqlExpr (Maybe (Entity LmsUser))
|
queryLmsUser :: LmsTableExpr -> E.SqlExpr (Maybe (Entity LmsUser))
|
||||||
queryLmsUser = $(sqlLOJproj 3 2)
|
queryLmsUser = $(sqlLOJproj 2 2)
|
||||||
|
|
||||||
queryUser :: LmsResultTableExpr -> E.SqlExpr (Maybe (Entity User))
|
type LmsTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser))
|
||||||
queryUser = $(sqlLOJproj 3 3)
|
|
||||||
|
|
||||||
type LmsResultTableData = DBRow (Entity Qualification, Entity LmsResult, Maybe (Entity LmsUser), Maybe (Entity User))
|
resultQualUser :: Lens' LmsTableData (Entity QualificationUser)
|
||||||
|
resultQualUser = _dbrOutput . _1
|
||||||
|
|
||||||
instance HasEntity LmsResultTableData LmsResult where
|
resultUser :: Lens' LmsTableData (Entity User)
|
||||||
hasEntity = _dbrOutput . _2
|
resultUser = _dbrOutput . _2
|
||||||
|
|
||||||
{- MaybeHasUser only!
|
resultLmsUser :: Traversal' LmsTableData (Entity LmsUser)
|
||||||
instance HasUser LmsResultTableData where
|
|
||||||
hasUser = resultUser . _entityVal
|
|
||||||
-}
|
|
||||||
|
|
||||||
resultQualification :: Lens' LmsResultTableData (Entity Qualification)
|
|
||||||
resultQualification = _dbrOutput . _1
|
|
||||||
|
|
||||||
resultLmsResult :: Lens' LmsResultTableData (Entity LmsResult)
|
|
||||||
resultLmsResult = _dbrOutput . _2
|
|
||||||
|
|
||||||
resultLmsUser :: Traversal' LmsResultTableData (Entity LmsUser)
|
|
||||||
resultLmsUser = _dbrOutput . _3 . _Just
|
resultLmsUser = _dbrOutput . _3 . _Just
|
||||||
|
|
||||||
resultUser :: Traversal' LmsResultTableData (Entity User)
|
instance HasEntity LmsTableData User where
|
||||||
resultUser = _dbrOutput . _4 . _Just
|
hasEntity = resultUser
|
||||||
|
|
||||||
|
instance HasUser LmsTableData where
|
||||||
|
hasUser = resultUser . _entityVal
|
||||||
|
|
||||||
mkLmsTable :: QualificationId -> DB (Any, Widget)
|
mkLmsTable :: QualificationId -> DB (Any, Widget)
|
||||||
mkLmsTable qid = do
|
mkLmsTable qid = do
|
||||||
@ -179,44 +169,47 @@ mkLmsTable qid = do
|
|||||||
resultDBTable = DBTable{..}
|
resultDBTable = DBTable{..}
|
||||||
where
|
where
|
||||||
dbtSQLQuery = runReaderT $ do
|
dbtSQLQuery = runReaderT $ do
|
||||||
qualification <- asks queryQualification
|
qualUser <- asks queryQualUser
|
||||||
lmsResult <- asks queryLmsResult
|
user <- asks queryUser
|
||||||
lmsUser <- asks queryLmsUser
|
lmsUser <- asks queryLmsUser
|
||||||
user <- asks queryUser
|
|
||||||
lift $ do
|
lift $ do
|
||||||
E.on $ qualification E.^. QualificationId E.==. lmsResult E.^. LmsResultQualification
|
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
|
||||||
E.on $ lmsUser E.?. LmsUserIdent E.==. E.just (lmsResult E.^. LmsResultIdent)
|
E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser
|
||||||
E.on $ lmsUser E.?. LmsUserUser E.==. user E.?. UserId
|
E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification
|
||||||
E.where_ $ qualification E.^. QualificationId E.==. E.val qid
|
E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification
|
||||||
return (qualification, lmsResult, lmsUser, user)
|
return (qualUser, user, lmsUser)
|
||||||
dbtRowKey = queryLmsResult >>> (E.^. LmsResultId)
|
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) $ -- \(preview resultUser -> entuser) -> maybeCell entuser (cellHasUserLink AdminUserR)
|
[ sortable (Just "user") (i18nCell MsgTableLmsUser) $ cellHasUserLink AdminUserR
|
||||||
foldMap (cellHasUserLink AdminUserR) . (^? resultUser)
|
, sortable (Just "email") (i18nCell MsgTableEmail) cellHasEMail
|
||||||
, sortable (Just "email") (i18nCell MsgTableEmail) $ -- \(preview $ resultUser . _entityVal -> user) -> maybeCell user cellHasEMail
|
--, sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident
|
||||||
foldMap cellHasEMail . (^? resultUser)
|
--, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(view $ resultLmsResult . _entityVal . _lmsResultSuccess -> success) -> dayCell success
|
||||||
, 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 !!!
|
] -- TODO: add more columns for manual debugging view !!!
|
||||||
dbtSorting = Map.fromList
|
dbtSorting = Map.fromList
|
||||||
[ ("user" , SortColumn $ queryUser >>> (E.?. UserDisplayName))
|
[ ("user" , SortColumn $ queryUser >>> (E.^. UserDisplayName))
|
||||||
, ("email" , SortColumn $ queryUser >>> (E.?. UserEmail))
|
, ("email" , SortColumn $ queryUser >>> (E.^. UserEmail))
|
||||||
, (csvLmsIdent , SortColumn $ queryLmsResult >>> (E.^. LmsResultIdent))
|
--
|
||||||
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
|
-- , (csvLmsIdent , SortColumn $ queryLmsUser >>> (E.^. LmsResultIdent))
|
||||||
, (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
|
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
|
||||||
|
-- , (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
|
||||||
]
|
]
|
||||||
dbtFilter = Map.fromList
|
-- where single = uncurry Map.singleton
|
||||||
[ ("user" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.?. UserDisplayName))
|
dbtFilter = mconcat
|
||||||
, ("email" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.?. UserEmail))
|
[ single $ fltrUserNameEmail queryUser
|
||||||
, (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
|
where single = uncurry Map.singleton
|
||||||
[ prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsUser)
|
dbtFilterUI mPrev = mconcat
|
||||||
, prismAForm (singletonFilter "email" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableEmail)
|
[ fltrUserNameEmailUI mPrev
|
||||||
, prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
|
-- prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsUser)
|
||||||
, prismAForm (singletonFilter csvLmsSuccess . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsSuccess)
|
--, 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)
|
||||||
]
|
]
|
||||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||||
dbtParams = def
|
dbtParams = def
|
||||||
|
|||||||
Reference in New Issue
Block a user