chore(lms): work on lms handler stub

models/lms.model

@@ -1,9 +1,16 @@
 -- 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
+LmsUser
+  user              UserId 
+  ident             LmsIdent
+  qualification     QualificationId
+  pin               Text
+  resetPin          Bool
+  delete            Bool
+  deriving Generic
+
+Qualification
+  name Text
+  deriving Generic
 
 LmsUserlist
   ident             LmsIdent

src/Handler/LMS.hs

@@ -15,19 +15,28 @@ type LmsUserIdent = Text -- Unique random use-once identifier for each individua
 data LmsUserTableCsv = LmsUserTableCsv -- Export only
   { csvLmsUserIdent :: LmsUserIdent
   , csvLmsUserPin   :: Text 
-  , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Bool
+  , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Int
   }
 
-data LmsUserlistTableCsv = LmsUserlistTableCsv -- Import only, all users that are currently enlisted at the e-learning plattform
-  { csvLmsUserlistIdent   :: LmsUserIdent
-  , csvLmsUserlistFailed  :: Bool             
-  }
+type LmsUserTableExpr = E.SqlExpr (Entity LmsUser)
+                        `E.LeftOuterJoin` E.SqlExpr (Entity User)
+
+type LmsUserTableData = DBRow ( Entity LmsUser
+                              , Maybe (Entity User)
+                              )
+
+queryLmsUser :: Getter LmsUserTableExpr (E.SqlExpr (Entity LmsUser))
+queryLmsUser = to $(E.sqlLOJproj 2 1)
+
+queryUser :: Getter LmsUserTableExpr (E.SqlExpr (Maybe (Entity User)))
+queryUser = to $(E.sqlLOJproj 2 2)
+
+resultLmsUser :: Lens' LmsUserTableData (Entity LmsUser)
+resultLmsUser = _dbrOutput . _1
+
+resultUser :: Lens' LmsUserTableData (Maybe (Entity User))
+resultUser = _dbrOutput . _2
 
-data LmsResultTableCsv = LmsResultTableCsv  -- Import only, all users that succeeded are returned ONCE only; must then be deleted via LmsUserTableCsv Export!
-  { csvLmsResultIdent   :: LmsUserIdent
-  , csvLmsResultSuccess :: UTCTime          -- datestamp user succeeded (might be local time, unclear)
-  }
-  
 csvLmsUserFilename :: IO Text
 csvLmsUserFilename = makeLmsFilename "user"
 
@@ -54,10 +63,17 @@ getLmsR :: Handler Html
 getLmsR = do
   let dbtIdent     = "lmsUsers" :: Text
       dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
-      dbtSQLQuery q = error "TODO"
-      dbtRowKey    = error "TODO"
-      dbtProj      = dbtProjSimple $ \(userIdent, userPin, doUserPinReset, doDeleteUser, isUserIntern) -> do
-        return ("abcdefgh", "12345678", False, False, True) -- Warum keine Liste? 
+      dbtSQLQuery  = runReaderT $ do
+        lmsUser <- view queryLmsUser
+        user <- view queryUser
+        lift $ do
+          E.on $ E.just (lmsUser E.^. LmsUserUser) E.==. user E.?. UserId
+          -- TODO where?
+          return (lmsUser, user)
+      dbtRowKey    = queryLmsUser >>> (E.^. LmsUserId)
+      dbtProj      = dbtProjSimple $ \(lmsUser, user) -> do
+        -- return ("abcdefgh", "12345678", False, False, True)
+        return (lmsUser E.^. LmsUserIdent, lmsUser E.^. LmsUserPin, lmsUser E.^. LmsUserResetPin, lmsUser E.^. LmsUserResetPin, isJust (user E.?. UserCompanyPersonalNumber))
       dbtColonnade = colChoices
       dbtSorting   = mempty
       dbtFilter    = mempty
@@ -68,31 +84,32 @@ getLmsR = do
       dbtCsvEncode = do
         return $ DBTCsvEncode
           { dbtCsvExportForm = def
-          , dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $
-              LmsTableCsv  -- <- for each desired column one view
-                <$> _t1
-                <*> _t2
-                <*> _t3
-                <*> _t4
-                <*> _t5
+          , dbtCsvDoEncode = \LmsCsvExportData{} -> C.mapM $ \(_lmsUserTableId, row) -> do
+              mitarbeiter <- return 1
+              return $ LmsUserTableCsv
+                (row ^. resultUser . _entityVal . _lmsUserIdent)
+                (row ^. resultUser . _entityVal . _lmsUserPin)
+                (row ^. resultUser . _entityVal . _lmsUserResetPin . to fromEnum)
+                (row ^. resultUser . _entityVal . _lmsUserDelete . to fromEnum)
+                mitarbeiter
           , dbtCsvName
           , dbtCsvSheetName
-          , dbtCsvNoExportData = Nothing -- ?
-          , dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
+          , dbtCsvNoExportData = Nothing
+          , dbtCsvHeader = Nothing -- 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 = _1
-        , dbtCsvComputeActions = _2
-        , dbtCsvClassifyAction = _3
-        , dbtCsvCoarsenActionClass = _4
-        , dbtCsvValidateActions = _5
-        , dbtCsvExecuteActions =  _6 -- <- actions based on sent data here
-        , dbtCsvRenderKey = _7
-        , dbtCsvRenderActionClass = _8
-        , dbtCsvRenderException = _9
-        }
+      dbtCsvDecode = Nothing -- 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