chore(lms): continued work on stub wip

This commit is contained in:
Steffen Jost 2022-02-08 12:21:35 +01:00
parent a8ba1783cc
commit c76b2efd1d
5 changed files with 35 additions and 15 deletions

View File

@ -1,4 +1,9 @@
Qualification
name Text
deriving Generic
-- LMS Interface Tables, need regular processing by background jobs -- LMS Interface Tables, need regular processing by background jobs
LmsUser LmsUser
user UserId user UserId
ident LmsIdent ident LmsIdent
@ -8,18 +13,14 @@ LmsUser
delete Bool delete Bool
deriving Generic deriving Generic
Qualification
name Text
deriving Generic
LmsUserlist LmsUserlist
ident LmsIdent ident LmsIdent
failed Bool failed Bool
UniqueLmsUserlist lmsident UniqueLmsUserlist ident
deriving Generic deriving Generic
LmsResult LmsResult
ident LmsIdent ident LmsIdent
success UTCTime success UTCTime
UniqueLmsResult lmsident UniqueLmsResult ident
deriving Generic deriving Generic

View File

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

View File

@ -9,6 +9,9 @@ import Handler.Utils
import qualified Data.Csv as Csv import qualified Data.Csv as Csv
import qualified Data.Conduit.List as C import qualified Data.Conduit.List as C
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import Database.Esqueleto.Utils.TH
type LmsUserIdent = Text -- Unique random use-once identifier for each individual e-learning course; i.e. users may have several active LmsUserIdents at once! type LmsUserIdent = Text -- Unique random use-once identifier for each individual e-learning course; i.e. users may have several active LmsUserIdents at once!
@ -18,8 +21,10 @@ data LmsUserTableCsv = LmsUserTableCsv -- Export only
, csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Int , csvLmsUserReset, cvsLmsUserRemove, cvsLmsUserIntern :: Int
} }
data LmsCsvExportData = LmsCsvExportData
type LmsUserTableExpr = E.SqlExpr (Entity LmsUser) type LmsUserTableExpr = E.SqlExpr (Entity LmsUser)
`E.LeftOuterJoin` E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
type LmsUserTableData = DBRow ( Entity LmsUser type LmsUserTableData = DBRow ( Entity LmsUser
, Maybe (Entity User) , Maybe (Entity User)
@ -74,12 +79,12 @@ getLmsR = do
dbtProj = dbtProjSimple $ \(lmsUser, user) -> do dbtProj = dbtProjSimple $ \(lmsUser, user) -> do
-- return ("abcdefgh", "12345678", False, False, True) -- return ("abcdefgh", "12345678", False, False, True)
return (lmsUser E.^. LmsUserIdent, lmsUser E.^. LmsUserPin, lmsUser E.^. LmsUserResetPin, lmsUser E.^. LmsUserResetPin, isJust (user E.?. UserCompanyPersonalNumber)) return (lmsUser E.^. LmsUserIdent, lmsUser E.^. LmsUserPin, lmsUser E.^. LmsUserResetPin, lmsUser E.^. LmsUserResetPin, isJust (user E.?. UserCompanyPersonalNumber))
dbtColonnade = colChoices dbtColonnade = mempty --TODO
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
@ -92,8 +97,7 @@ getLmsR = do
(row ^. resultUser . _entityVal . _lmsUserResetPin . to fromEnum) (row ^. resultUser . _entityVal . _lmsUserResetPin . to fromEnum)
(row ^. resultUser . _entityVal . _lmsUserDelete . to fromEnum) (row ^. resultUser . _entityVal . _lmsUserDelete . to fromEnum)
mitarbeiter mitarbeiter
, dbtCsvName , dbtCsvName
, dbtCsvSheetName
, dbtCsvNoExportData = Nothing , dbtCsvNoExportData = Nothing
, dbtCsvHeader = Nothing -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def , dbtCsvHeader = Nothing -- return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
, dbtCsvExampleData = Nothing , dbtCsvExampleData = Nothing
@ -109,8 +113,9 @@ getLmsR = do
-- , dbtCsvRenderKey = _7 -- , dbtCsvRenderKey = _7
-- , dbtCsvRenderActionClass = _8 -- , dbtCsvRenderActionClass = _8
-- , dbtCsvRenderException = _9 -- , dbtCsvRenderException = _9
-- } -- }
dbTable psValidator DBTable{..} psValidator = def
lmsTable = dbTable psValidator DBTable{..}
heading = [whamlet|LMS|] heading = [whamlet|LMS|]
siteLayout heading $ do siteLayout heading $ do
setTitleI heading setTitleI heading

View File

@ -22,3 +22,4 @@ import Model.Types.Markup as Types
import Model.Types.Room as Types import Model.Types.Room as Types
import Model.Types.Csv as Types import Model.Types.Csv as Types
import Model.Types.Upload as Types import Model.Types.Upload as Types
import Model.Types.Lms as Types

13
src/Model/Types/Lms.hs Normal file
View File

@ -0,0 +1,13 @@
{-|
Module: Model.Types.Lms
Description: Types for Lms
-}
module Model.Types.Lms
( module Model.Types.Lms
) where
import Import.NoModel
type LmsIdent = Text