From 417a48e7cb8386e06dd319fab97b04f5ca449795 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 8 Feb 2022 11:43:37 +0100 Subject: [PATCH] chore(lms): work on lms handler stub --- models/lms.model | 17 +++++++--- src/Handler/LMS.hs | 85 +++++++++++++++++++++++++++------------------- 2 files changed, 63 insertions(+), 39 deletions(-) diff --git a/models/lms.model b/models/lms.model index 22a764736..46bc21f61 100644 --- a/models/lms.model +++ b/models/lms.model @@ -1,9 +1,16 @@ -- 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 +LmsUser + user UserId + ident LmsIdent + qualification QualificationId + pin Text + resetPin Bool + delete Bool + deriving Generic + +Qualification + name Text + deriving Generic LmsUserlist ident LmsIdent diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index dd8ed644e..5c069b1fc 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -15,19 +15,28 @@ type LmsUserIdent = Text -- Unique random use-once identifier for each individua data LmsUserTableCsv = LmsUserTableCsv -- Export only { csvLmsUserIdent :: LmsUserIdent , csvLmsUserPin :: Text - , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Bool + , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Int } -data LmsUserlistTableCsv = LmsUserlistTableCsv -- Import only, all users that are currently enlisted at the e-learning plattform - { csvLmsUserlistIdent :: LmsUserIdent - , csvLmsUserlistFailed :: Bool - } +type LmsUserTableExpr = E.SqlExpr (Entity LmsUser) + `E.LeftOuterJoin` E.SqlExpr (Entity User) + +type LmsUserTableData = DBRow ( Entity LmsUser + , Maybe (Entity User) + ) + +queryLmsUser :: Getter LmsUserTableExpr (E.SqlExpr (Entity LmsUser)) +queryLmsUser = to $(E.sqlLOJproj 2 1) + +queryUser :: Getter LmsUserTableExpr (E.SqlExpr (Maybe (Entity User))) +queryUser = to $(E.sqlLOJproj 2 2) + +resultLmsUser :: Lens' LmsUserTableData (Entity LmsUser) +resultLmsUser = _dbrOutput . _1 + +resultUser :: Lens' LmsUserTableData (Maybe (Entity User)) +resultUser = _dbrOutput . _2 -data LmsResultTableCsv = LmsResultTableCsv -- Import only, all users that succeeded are returned ONCE only; must then be deleted via LmsUserTableCsv Export! - { csvLmsResultIdent :: LmsUserIdent - , csvLmsResultSuccess :: UTCTime -- datestamp user succeeded (might be local time, unclear) - } - csvLmsUserFilename :: IO Text csvLmsUserFilename = makeLmsFilename "user" @@ -54,10 +63,17 @@ 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? + dbtSQLQuery = runReaderT $ do + lmsUser <- view queryLmsUser + user <- view queryUser + lift $ do + E.on $ E.just (lmsUser E.^. LmsUserUser) E.==. user E.?. UserId + -- TODO where? + return (lmsUser, user) + dbtRowKey = queryLmsUser >>> (E.^. LmsUserId) + dbtProj = dbtProjSimple $ \(lmsUser, user) -> do + -- return ("abcdefgh", "12345678", False, False, True) + return (lmsUser E.^. LmsUserIdent, lmsUser E.^. LmsUserPin, lmsUser E.^. LmsUserResetPin, lmsUser E.^. LmsUserResetPin, isJust (user E.?. UserCompanyPersonalNumber)) dbtColonnade = colChoices dbtSorting = mempty dbtFilter = mempty @@ -68,31 +84,32 @@ getLmsR = do 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 + , dbtCsvDoEncode = \LmsCsvExportData{} -> C.mapM $ \(_lmsUserTableId, row) -> do + mitarbeiter <- return 1 + return $ LmsUserTableCsv + (row ^. resultUser . _entityVal . _lmsUserIdent) + (row ^. resultUser . _entityVal . _lmsUserPin) + (row ^. resultUser . _entityVal . _lmsUserResetPin . to fromEnum) + (row ^. resultUser . _entityVal . _lmsUserDelete . to fromEnum) + mitarbeiter , dbtCsvName , dbtCsvSheetName - , dbtCsvNoExportData = Nothing -- ? - , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def + , dbtCsvNoExportData = Nothing + , dbtCsvHeader = Nothing -- 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 = _1 - , dbtCsvComputeActions = _2 - , dbtCsvClassifyAction = _3 - , dbtCsvCoarsenActionClass = _4 - , dbtCsvValidateActions = _5 - , dbtCsvExecuteActions = _6 -- <- actions based on sent data here - , dbtCsvRenderKey = _7 - , dbtCsvRenderActionClass = _8 - , dbtCsvRenderException = _9 - } + dbtCsvDecode = Nothing -- 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