fraport/fradrive-old
Archived
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 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

43
src/Handler/LMS.hs
View File

@ -37,13 +37,13 @@ csvLmsUserlistFilename = makeLmsFilename "userliste"
csvLmsResultFilename :: IO Text csvLmsResultFilename :: IO Text
csvLmsResultFilename = makeLmsFilename "ergebnisse" 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 :: Text -> IO Text
makeLmsFilename ftag = do makeLmsFilename ftag = do
ymth <- get_ymth ymth <- get_ymth
return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv" return $ "fradrive_f_" <> ftag <> "_" <> ymth <> ".csv"
--| returns current datetime in YYYYMMDDHH format -- | Return current datetime in YYYYMMDDHH format
get_ymth :: IO Text get_ymth :: IO Text
get_ymth = do get_ymth = do
now <- getCurrentTime now <- getCurrentTime
@ -70,20 +70,11 @@ getLmsR = do
{ 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)
<*> 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 , dbtCsvName
, dbtCsvSheetName , dbtCsvSheetName
, dbtCsvNoExportData = Nothing -- ? , dbtCsvNoExportData = Nothing -- ?
@ -92,18 +83,18 @@ getLmsR = do
} }
-- TODO wip, for reference see e.g. Handler.Exam.Users -- TODO wip, for reference see e.g. Handler.Exam.Users
dbtCsvDecode = Just DBTCsvDecode dbtCsvDecode = Just DBTCsvDecode
{ dbtCsvRowKey = { dbtCsvRowKey = _1
, dbtCsvComputeActions = , dbtCsvComputeActions = _2
, dbtCsvClassifyAction = , dbtCsvClassifyAction = _3
, dbtCsvCoarsenActionClass = , dbtCsvCoarsenActionClass = _4
, dbtCsvValidateActions = , dbtCsvValidateActions = _5
, dbtCsvExecuteActions = -- <- actions based on sent data here , dbtCsvExecuteActions = _6 -- <- actions based on sent data here
, dbtCsvRenderKey = , dbtCsvRenderKey = _7
, dbtCsvRenderActionClass = , dbtCsvRenderActionClass = _8
, dbtCsvRenderException = , dbtCsvRenderException = _9
} }
dbTable psValidator DBTable{..} dbTable psValidator DBTable{..}
let heading = [whamlet|LMS|] heading = [whamlet|LMS|]
siteLayout heading $ do siteLayout heading $ do
setTitleI heading setTitleI heading
$(widgetFile "lms") $(widgetFile "lms")