From 3eeac06c47ff67ec7ad40deae69f60205fb4073c Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 8 Feb 2022 09:36:11 +0100 Subject: [PATCH] chore(lms): minor code cleaning --- models/lms.model | 18 +++++++ src/Foundation/Navigation.hs | 2 +- src/Handler/LMS.hs | 97 ++++++++++++++++-------------------- 3 files changed, 63 insertions(+), 54 deletions(-) create mode 100644 models/lms.model diff --git a/models/lms.model b/models/lms.model new file mode 100644 index 000000000..22a764736 --- /dev/null +++ b/models/lms.model @@ -0,0 +1,18 @@ +-- LMS Interface Tables, need regular processing by background jobs +--LmsUsers +-- user UserId +-- ident LmsIdent +-- -- pin LmsPin -- pin must not be stored, is only sent once and can be recreated? +-- deriving Generic + +LmsUserlist + ident LmsIdent + failed Bool + UniqueLmsUserlist lmsident + deriving Generic + +LmsResult + ident LmsIdent + success UTCTime + UniqueLmsResult lmsident + deriving Generic \ No newline at end of file diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 1341194de..8ce8a998a 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -133,7 +133,7 @@ breadcrumb HealthR = i18nCrumb MsgMenuHealth Nothing breadcrumb InstanceR = i18nCrumb MsgMenuInstance Nothing breadcrumb StatusR = i18nCrumb MsgMenuHealth Nothing -- never displayed -breadcrumb LmsR = i18nCrumb MsgMenuLms Nothing +-- breadcrumb LmsR = i18nCrumb MsgMenuLms Nothing breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 298b6959d..dd8ed644e 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -37,13 +37,13 @@ csvLmsUserlistFilename = makeLmsFilename "userliste" csvLmsResultFilename :: IO Text csvLmsResultFilename = makeLmsFilename "ergebnisse" ---| create filenames as specified by LMS +-- | Create filenames as specified by the LMS interface agreed with Know How AG makeLmsFilename :: Text -> IO Text makeLmsFilename ftag = do ymth <- get_ymth return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv" ---| returns current datetime in YYYYMMDDHH format +-- | Return current datetime in YYYYMMDDHH format get_ymth :: IO Text get_ymth = do now <- getCurrentTime @@ -52,58 +52,49 @@ get_ymth = do getLmsR :: Handler Html getLmsR = do - let dbtIdent = "lmsUsers" :: Text - dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } - dbtSQLQuery q = error "TODO" - dbtRowKey = error "TODO" - dbtProj = dbtProjSimple $ \(userIdent, userPin, doUserPinReset, doDeleteUser, isUserIntern) -> do - return ("abcdefgh", "12345678", False, False, True) -- Warum keine Liste? - dbtColonnade = colChoices - dbtSorting = mempty - dbtFilter = mempty - dbtFilterUI = mempty - dbtParams = def - dbtCsvName = "lms.csv" - -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam. - dbtCsvEncode = do - return $ DBTCsvEncode - { dbtCsvExportForm = def - , dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $ - LmsTableCsv -- <- for each desired column one view - <$> view (hasUser . _userSurname) - <*> view (hasUser . _userFirstName) - <*> view (hasUser . _userDisplayName) - <*> view (hasUser . _userSex) - <*> view (hasUser . _userMatrikelnummer) - <*> view (hasUser . _userEmail) - <*> view _userStudyFeatures - <*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName) - <*> view _userTableRegistration - <*> userNote - <*> (over (_2.traverse._Just) (tutorialName . entityVal) . over (_1.traverse) (tutorialName . entityVal) <$> view _userTutorials) - -- <*> (over (_2.traverse._Just) (examName . entityVal) . over (_1.traverse) (examName . entityVal) <$> view _userExams) - <*> (over traverse (examName . entityVal) <$> view _userExams) - <*> views _userSheets (set (mapped . _1 . mapped) ()) - , dbtCsvName - , dbtCsvSheetName - , dbtCsvNoExportData = Nothing -- ? - , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def - , dbtCsvExampleData = Nothing - } - -- TODO wip, for reference see e.g. Handler.Exam.Users - dbtCsvDecode = Just DBTCsvDecode - { dbtCsvRowKey = - , dbtCsvComputeActions = - , dbtCsvClassifyAction = - , dbtCsvCoarsenActionClass = - , dbtCsvValidateActions = - , dbtCsvExecuteActions = -- <- actions based on sent data here - , dbtCsvRenderKey = - , dbtCsvRenderActionClass = - , dbtCsvRenderException = + let dbtIdent = "lmsUsers" :: Text + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } + dbtSQLQuery q = error "TODO" + dbtRowKey = error "TODO" + dbtProj = dbtProjSimple $ \(userIdent, userPin, doUserPinReset, doDeleteUser, isUserIntern) -> do + return ("abcdefgh", "12345678", False, False, True) -- Warum keine Liste? + dbtColonnade = colChoices + dbtSorting = mempty + dbtFilter = mempty + dbtFilterUI = mempty + dbtParams = def + dbtCsvName = "lms.csv" + -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam. + dbtCsvEncode = do + return $ DBTCsvEncode + { dbtCsvExportForm = def + , dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $ + LmsTableCsv -- <- for each desired column one view + <$> _t1 + <*> _t2 + <*> _t3 + <*> _t4 + <*> _t5 + , dbtCsvName + , dbtCsvSheetName + , dbtCsvNoExportData = Nothing -- ? + , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def + , dbtCsvExampleData = Nothing } - dbTable psValidator DBTable{..} - let heading = [whamlet|LMS|] + -- TODO wip, for reference see e.g. Handler.Exam.Users + dbtCsvDecode = Just DBTCsvDecode + { dbtCsvRowKey = _1 + , dbtCsvComputeActions = _2 + , dbtCsvClassifyAction = _3 + , dbtCsvCoarsenActionClass = _4 + , dbtCsvValidateActions = _5 + , dbtCsvExecuteActions = _6 -- <- actions based on sent data here + , dbtCsvRenderKey = _7 + , dbtCsvRenderActionClass = _8 + , dbtCsvRenderException = _9 + } + dbTable psValidator DBTable{..} + heading = [whamlet|LMS|] siteLayout heading $ do setTitleI heading $(widgetFile "lms")