chore(lms): lms overview cleaned
This commit is contained in:
Steffen Jost
parent
0d6bfaf099
commit
1f9a5e377d
@ -20,4 +20,5 @@ LmsResultInsert: Neues LMS Ergebnis
|
||||
LmsResultUpdate: LMS Ergebnis aktualisierung
|
||||
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
||||
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
||||
LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
||||
LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
||||
QualificationDescription: Beschreibung
|
||||
@ -20,4 +20,5 @@ LmsResultInsert: New LMS result
|
||||
LmsResultUpdate: Update of LMS result
|
||||
LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
|
||||
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
|
||||
LmsDirectUpload: Direct upload for automated Systems
|
||||
LmsDirectUpload: Direct upload for automated Systems
|
||||
QualificationDescription: Description
|
||||
@ -125,7 +125,9 @@ MenuLanguage: Sprache
|
||||
|
||||
MenuQualification: Qualifkationen
|
||||
MenuLms: Schnittstelle E-Lernen
|
||||
MenuLmsEdit: Bearbeiten E-Lernen
|
||||
MenuLmsUsers: Empfang E-Lernen Benutzer
|
||||
MenuLmsUserlist: Melden E-Lernen Benutzer
|
||||
MenuLmsResult: Melden Ergebnisse E-Lernen
|
||||
MenuLmsUpload: Direkter Upload
|
||||
MenuLmsUpload: Hochladen
|
||||
MenuLmsDirect: Direkter Upload
|
||||
@ -126,7 +126,9 @@ MenuLanguage: Language
|
||||
|
||||
MenuQualification: Qualifcations
|
||||
MenuLms: Interface E-Learning
|
||||
MenuLmsEdit: Edit E-Learning
|
||||
MenuLmsUsers: Download E-Learning Users
|
||||
MenuLmsUserlist: Upload E-Learning Users
|
||||
MenuLmsResult: Upload E-Learning Results
|
||||
MenuLmsUpload: Direct Upload
|
||||
MenuLmsUpload: Upload
|
||||
MenuLmsDirect: Direct Upload
|
||||
|
||||
1
routes
1
routes
@ -258,6 +258,7 @@
|
||||
/lms LmsAllR GET
|
||||
/lms/#SchoolId LmsSchoolR GET
|
||||
/lms/#SchoolId/#QualificationShorthand LmsR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/edit LmsEditR GET POST
|
||||
/lms/#SchoolId/#QualificationShorthand/users LmsUsersR GET
|
||||
/lms/#SchoolId/#QualificationShorthand/users/direct LmsUsersDirectR GET
|
||||
/lms/#SchoolId/#QualificationShorthand/userlist LmsUserlistR GET POST
|
||||
|
||||
@ -140,6 +140,7 @@ breadcrumb (LmsSchoolR ssh ) = useRunDB . maybeT (i18nCrumb MsgBrea
|
||||
breadcrumb (LmsR ssh qsh) =useRunDB . maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ LmsSchoolR ssh) $ do
|
||||
guardM . lift . existsBy $ SchoolQualificationShort ssh qsh
|
||||
return (CI.original qsh, Just $ LmsSchoolR ssh)
|
||||
breadcrumb (LmsEditR ssh qsh) = i18nCrumb MsgMenuLmsEdit $ Just $ LmsR ssh qsh
|
||||
breadcrumb (LmsUsersR ssh qsh) = i18nCrumb MsgMenuLmsUsers $ Just $ LmsR ssh qsh
|
||||
breadcrumb (LmsUsersDirectR ssh qsh) = i18nCrumb MsgMenuLmsUsers $ Just $ LmsUsersR ssh qsh -- never displayed, TypedContent
|
||||
breadcrumb (LmsUserlistR ssh qsh) = i18nCrumb MsgMenuLmsUserlist $ Just $ LmsR ssh qsh
|
||||
@ -428,6 +429,15 @@ makeLenses_ ''NavLink
|
||||
instance RenderMessage UniWorX NavLink where
|
||||
renderMessage app ls NavLink{..} = renderMessage app ls navLabel
|
||||
|
||||
-- | NavLink default with most common settings
|
||||
defNavLink :: (RenderMessage UniWorX msg, HasRoute UniWorX route) => msg -> route -> NavLink
|
||||
defNavLink navLabel navRoute = NavLink {..}
|
||||
where
|
||||
navAccess' = NavAccessTrue
|
||||
navType = NavTypeLink { navModal = False}
|
||||
navQuick' = mempty
|
||||
navForceActive = False
|
||||
|
||||
navBaseRoute :: NavLink -> Route UniWorX
|
||||
navBaseRoute NavLink{navRoute} = urlRoute navRoute
|
||||
|
||||
@ -2392,6 +2402,32 @@ pageActions ParticipantsListR = return
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (LmsR sid qsh) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuLmsUsers $ LmsUsersR sid qsh
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuLmsDirect $ LmsUsersDirectR sid qsh
|
||||
]
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuLmsUserlist $ LmsUserlistR sid qsh
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuLmsUpload $ LmsUserlistUploadR sid qsh
|
||||
, defNavLink MsgMenuLmsDirect $ LmsUserlistDirectR sid qsh
|
||||
]
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgMenuLmsResult $ LmsResultR sid qsh
|
||||
, navChildren =
|
||||
[ defNavLink MsgMenuLmsUpload $ LmsResultUploadR sid qsh
|
||||
, defNavLink MsgMenuLmsDirect $ LmsResultDirectR sid qsh
|
||||
]
|
||||
}
|
||||
, NavPageActionSecondary {
|
||||
navLink = defNavLink MsgMenuLmsEdit $ LmsEditR sid qsh
|
||||
}
|
||||
]
|
||||
|
||||
pageActions _ = return []
|
||||
|
||||
submissionList :: ( MonadIO m
|
||||
|
||||
@ -8,6 +8,7 @@ module Handler.LMS
|
||||
( getLmsAllR
|
||||
, getLmsSchoolR
|
||||
, getLmsR , postLmsR
|
||||
, getLmsEditR , postLmsEditR
|
||||
, getLmsUsersR , getLmsUsersDirectR
|
||||
, getLmsUserlistR , postLmsUserlistR
|
||||
, getLmsUserlistUploadR , postLmsUserlistUploadR, postLmsUserlistDirectR
|
||||
@ -39,6 +40,13 @@ getLmsAllR = error "TODO"
|
||||
getLmsSchoolR :: SchoolId -> Handler Html
|
||||
getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-school", toPathPiece ssh)])
|
||||
|
||||
|
||||
getLmsEditR, postLmsEditR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsEditR = postLmsEditR
|
||||
postLmsEditR = error "TODO"
|
||||
|
||||
|
||||
|
||||
{- --redirect with filering
|
||||
getLmsR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsR ssh qsh = redirect (LmsAllR, [("qualification-school" , toPathPiece ssh)
|
||||
@ -204,8 +212,7 @@ 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 "user") (i18nCell MsgTableLmsUser) $ -- \(preview resultUser -> entuser) -> maybeCell entuser (cellHasUserLink AdminUserR)
|
||||
[ 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)
|
||||
@ -213,23 +220,20 @@ mkLmsTable qid = do
|
||||
, 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))
|
||||
, ("user" , SortColumn $ queryUser >>> (E.?. UserDisplayName))
|
||||
[ ("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))
|
||||
, ("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))
|
||||
, (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 "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)
|
||||
@ -249,9 +253,11 @@ mkLmsTable qid = do
|
||||
getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsR = postLmsR
|
||||
postLmsR sid qsh = do
|
||||
lmsTable <- runDB $ do
|
||||
qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
|
||||
view _2 <$> mkLmsTable qid
|
||||
siteLayoutMsg MsgMenuLmsResult $ do
|
||||
setTitleI MsgMenuLmsResult
|
||||
(lmsTable, quali) <- runDB $ do
|
||||
Entity qid quali <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
tbl <- view _2 <$> mkLmsTable qid
|
||||
return (tbl, quali)
|
||||
let heading = citext2widget $ qualificationName quali
|
||||
siteLayout heading $ do
|
||||
setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh
|
||||
$(widgetFile "lms")
|
||||
|
||||
@ -1,10 +1,21 @@
|
||||
LMS Overview
|
||||
$newline never
|
||||
<dl .deflist>
|
||||
$maybe descr <- qualificationDescription quali
|
||||
<dt .deflist__dt>_{MsgQualificationDescription}
|
||||
<dd .deflist__dd>
|
||||
<div>
|
||||
#{descr}
|
||||
|
||||
|
||||
<ul>
|
||||
<li> <a href=@{LmsUsersR sid qsh}>Export Users
|
||||
<li> <a href=@{LmsUserlistR sid qsh}>Import Userlist
|
||||
<li> <a href=@{LmsResultR sid qsh}>Import Result
|
||||
|
||||
|
||||
|
||||
!!!THIS PAGE IS NOT YET FUNCTIONAL!!!
|
||||
|
||||
|
||||
^{lmsTable}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user