From 37411b71065ec4dadfd77002baf609036f8ff00a Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 10 Feb 2022 15:40:08 +0100 Subject: [PATCH] chore(lms): add stubs for lms userlist and result uploads --- .../utils/navigation/menu/de-de-formal.msg | 4 +- .../uniworx/utils/navigation/menu/en-eu.msg | 4 +- routes | 4 +- src/Foundation/Navigation.hs | 2 + src/Handler/LMS.hs | 42 ++++++++++++++----- templates/lms-result.hamlet | 1 + templates/lms-userlist.hamlet | 1 + 7 files changed, 44 insertions(+), 14 deletions(-) create mode 100644 templates/lms-result.hamlet create mode 100644 templates/lms-userlist.hamlet diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index b16981ad4..0ccd16936 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -123,4 +123,6 @@ MenuCourseEventNew: Neuer Kurstermin MenuCourseEventEdit: Kurstermin bearbeiten MenuLanguage: Sprache -MenuLms: Schnittstelle E-Lernen \ No newline at end of file +MenuLms: Schnittstelle E-Lernen +MenuLmsUserlist: Melden E-Lernen Benutzer +MenuLmsResult: Melden Ergebnisse E-Lernen \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 91fd11d74..dc5646b24 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -124,4 +124,6 @@ MenuCourseEventNew: New course occurrence MenuCourseEventEdit: Edit course occurrence MenuLanguage: Language -MenuLms: Interface E-Learning \ No newline at end of file +MenuLms: Interface E-Learning +MenuLmsUserlist: Upload E-Learning Users +MenuLmsResult: Upload E-Learning Results \ No newline at end of file diff --git a/routes b/routes index 92cbcacc8..5ef536254 100644 --- a/routes +++ b/routes @@ -255,4 +255,6 @@ !/*WellKnownFileName WellKnownR GET !free -- OSIS CSV Export Demo -/lms LmsR GET \ No newline at end of file +/lms LmsR GET +/lms/userlist LmsUserlistR GET +/lms/result LmsResultR GET diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 1341194de..f15d4cdb9 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -134,6 +134,8 @@ breadcrumb InstanceR = i18nCrumb MsgMenuInstance Nothing breadcrumb StatusR = i18nCrumb MsgMenuHealth Nothing -- never displayed breadcrumb LmsR = i18nCrumb MsgMenuLms Nothing +breadcrumb LmsUserlistR = i18nCrumb MsgMenuLmsUserlist $ Just LmsR +breadcrumb LmsResultR = i18nCrumb MsgMenuLmsResult $ Just LmsR breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 3116976f7..351036b40 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -1,3 +1,8 @@ +{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only +{-# OPTIONS -Wno-unused-imports #-} -- TODO: remove me, for debugging only +{-# OPTIONS -Wno-redundant-constraints #-} -- TODO: remove me, for debugging only + + module Handler.LMS ( getLmsR ) @@ -15,7 +20,7 @@ import Database.Esqueleto.Utils.TH type LmsUserIdent = Text -- Unique random use-once identifier for each individual e-learning course; i.e. users may have several active LmsUserIdents at once! -data LmsUserTableCsv = LmsUserTableCsv -- Export only +data LmsUserTableCsv = LmsUserTableCsv -- for csv export only { csvLmsUserIdent :: LmsUserIdent , csvLmsUserPin :: Text , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Int @@ -54,18 +59,17 @@ csvLmsResultFilename = makeLmsFilename "ergebnisse" -- | Create filenames as specified by the LMS interface agreed with Know How AG makeLmsFilename :: MonadHandler m => Text -> m Text makeLmsFilename ftag = do - ymth <- get_ymth + ymth <- getYMTH return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv" -- | Return current datetime in YYYYMMDDHH format -get_ymth :: MonadHandler m => m Text -get_ymth = do - now <- liftIO $ getCurrentTime - formatTime' "%Y%m%d%H" now +getYMTH :: MonadHandler m => m Text +getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime getLmsR :: Handler Html -getLmsR = do +getLmsR = do + {- dbtCsvName <- csvLmsUserFilename let dbtIdent = "lmsUsers" :: Text dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } @@ -89,7 +93,7 @@ getLmsR = do dbtSorting = mempty dbtFilter = mempty dbtFilterUI = mempty - dbtParams = def + dbtParams = def -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam. dbtCsvEncode = do return $ DBTCsvEncode @@ -121,7 +125,23 @@ getLmsR = do -- } psValidator = def lmsTable = dbTable psValidator DBTable{..} - heading = [whamlet|LMS|] - siteLayout heading $ do - setTitleI heading + -} + let lmsTable = [whamlet|TODO|] -- TODO: remove me, just for debugging + siteLayoutMsg MsgMenuLms $ do + setTitleI MsgMenuLms $(widgetFile "lms") + + +getLmsUserlistR :: Handler Html +getLmsUserlistR = do + siteLayoutMsg MsgMenuLmsUserlist $ do + setTitleI MsgMenuLmsUserlist + $(widgetFile "lms-userlist") + + +getLmsResultR :: Handler Html +getLmsResultR = do + siteLayoutMsg MsgMenuLmsResult $ do + setTitleI MsgMenuLmsResult + $(widgetFile "lms-result") + \ No newline at end of file diff --git a/templates/lms-result.hamlet b/templates/lms-result.hamlet new file mode 100644 index 000000000..51d91dafb --- /dev/null +++ b/templates/lms-result.hamlet @@ -0,0 +1 @@ +^{lmsTable} diff --git a/templates/lms-userlist.hamlet b/templates/lms-userlist.hamlet new file mode 100644 index 000000000..51d91dafb --- /dev/null +++ b/templates/lms-userlist.hamlet @@ -0,0 +1 @@ +^{lmsTable}