chore(lms): minor code cleaning

models/lms.model

@@ -0,0 +1,18 @@
+-- LMS Interface Tables, need regular processing by background jobs
+--LmsUsers
+--  user              UserId 
+--  ident             LmsIdent
+--  -- pin               LmsPin   -- pin must not be stored, is only sent once and can be recreated?
+--  deriving Generic
+
+LmsUserlist
+  ident             LmsIdent
+  failed            Bool
+  UniqueLmsUserlist lmsident
+  deriving Generic
+
+LmsResult
+  ident             LmsIdent
+  success           UTCTime
+  UniqueLmsResult   lmsident
+  deriving Generic

src/Foundation/Navigation.hs

@@ -133,7 +133,7 @@ breadcrumb HealthR          = i18nCrumb MsgMenuHealth          Nothing
 breadcrumb InstanceR        = i18nCrumb MsgMenuInstance        Nothing
 breadcrumb StatusR          = i18nCrumb MsgMenuHealth          Nothing  -- never displayed
 
-breadcrumb LmsR             = i18nCrumb MsgMenuLms             Nothing
+-- breadcrumb LmsR             = i18nCrumb MsgMenuLms             Nothing
 
 breadcrumb ProfileR         = i18nCrumb MsgBreadcrumbProfile   Nothing
 breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail  $ Just ProfileR

src/Handler/LMS.hs

@@ -37,13 +37,13 @@ csvLmsUserlistFilename = makeLmsFilename "userliste"
 csvLmsResultFilename :: IO Text
 csvLmsResultFilename = makeLmsFilename "ergebnisse"
 
---| create filenames as specified by LMS 
+-- | Create filenames as specified by the LMS interface agreed with Know How AG
 makeLmsFilename :: Text -> IO Text 
 makeLmsFilename ftag = do 
   ymth <- get_ymth 
   return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv"
 
---| returns current datetime in YYYYMMDDHH format 
+-- | Return current datetime in YYYYMMDDHH format 
 get_ymth :: IO Text 
 get_ymth = do 
   now <- getCurrentTime
@@ -52,58 +52,49 @@ get_ymth = do
 
 getLmsR :: Handler Html
 getLmsR = do
-  let   dbtIdent     = "lmsUsers" :: Text
+  let dbtIdent     = "lmsUsers" :: Text
-        dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
+      dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
-        dbtSQLQuery q = error "TODO"
+      dbtSQLQuery q = error "TODO"
-        dbtRowKey    = error "TODO"
+      dbtRowKey    = error "TODO"
-        dbtProj      = dbtProjSimple $ \(userIdent, userPin, doUserPinReset, doDeleteUser, isUserIntern) -> do
+      dbtProj      = dbtProjSimple $ \(userIdent, userPin, doUserPinReset, doDeleteUser, isUserIntern) -> do
-          return ("abcdefgh", "12345678", False, False, True) -- Warum keine Liste? 
+        return ("abcdefgh", "12345678", False, False, True) -- Warum keine Liste? 
-        dbtColonnade = colChoices
+      dbtColonnade = colChoices
-        dbtSorting   = mempty
+      dbtSorting   = mempty
-        dbtFilter    = mempty
+      dbtFilter    = mempty
-        dbtFilterUI  = mempty
+      dbtFilterUI  = mempty
-        dbtParams    = def
+      dbtParams    = def
-        dbtCsvName = "lms.csv"
+      dbtCsvName = "lms.csv"
-        -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam.
+      -- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam.
-        dbtCsvEncode = do
+      dbtCsvEncode = do
-          return $ DBTCsvEncode
+        return $ DBTCsvEncode
-            { dbtCsvExportForm = def
+          { dbtCsvExportForm = def
-            , dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $
+          , dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $
-                LmsTableCsv  -- <- for each desired column one view
+              LmsTableCsv  -- <- for each desired column one view
-                  <$> view (hasUser . _userSurname)
+                <$> _t1
-                  <*> view (hasUser . _userFirstName)
+                <*> _t2
-                  <*> view (hasUser . _userDisplayName)
+                <*> _t3
-                  <*> view (hasUser . _userSex)
+                <*> _t4
-                  <*> view (hasUser . _userMatrikelnummer)
+                <*> _t5
-                  <*> view (hasUser . _userEmail)
+          , dbtCsvName
-                  <*> view _userStudyFeatures
+          , dbtCsvSheetName
-                  <*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
+          , dbtCsvNoExportData = Nothing -- ?
-                  <*> view _userTableRegistration
+          , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
-                  <*> userNote
+          , dbtCsvExampleData = Nothing
-                  <*> (over (_2.traverse._Just) (tutorialName . entityVal) . over (_1.traverse) (tutorialName . entityVal) <$> view _userTutorials)
-                  -- <*> (over (_2.traverse._Just) (examName . entityVal) . over (_1.traverse) (examName . entityVal) <$> view _userExams)
-                  <*> (over traverse (examName . entityVal) <$> view _userExams)
-                  <*> views _userSheets (set (mapped . _1 . mapped) ())
-            , dbtCsvName
-            , dbtCsvSheetName
-            , dbtCsvNoExportData = Nothing -- ?
-            , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
-            , dbtCsvExampleData = Nothing
-            }
-        -- TODO wip, for reference see e.g. Handler.Exam.Users
-        dbtCsvDecode = Just DBTCsvDecode
-          { dbtCsvRowKey = 
-          , dbtCsvComputeActions = 
-          , dbtCsvClassifyAction = 
-          , dbtCsvCoarsenActionClass = 
-          , dbtCsvValidateActions = 
-          , dbtCsvExecuteActions =  -- <- actions based on sent data here
-          , dbtCsvRenderKey = 
-          , dbtCsvRenderActionClass = 
-          , dbtCsvRenderException = 
           }
-    dbTable psValidator DBTable{..}
+      -- TODO wip, for reference see e.g. Handler.Exam.Users
-  let heading = [whamlet|LMS|]
+      dbtCsvDecode = Just DBTCsvDecode
+        { dbtCsvRowKey = _1
+        , dbtCsvComputeActions = _2
+        , dbtCsvClassifyAction = _3
+        , dbtCsvCoarsenActionClass = _4
+        , dbtCsvValidateActions = _5
+        , dbtCsvExecuteActions =  _6 -- <- actions based on sent data here
+        , dbtCsvRenderKey = _7
+        , dbtCsvRenderActionClass = _8
+        , dbtCsvRenderException = _9
+        }
+      dbTable psValidator DBTable{..}
+      heading = [whamlet|LMS|]
   siteLayout heading $ do
     setTitleI heading
     $(widgetFile "lms")