chore(lms): lms overview cleaned

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -21,3 +21,4 @@ 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
+QualificationDescription: Beschreibung

messages/uniworx/categories/qualification/en-eu.msg

@@ -21,3 +21,4 @@ LmsResultUpdate: Update of LMS result
 LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
 LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
 LmsDirectUpload: Direct upload for automated Systems
+QualificationDescription: Description

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -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 

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -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

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

src/Foundation/Navigation.hs

@@ -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

src/Handler/LMS.hs

@@ -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 
+  (lmsTable, quali) <- runDB $ do 
-    qid <- getKeyBy404 $ SchoolQualificationShort sid qsh 
+    Entity qid quali <- getBy404 $ SchoolQualificationShort sid qsh 
-    view _2 <$> mkLmsTable qid 
+    tbl <- view _2 <$> mkLmsTable qid 
-  siteLayoutMsg MsgMenuLmsResult $ do
+    return (tbl, quali)
-    setTitleI MsgMenuLmsResult
+  let heading = citext2widget $ qualificationName quali
+  siteLayout heading $ do
+    setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh
     $(widgetFile "lms")

templates/lms.hamlet

@@ -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}
+