From 1a67063ec3af18ab51f1b36652653be290299c32 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 26 Jul 2022 14:35:49 +0200 Subject: [PATCH] chore(lms): add csv export to overview table (wip) --- .../categories/qualification/de-de-formal.msg | 2 +- .../categories/qualification/en-eu.msg | 4 +- src/Handler/LMS.hs | 86 ++++++++++++++++++- src/Utils/Print.hs | 6 +- 4 files changed, 89 insertions(+), 9 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 06364ca2b..d3381809c 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -12,7 +12,7 @@ TableQualificationCountTotal: Gesamt TableQualificationValidUntil: Gültig bis TableQualificationLastRefresh: Zuletzt erneuert TableQualificationFirstHeld: Erstmalig -TableLmsUser: Prüfling +TableLmsUser: Ermächtigter TableLmsIdent: Identifikation TableLmsElearning: E-Lernen TableLmsPin: E-Lernen Pin diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index d4ea87c62..802356ef7 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -12,7 +12,7 @@ TableQualificationCountTotal: Total TableQualificationValidUntil: Valid until TableQualificationLastRefresh: Last renewed TableQualificationFirstHeld: First held -TableLmsUser: Examinee +TableLmsUser: Licensee TableLmsIdent: Identifier TableLmsPin: E-learning pin TableLmsElearning: E-learning @@ -21,7 +21,7 @@ TableLmsDatePin: Pin created TableLmsDelete: Delete? TableLmsStaff: Staff? TableLmsStarted: Started -TableLmsReceived: Last received +TableLmsReceived: Last update TableLmsEnded: Ended TableLmsStatus: Status e-learning TableLmsSuccess: Completed diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index dab02b9cd..57b478f0c 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -25,8 +25,8 @@ import Handler.Utils.LMS import qualified Data.Set as Set import qualified Data.Map as Map --- import qualified Data.Csv as Csv --- import qualified Data.Conduit.List as C +import qualified Data.Csv as Csv +import qualified Data.Conduit.List as C import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E @@ -168,6 +168,58 @@ getLmsEditR = postLmsEditR postLmsEditR = error "TODO" +data LmsTableCsv = LmsTableCsv -- L..T..C.. -> ltc.. + { ltcDisplayName :: UserDisplayName + , ltcEmail :: UserEmail + , ltcValidUntil :: Day + , ltcLastRefresh :: Day + , ltcFirstHeld :: Day + , ltcLmsIdent :: Maybe LmsIdent + , ltcLmsStatus :: Maybe LmsStatus + , ltcLmsStarted :: Maybe UTCTime + , ltcLmsDatePin :: Maybe UTCTime + , ltcLmsReceived :: Maybe UTCTime + , ltcLmsEnded :: Maybe UTCTime + } + deriving Generic + +makeLenses_ ''LmsTableCsv + +lmsTableCsvHeaderList :: [ByteString] +lmsTableCsvHeaderList = + [ "licensee" + , "email" + , "valid-until" + , "last-renewed" + , "first-held" + , "e-learn-ident" + , "e-learn-status" + , "e-learn-started" + , "e-learn-pin-created" + , "e-learn-last-update" + , "e-learn-ended" + ] + +lmsTableCsvHeader :: Csv.Header +lmsTableCsvHeader = Csv.header lmsTableCsvHeaderList + +instance Csv.ToNamedRecord LmsTableCsv where + toNamedRecord LmsTableCsv{..} = Csv.namedRecord $ zipWith lmsTableCsvHeaderList lmsTableFields Csv.namedField + where lmsTableFields = + [ ltcDisplayName + , ltcEmail + , ltcValidUntil + , ltcLastRefresh + , ltcFirstHeld + , ltcLmsIdent + , ltcLmsStatus + , ltcLmsStarted + , ltcLmsDatePin + , ltcLmsReceived + , ltcLmsEnded + ] + + type LmsTableExpr = ( E.SqlExpr (Entity QualificationUser) `E.InnerJoin` E.SqlExpr (Entity User) ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) @@ -294,7 +346,35 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtIdent :: Text dbtIdent = "qualification" - dbtCsvEncode = noCsvEncode + dbtCsvEncode = Just DBTCsvEncode + { dbtCsvExportForm = pure () + , dbtCsvDoEncode = \() -> C.map (doEncode' . view _2) + , dbtCsvName + , dbtCsvSheetName + , dbtCsvNoExportData = Just id + , dbtCsvHeader = const $ return lmsTableCsvHeader + , dbtCsvExampleData = Nothing -- TODO + {- + Just + [ LmsTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = LmsDay $ addDays (-dos) now_day } + | (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..] + ] + -} + } + where + doEncode' = LmsTableCsv + <$> view (resultUser . _entityVal . _userDisplayName) + <*> view (resultUser . _entityVal . _userEmail) + <*> view (resultQualUser . _entityVal . _qualificationUserValidUntil) + <*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh) + <*> view (resultQualUser . _entityVal . _qualificationUserFirstHeld) + <*> preview (resultLmsUser . _entityVal . _lmsUserIdent) + <*> preview (resultLmsUser . _entityVal . _lmsUserStatus) + <*> preview (resultLmsUser . _entityVal . _lmsUserStarted) + <*> preview (resultLmsUser . _entityVal . _lmsUserDatePin) + <*> preview (resultLmsUser . _entityVal . _lmsUserReceived) + <*> preview (resultLmsUser . _entityVal . _lmsUserEnded) + dbtCsvDecode = Nothing dbtExtraReps = [] dbtParams = DBParamsForm diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 7b76cf071..375d522c5 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -63,10 +63,10 @@ makePDF wopts doc = do bs2pandocError = over _Left (P.PandocMakePDFError . decodeUtf8 . LBS.toStrict) _Meta :: Lens' P.Pandoc P.Meta -_Meta = lens mg mp +_Meta = lens mget mput where - mg (P.Pandoc m _) = m - mp (P.Pandoc _ b) m = P.Pandoc m b + mget (P.Pandoc m _) = m + mput (P.Pandoc _ b) m = P.Pandoc m b -- | Modify the Meta-Block of Pandoc appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc