chore(lms): add csv export to overview table (wip)

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

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

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

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