fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(lms): minor code cleaning

Browse Source
This commit is contained in:
Steffen Jost 2022-02-08 09:36:11 +01:00
parent cdc297716a
commit 3eeac06c47
3 changed files with 63 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
models/lms.model Normal file
View File

@ -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

2
src/Foundation/Navigation.hs
View File

@ -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

97
src/Handler/LMS.hs
View File

@ -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
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?
dbtColonnade = colChoices
dbtSorting = mempty
dbtFilter = mempty
dbtFilterUI = mempty
dbtParams = def
dbtCsvName = "lms.csv"
-- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam.
dbtCsvEncode = do
return $ DBTCsvEncode
{ dbtCsvExportForm = def
, dbtCsvDoEncode = \UserCsvExportData{} -> C.mapM $ \(_, row) -> flip runReaderT row $
LmsTableCsv -- <- for each desired column one view
<$> view (hasUser . _userSurname)
<*> view (hasUser . _userFirstName)
<*> view (hasUser . _userDisplayName)
<*> view (hasUser . _userSex)
<*> view (hasUser . _userMatrikelnummer)
<*> view (hasUser . _userEmail)
<*> view _userStudyFeatures
<*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
<*> view _userTableRegistration
<*> userNote
<*> (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 =
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?
dbtColonnade = colChoices
dbtSorting = mempty
dbtFilter = mempty
dbtFilterUI = mempty
dbtParams = def
dbtCsvName = "lms.csv"
-- TODO: wip, for reference, see e.g. Handler.Course.Users or Handler.Exam.
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
, dbtCsvName
, dbtCsvSheetName
, dbtCsvNoExportData = Nothing -- ?
, dbtCsvHeader = return . Vector.filter csvColumns' . userTableCsvHeader showSex tutorials sheets . fromMaybe def
, dbtCsvExampleData = Nothing
}
dbTable psValidator DBTable{..}
let heading = [whamlet|LMS|]
-- 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
}
dbTable psValidator DBTable{..}
heading = [whamlet|LMS|]
siteLayout heading $ do
setTitleI heading
$(widgetFile "lms")