From 9e80a2e5e99c65880cfddab007be0275bfc42174 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 8 Mar 2022 16:16:16 +0100 Subject: [PATCH] chore(lms): activate filters, add examples --- .../categories/qualification/de-de-formal.msg | 2 +- .../uniworx/categories/qualification/en-eu.msg | 2 +- src/Handler/LMS.hs | 2 +- src/Handler/LMS/Result.hs | 8 ++++++-- src/Handler/LMS/Userlist.hs | 18 +++++++++--------- src/Handler/LMS/Users.hs | 2 +- 6 files changed, 19 insertions(+), 15 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 5ffa99c7e..bbf743671 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -11,7 +11,7 @@ CsvColumnLmsPin: PIN des E-Lernen Zugangs CsvColumnLmsResetPin: Wird die PIN bei der nächsten Synchronisation zurückgesetzt? CsvColumnLmsDelete: Wird der Identifikator in der E-Lernen Plattform bei der nächsten Synchronisation gelöscht? CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.) -CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme +CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme (UTC) CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts LmsUserlistInsert: Neuer LMS User LmsUserlistUpdate: LMS User aktualisierung diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 0eeca65f9..c618d7307 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -11,7 +11,7 @@ CsvColumnLmsPin: PIN for E-learning access CsvColumnLmsResetPin: Will the E-learning PIN be reset upon next synchronisation? CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation? CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored) -CsvColumnLmsSuccess: Timestamp of successful completion +CsvColumnLmsSuccess: Timestamp of successful completion (UTC) CsvColumnLmsFailed: Blockier durch LMS, üblicherweise wegen zu vieler Fehlversuche LmsUserlistInsert: New LMS User LmsUserlistUpdate: Update of LMS User diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 263d97cfc..5c6f9d169 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -265,7 +265,7 @@ mkLmsTable sid qsh qid = do [ prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) , prismAForm (singletonFilter csvLmsSuccess . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsSuccess) ] - dbtStyle = def + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = def dbtIdent :: Text dbtIdent = "lms-result" diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index 46891f27f..9f7f55160 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -78,6 +78,7 @@ embedRenderMessage ''UniWorX ''LmsResultCsvException id mkResultTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget) mkResultTable sid qsh qid = do + now_day <- utctDay <$> liftIO getCurrentTime dbtCsvName <- csvFilenameLmsResult qsh let dbtCsvSheetName = dbtCsvName let @@ -107,7 +108,7 @@ mkResultTable sid qsh qid = do [ prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) , prismAForm (singletonFilter csvLmsSuccess . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgTableLmsSuccess) ] - dbtStyle = def + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = def dbtIdent :: Text dbtIdent = "lms-result" @@ -118,7 +119,10 @@ mkResultTable sid qsh qid = do , dbtCsvSheetName , dbtCsvNoExportData = Just id , dbtCsvHeader = const $ return lmsResultTableCsvHeader - , dbtCsvExampleData = Nothing + , dbtCsvExampleData = Just + [ LmsResultTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = addDays (-dos) now_day } + | (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..] + ] } where doEncode' = LmsResultTableCsv diff --git a/src/Handler/LMS/Userlist.hs b/src/Handler/LMS/Userlist.hs index 858559d14..849b33e26 100644 --- a/src/Handler/LMS/Userlist.hs +++ b/src/Handler/LMS/Userlist.hs @@ -30,8 +30,8 @@ makeLenses_ ''LmsUserlistTableCsv --instance Csv.FromRecord LmsUserlistTableCsv -- csv with headers -lmsUserlistTableCsvHeader :: Csv.Header -lmsUserlistTableCsvHeader = Csv.header [ csvLmsIdent, csvLmsBlocked ] +instance DefaultOrdered LmsUserlistTableCsv where + headerOrder = const $ Csv.header [ csvLmsIdent, csvLmsBlocked ] instance ToNamedRecord LmsUserlistTableCsv where toNamedRecord LmsUserlistTableCsv{..} = Csv.namedRecord @@ -106,17 +106,17 @@ mkUserlistTable sid qsh qid = do [ prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) , prismAForm (singletonFilter csvLmsBlocked . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsFailed) ] - dbtStyle = def + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = def dbtIdent :: Text dbtIdent = "lms-userlist" - dbtCsvEncode = Just DBTCsvEncode {..} + dbtCsvEncode = simpleCsvEncode dbtCsvName dbtCsvSheetName doEncode' <&> addExample where - dbtCsvExportForm = pure () - dbtCsvNoExportData = Just id - dbtCsvExampleData = Nothing - dbtCsvHeader = const $ return lmsUserlistTableCsvHeader - dbtCsvDoEncode = \() -> C.map (doEncode' . view _2) + addExample dce = dce{ dbtCsvExampleData = csvExample } + csvExample = Just + [ LmsUserlistTableCsv{csvLULident = LmsIdent lid, csvLULfailed = LmsBool ufl} + | (lid,ufl) <- zip ["abcdefgh", "12345678", "ident8ch"] [False,True,False] + ] doEncode' = LmsUserlistTableCsv <$> view (_dbrOutput . _entityVal . _lmsUserlistIdent) <*> view (_dbrOutput . _entityVal . _lmsUserlistFailed . _lmsBool) diff --git a/src/Handler/LMS/Users.hs b/src/Handler/LMS/Users.hs index d98c9c369..eb4be3cde 100644 --- a/src/Handler/LMS/Users.hs +++ b/src/Handler/LMS/Users.hs @@ -98,7 +98,7 @@ mkUserTable _sid qsh qid = do [ prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent) , prismAForm (singletonFilter csvLmsResetPin . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsResetPin) ] - dbtStyle = def + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = def dbtIdent :: Text dbtIdent = "lms-user"