diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index a8a5c4455..1e1008da3 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -5,5 +5,8 @@ TableLmsReceived: Erhalten CsvColumnLmsIdent: E-Lernen Identifikator, einzigartig pro Qualifikation und Teilnehmer CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts +LmsUserlistInsert: Neuer LMS User +LmsUserlistUpdate: Aktualisierung von LMS User LmsResultInsert: Neues LMS Ergebnis -LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel \ No newline at end of file +LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel +LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index d45739846..f1c822915 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -5,5 +5,8 @@ TableLmsReceived: Received CsvColumnLmsIdent: E-Learing identifier, unique for each qualfication and user CsvColumnLmsSuccess: Timestamp of successful completion CsvColumnLmsFailed: Blockier durch LMS, üblicherweise wegen zu vieler Fehlversuche +LmsUserlistInsert: New LMS User +LmsUserlistUpdate: Update of LMS User LmsResultInsert: New LMS result -LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key \ No newline at end of file +LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key +LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key \ No newline at end of file diff --git a/models/lms.model b/models/lms.model index 47ec44cdf..5747095ab 100644 --- a/models/lms.model +++ b/models/lms.model @@ -107,6 +107,7 @@ LmsUserlist ident LmsIdent failed Bool timestamp UTCTime default=now() + UniqueLmsUserlist qualification ident deriving Generic -- LmsResult stores LMS upload for later processing only diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index dd8a2a5d8..c612da702 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -112,7 +112,7 @@ deriveJSON defaultOptions } ''LmsResultCsvAction data LmsResultCsvException - = LmsResultCsvExceptionDuplicatedKey + = LmsResultCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?! deriving (Show, Generic, Typeable) instance Exception LmsResultCsvException @@ -185,9 +185,9 @@ mkResultTable sid qsh qid = do { lmsResultInsertIdent = csvLRTident dbCsvNew , lmsResultInsertSuccess = csvLRTsuccess dbCsvNew } - DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsResult was found, but the key no longer exists." + DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsResult was found, but the key no longer exists." -- TODO: how can this ever happen? Check Pagination-Code DBCsvDiffMissing{} -> return () -- no deletion - DBCsvDiffExisting{} -> return () -- no merge + DBCsvDiffExisting{} -> return () -- no merge TODO!!! ADD MERGE DUE TO Uniqueness! , dbtCsvClassifyAction = \LmsResultInsertData{} -> LmsResultInsert , dbtCsvCoarsenActionClass = \LmsResultInsert -> DBCsvActionNew -- there is only one action: insert into table , dbtCsvValidateActions = return () -- no validation, since this is an automatic upload, i.e. no user to review error @@ -207,7 +207,7 @@ mkResultTable sid qsh qid = do -- queueDBJob?? -- todo -- audit return $ LmsResultR sid qsh - , dbtCsvRenderKey = \_ LmsResultInsertData{..} -> do + , dbtCsvRenderKey = \_ LmsResultInsertData{..} -> do -- TODO: i18n [whamlet| $newline never Ident #{getLmsIdent lmsResultInsertIdent} # diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs index 29721e585..8c3741c86 100644 --- a/src/Handler/LMS/Userlist.hs +++ b/src/Handler/LMS/Userlist.hs @@ -56,8 +56,30 @@ instance CsvColumnsExplained LmsUserlistTableCsv where single k v = singletonMap k [whamlet|_{v}|] +data LmsUserlistCsvActionClass = LmsUserlistInsert | LmsUserlistUpdate + deriving (Eq, Ord, Read, Show, Generic, Typeable, Enum, Bounded) +embedRenderMessage ''UniWorX ''LmsUserlistCsvActionClass id + +data LmsUserlistCsvAction = LmsUserlistInsertData { lmsUserlistInsertIdent :: LmsIdent, lmsUserlistInsertFailed :: Bool } + | LmsUserlistUpdateData { lmsUserlistInsertIdent :: LmsIdent, lmsUserlistInsertFailed :: Bool } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +deriveJSON defaultOptions + { constructorTagModifier = camelToPathPiece'' 2 1 -- LmsUserlistInsertData -> insert + , fieldLabelModifier = camelToPathPiece' 2 -- lmsUserlistInsertIdent -> insert-ident | lmsUserlistInsertFailed -> insert-failed + , sumEncoding = TaggedObject "action" "data" + } ''LmsUserlistCsvAction + + +data LmsUserlistCsvException + = LmsUserlistCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?! + deriving (Show, Generic, Typeable) + +instance Exception LmsUserlistCsvException +embedRenderMessage ''UniWorX ''LmsUserlistCsvException id + mkUserlistTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget) -mkUserlistTable _sid qsh qid = do +mkUserlistTable sid qsh qid = do dbtCsvName <- csvFilenameLmsUserlist qsh let dbtCsvSheetName = dbtCsvName let @@ -100,7 +122,65 @@ mkUserlistTable _sid qsh qid = do doEncode' = LmsUserlistTableCsv <$> view (_dbrOutput . _entityVal . _lmsUserlistIdent) <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed) - dbtCsvDecode = Nothing -- TODO !!! continue here !!! CSV Import is the purpose of this page! Just save to DB, create Job to deal with it later! + dbtCsvDecode = Just DBTCsvDecode {..} + where + dbtCsvRowKey = \LmsUserlistTableCsv{csvLULident} -> + fmap E.Value . MaybeT . getKeyBy $ UniqueLmsUserlist qid csvLULident + dbtCsvComputeActions = \case -- shows a diff first + DBCsvDiffNew{dbCsvNew} -> do + yield $ LmsUserlistInsertData + { lmsUserlistInsertIdent = csvLULident dbCsvNew + , lmsUserlistInsertFailed = csvLULfailed dbCsvNew + } + DBCsvDiffExisting{dbCsvNew = LmsUserlistTableCsv{..}} -> do + yield $ LmsUserlistUpdateData + { lmsUserlistInsertIdent = csvLULident + , lmsUserlistInsertFailed = csvLULfailed + } + DBCsvDiffMissing{} -> return () -- no deletion + dbtCsvClassifyAction = \case + LmsUserlistInsertData{} -> LmsUserlistInsert + LmsUserlistUpdateData{} -> LmsUserlistUpdate + dbtCsvCoarsenActionClass = \case + LmsUserlistInsert -> DBCsvActionNew + LmsUserlistUpdate -> DBCsvActionExisting + dbtCsvValidateActions = return () -- no validation, since this is an automatic upload, i.e. no user to review error + dbtCsvExecuteActions = do + C.mapM_ $ \actionData -> do + now <- liftIO getCurrentTime + void $ upsert LmsUserlist + { + lmsUserlistQualification = qid + , lmsUserlistIdent = lmsUserlistInsertIdent actionData + , lmsUserlistFailed = lmsUserlistInsertFailed actionData + , lmsUserlistTimestamp = now + } + [ + LmsUserlistFailed =. lmsUserlistInsertFailed actionData -- TODO: should we allow a reset from failed: True to False? + , LmsUserlistTimestamp =. now + ] + return $ LmsUserlistR sid qsh + dbtCsvRenderKey = const $ \case + LmsUserlistInsertData{..} -> do -- TODO: i18n + [whamlet| + $newline never + Insert: Course for Ident #{getLmsIdent lmsUserlistInsertIdent} # + $if lmsUserlistInsertFailed + is closed due to failure. + $else + is open. + |] + LmsUserlistUpdateData{..} -> do -- TODO: i18n + [whamlet| + $newline never + Update: Course for Ident #{getLmsIdent lmsUserlistInsertIdent} # + $if lmsUserlistInsertFailed + is now closed due to failure. + $else + is still open. + |] + dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure + dbtCsvRenderException = ap getMessageRender . pure :: LmsUserlistCsvException -> DB Text dbtExtraReps = [] userlistDBTableValidator = def diff --git a/templates/lms-result.hamlet b/templates/lms-result.hamlet index 51d91dafb..389ec613d 100644 --- a/templates/lms-result.hamlet +++ b/templates/lms-result.hamlet @@ -1 +1,2 @@ +LMS Result ^{lmsTable} diff --git a/templates/lms-userlist.hamlet b/templates/lms-userlist.hamlet index 51d91dafb..ae0f39cab 100644 --- a/templates/lms-userlist.hamlet +++ b/templates/lms-userlist.hamlet @@ -1 +1,2 @@ +LMS Userlist ^{lmsTable} diff --git a/templates/lms.hamlet b/templates/lms.hamlet index 51d91dafb..79aa7175b 100644 --- a/templates/lms.hamlet +++ b/templates/lms.hamlet @@ -1 +1,5 @@ +LMS Overview + +!!!THIS PAGE IS NOT YET FUNCTIONAL!!! + ^{lmsTable}