chore(lms): minor refactor for csv filenames

src/Handler/LMS.hs

@@ -53,16 +53,6 @@ resultLmsUser = _dbrOutput . _1
 resultUser :: Lens' LmsUserTableData (Maybe (Entity User))
 resultUser = _dbrOutput . _2
 
-csvLmsUserFilename :: MonadHandler m => m Text
-csvLmsUserFilename = makeLmsFilename "user"
-
-csvLmsUserlistFilename :: MonadHandler m => m Text
-csvLmsUserlistFilename = makeLmsFilename "userliste"
-
-csvLmsResultFilename :: MonadHandler m => m Text
-csvLmsResultFilename = makeLmsFilename "ergebnisse"
-
-
 
 getLmsR, postLmsR:: SchoolId -> QualificationShorthand -> Handler Html
 getLmsR = postLmsR

src/Handler/LMS/Result.hs

@@ -26,11 +26,20 @@ import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
+csvLmsUserFilename :: MonadHandler m => QualificationShorthand -> m Text
+csvLmsUserFilename = makeLmsFilename "user"
+
+csvLmsUserlistFilename :: MonadHandler m => QualificationShorthand -> m Text
+csvLmsUserlistFilename = makeLmsFilename "userliste"
+
+csvLmsResultFilename :: MonadHandler m => QualificationShorthand -> m Text
+csvLmsResultFilename = makeLmsFilename "ergebnisse"
+
 -- | Create filenames as specified by the LMS interface agreed with Know How AG
-makeLmsFilename :: MonadHandler m => Text -> m Text
+makeLmsFilename :: MonadHandler m => Text -> QualificationShorthand ->  m Text
-makeLmsFilename ftag = do
+makeLmsFilename ftag (citext2lower -> qsh) = do
   ymth <- getYMTH
-  return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv"
+  return $ "fradrive_" <> qsh <> "_" <> ftag <> "_" <> ymth <> ".csv"
 
 -- | Return current datetime in YYYYMMDDHH format
 getYMTH :: MonadHandler m => m Text
@@ -138,11 +147,13 @@ embedRenderMessage ''UniWorX ''LmsResultCsvException id
 
 
 mkResultTable :: SchoolId -> QualificationShorthand -> QualificationId -> DB (Any, Widget)
-mkResultTable sid qsh qid = do
+mkResultTable sid qsh qid = do  
-  --now <- liftIO getCurrentTime
+  dbtCsvName <- csvLmsResultFilename qsh
+  let dbtCsvSheetName = dbtCsvName
   let
     resultDBTable = DBTable{..}
       where
+
         dbtSQLQuery = runReaderT $ do
           qualification <- asks queryQualification
           lmsResult     <- asks queryLmsResult
@@ -176,18 +187,20 @@ mkResultTable sid qsh qid = do
         dbtStyle = def
         dbtParams = def
         dbtIdent :: Text
-        dbtIdent = "lms-userlist"
+        dbtIdent = "lms-userlist"        
-        dbtCsvEncode = Nothing                
-        {-
         dbtCsvEncode = Just DBTCsvEncode
           { dbtCsvExportForm   = pure ()
           , dbtCsvDoEncode     = \() -> C.map (doEncode' . view _2)
-          , dbtCsvName         = makeLmsFilename "ergebnisse"
+          , dbtCsvName 
-          , dbtCsvSheetName    = makeLmsFilename "ergebnisse"
+          , dbtCsvSheetName
           , dbtCsvNoExportData = Just id
-          , dbtCsvHeader       = const . return . examUserTableCsvHeader allBoni doBonus $ examParts ^.. folded . _entityVal . _examPartNumber
+          , dbtCsvHeader       = const $ return lmsResultTableCsvHeader
           , dbtCsvExampleData  = Nothing
-          -}
+          }
+          where 
+            doEncode' = LmsResultTableCsv
+              <$> view (resultLmsResult . _entityVal . _lmsResultIdent)
+              <*> view (resultLmsResult . _entityVal . _lmsResultSuccess)
 
         dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later
           { dbtCsvRowKey = \LmsResultTableCsv{..} -> 

src/Utils.hs

@@ -295,6 +295,9 @@ text2widget t = [whamlet|#{t}|]
 citext2widget :: CI Text -> WidgetFor site ()
 citext2widget t = [whamlet|#{CI.original t}|]
 
+citext2lower :: CI Text -> Text 
+citext2lower = Text.toLower . CI.original
+
 str2widget :: String -> WidgetFor site ()
 str2widget s = [whamlet|#{s}|]
 

test/Database/Fill.hs

@@ -457,8 +457,11 @@ fillDb = do
   for_ [jost] $ \uid ->
     void . insert' $ UserSchool uid avn False
 
-  _qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein"  Nothing (Just 24) (Just $ 5 * 12) Nothing True 
+  qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein"  Nothing (Just 24) (Just $ 5 * 12) Nothing True 
-  _qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False
+  qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False
+  void . insert' $ LmsResult qid_f (LmsIdent "hijklmn") (addBDays (-1) $ utctDay now) now 
+  void . insert' $ LmsResult qid_f (LmsIdent "opqgrs" ) (addBDays (-2) $ utctDay now) now 
+  void . insert' $ LmsResult qid_r (LmsIdent "pqgrst" ) (addBDays (-3) $ utctDay now) now 
   let
     sdBsc = StudyDegreeKey' 82
     sdMst = StudyDegreeKey' 88