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

chore(lms): WIP V2 Report pages done, job and lms-main page to do

Browse Source
This commit is contained in:
Steffen Jost 2023-07-21 15:47:57 +00:00
parent b84577984a
commit 20b3a39bc3
8 changed files with 127 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -49,6 +49,7 @@ TableLmsElearning: E‑Learning
TableLmsPin: E‑Learning Passwort TableLmsPin: E‑Learning Passwort
TableLmsResetPin: E-Learning Passwort zurücksetzen? TableLmsResetPin: E-Learning Passwort zurücksetzen?
TableLmsDatePin: E-Learning Passwort erstellt TableLmsDatePin: E-Learning Passwort erstellt
TableLmsDate: Datum
TableLmsDelete: Löschen? TableLmsDelete: Löschen?
TableLmsStaff: Interner Mitarbeiter? TableLmsStaff: Interner Mitarbeiter?
TableLmsStarted: Begonnen TableLmsStarted: Begonnen
@ -76,15 +77,20 @@ CsvColumnLmsPin: Passwort E#{nonBreakableDash}Learning Zugang
CsvColumnLmsResetPin: Wird das E-Learning Passwort bei der nächsten Synchronisation zurückgesetzt? CsvColumnLmsResetPin: Wird das E-Learning Passwort bei der nächsten Synchronisation zurückgesetzt?
CsvColumnLmsDelete: Wird der Identifikator in der E‑Learning Plattform bei der nächsten Synchronisation gelöscht? CsvColumnLmsDelete: Wird der Identifikator in der E‑Learning Plattform bei der nächsten Synchronisation gelöscht?
CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.) CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.)
CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme (UTC) CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme
CsvColumnLmsDate: Datum des E‑Learning Ereignisses
CsvColumnLmsResetTries: Anzahl der bisher verbrauchten E‑Learning Prüfungsversuche zurücksetzen CsvColumnLmsResetTries: Anzahl der bisher verbrauchten E‑Learning Prüfungsversuche zurücksetzen
CsvColumnLmsLock: E‑Learning Login gesperrt CsvColumnLmsLock: E‑Learning Login gesperrt
CsvColumnLmsResult !ident-ok: LMS Status
LmsUserlistInsert: Neuer LMS User LmsUserlistInsert: Neuer LMS User
LmsUserlistUpdate: LMS User aktualisierung LmsUserlistUpdate: LMS User Aktualisierung
LmsResultInsert: Neues LMS Ergebnis LmsResultInsert: Neues LMS Ergebnis
LmsResultUpdate: LMS Ergebnis aktualisierung LmsResultUpdate: LMS Ergebnis Aktualisierung
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsReportInsert: Neues LMS Ereignis
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsReportUpdate: LMS Ereignis Aktualisierung
LmsResultCsvExceptionDuplicatedKey: CSV-Import LmsResult fand uneindeutigen Schlüssel
LmsUserlistCsvExceptionDuplicatedKey: CSV-Import LmsUserlist fand uneindeutigen Schlüssel
LmsReportCsvExceptionDuplicatedKey: CSV-Import LmsReport fand uneindeutigen Schlüssel
LmsDirectUpload: Direkter Upload für automatisierte Systeme LmsDirectUpload: Direkter Upload für automatisierte Systeme
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde. LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden

12
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -49,6 +49,7 @@ TableLmsPin: E‑learning password
TableLmsElearning: E‑learning TableLmsElearning: E‑learning
TableLmsResetPin: Reset E‑learning password? TableLmsResetPin: Reset E‑learning password?
TableLmsDatePin: E‑learning password created TableLmsDatePin: E‑learning password created
TableLmsDate: Date
TableLmsDelete: Delete? TableLmsDelete: Delete?
TableLmsStaff: Staff? TableLmsStaff: Staff?
TableLmsStarted: Started TableLmsStarted: Started
@ -74,17 +75,22 @@ FilterLmsNotificationDue: Notification due
CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user
CsvColumnLmsPin: Password e#{nonBreakableDash}learning access CsvColumnLmsPin: Password e#{nonBreakableDash}learning access
CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning password be reset upon next synchronisation? CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning password be reset upon next synchronisation?
CsvColumnLmsDelete: Will the identifier be deleted from the E‑learning platfrom upon next synchronisation? CsvColumnLmsDelete: Will the identifier be deleted from the e‑learning platfrom upon next synchronisation?
CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored) CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored)
CsvColumnLmsSuccess: Timestamp of successful completion (UTC) CsvColumnLmsSuccess: Timestamp of successful completion (UTC)
CsvColumnLmsResetTries: Reset number of used up e‑learning exam attempts CsvColumnLmsResetTries: Reset number of used up e‑learning exam attempts
CsvColumnLmsDate: Date of e‑learning event
CsvColumnLmsResult: LMS Status
CsvColumnLmsLock: E‑learning login is not permitted CsvColumnLmsLock: E‑learning login is not permitted
LmsUserlistInsert: New LMS user LmsUserlistInsert: New LMS user
LmsUserlistUpdate: Update of LMS user LmsUserlistUpdate: Update of LMS user
LmsResultInsert: New LMS result LmsResultInsert: New LMS result
LmsResultUpdate: Update of LMS result LmsResultUpdate: Update of LMS result
LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsReportInsert: New LMS event
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsReportUpdate: Update of LMS event
LmsResultCsvExceptionDuplicatedKey: CSV import LmsResult with ambiguous key
LmsUserlistCsvExceptionDuplicatedKey: CSV import LmsUserlist with ambiguous key
LmsReportCsvExceptionDuplicatedKey: CSV Import LmsReport with ambiguous key
LmsDirectUpload: Direct upload for automated systems LmsDirectUpload: Direct upload for automated systems
LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set. LmsErrorNoRefreshElearning: Error: E‑learning will not be started automatically due to refresh-within time period not being set.
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly

6
models/lms.model
View File

@ -122,7 +122,9 @@ LmsUser
received UTCTime Maybe -- last acknowledgement by LMS received UTCTime Maybe -- last acknowledgement by LMS
notified UTCTime Maybe -- last notified by FRADrive notified UTCTime Maybe -- last notified by FRADrive
ended UTCTime Maybe -- ident was deleted from LMS ended UTCTime Maybe -- ident was deleted from LMS
-- Primary ident -- newtype Key LmsUserId = LmsUserKey { unLmsUser :: Text } -- change LmsIdent -> Text. Do we want this? resetTries Bool default=false -- V2 should e-learning exam tries be reset?
locked Bool default=false -- V2 last returned lock status
-- Primary ident -- newtype Key LmsUserId = LmsUserKey { unLmsUser :: Text } -- change LmsIdent -> Text. Do we want this? No.
UniqueLmsIdent ident -- idents must be unique accross all qualifications, since idents are global within LMS! UniqueLmsIdent ident -- idents must be unique accross all qualifications, since idents are global within LMS!
UniqueLmsQualificationUser qualification user -- each user may be enrolled at most once per course UniqueLmsQualificationUser qualification user -- each user may be enrolled at most once per course
deriving Generic deriving Generic
@ -156,7 +158,7 @@ LmsReport
qualification QualificationId OnDeleteCascade OnUpdateCascade qualification QualificationId OnDeleteCascade OnUpdateCascade
ident LmsIdent ident LmsIdent
date Day Maybe -- BEWARE: timezone is local as submitted by LMS date Day Maybe -- BEWARE: timezone is local as submitted by LMS
result Int -- (0|1|2) 0=too many ties, 1=open, 2=success result LmsState -- (0|1|2) 0=too many ties, 1=open, 2=success
lock Bool -- (0|1) lock Bool -- (0|1)
timestamp UTCTime default=now() timestamp UTCTime default=now()
UniqueLmsReport qualification ident -- required by DBTable UniqueLmsReport qualification ident -- required by DBTable

102
src/Handler/LMS/Report.hs
View File

@ -70,6 +70,20 @@ instance CsvColumnsExplained LmsReportTableCsv where
single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget single :: RenderMessage UniWorX msg => Csv.Name -> msg -> Map Csv.Name Widget
single k v = singletonMap k [whamlet|_{v}|] single k v = singletonMap k [whamlet|_{v}|]
data LmsReportCsvActionClass = LmsReportInsert | LmsReportUpdate
deriving (Eq, Ord, Read, Show, Generic, Enum, Bounded)
embedRenderMessage ''UniWorX ''LmsReportCsvActionClass id
-- By coincidence the action type is identical to LmsReportTableCsv
data LmsReportCsvAction = LmsReportInsertData { lmsReportCsvIdent :: LmsIdent, lmsReportCsvDate :: Maybe Day, lmsReportCsvResult :: LmsState, lmsReportCsvLock :: Bool }
| LmsReportUpdateData { lmsReportCsvIdent :: LmsIdent, lmsReportCsvDate :: Maybe Day, lmsReportCsvResult :: LmsState, lmsReportCsvLock :: Bool }
deriving (Eq, Ord, Read, Show, Generic)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece'' 2 1 -- LmsReportInsertData -> insert
, fieldLabelModifier = camelToPathPiece' 2 -- lmsReportCsvIdent -> csv-ident
, sumEncoding = TaggedObject "action" "data"
} ''LmsReportCsvAction
data LmsReportCsvException data LmsReportCsvException
= LmsReportCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?! = LmsReportCsvExceptionDuplicatedKey -- TODO: this is not used anywhere?!
@ -95,8 +109,8 @@ mkReportTable sid qsh qid = do
[ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsReportIdent . _getLmsIdent -> ident) -> textCell ident [ sortable (Just csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(view $ _dbrOutput . _entityVal . _lmsReportIdent . _getLmsIdent -> ident) -> textCell ident
, sortable (Just csvLmsDate) (i18nCell MsgTableLmsDate) $ \(view $ _dbrOutput . _entityVal . _lmsReportDate -> d) -> cellMaybe dayCell d , sortable (Just csvLmsDate) (i18nCell MsgTableLmsDate) $ \(view $ _dbrOutput . _entityVal . _lmsReportDate -> d) -> cellMaybe dayCell d
, sortable (Just csvLmsResult) (i18nCell MsgTableLmsStatus) $ \(view $ _dbrOutput . _entityVal . _lmsReportResult -> s) -> lmsStateCell s , sortable (Just csvLmsResult) (i18nCell MsgTableLmsStatus) $ \(view $ _dbrOutput . _entityVal . _lmsReportResult -> s) -> lmsStateCell s
, sortable (Just csvLmsLock) (i18nCell MsgTableLmsLock) $ \(view $ _dbrOutput . _entityVal . _lmsReportLock . _lmsBool -> b) -> ifIconCell b IconLocked , sortable (Just csvLmsLock) (i18nCell MsgTableLmsLock) $ \(view $ _dbrOutput . _entityVal . _lmsReportLock -> b) -> ifIconCell b IconLocked
, sortable (Just csvLmsTimestamp) (i18nCell MsgTableLmsReceived)$ \(view $ _dbrOutput . _entityVal . _lmsReportTimestamp -> t) -> dateTimeCell timestamp , sortable (Just csvLmsTimestamp) (i18nCell MsgTableLmsReceived)$ \(view $ _dbrOutput . _entityVal . _lmsReportTimestamp -> t) -> dateTimeCell t
] ]
dbtSorting = Map.fromList dbtSorting = Map.fromList
[ (csvLmsIdent , SortColumn (E.^. LmsReportIdent)) [ (csvLmsIdent , SortColumn (E.^. LmsReportIdent))
@ -128,7 +142,7 @@ mkReportTable sid qsh qid = do
[ LmsReportTableCsv [ LmsReportTableCsv
{ csvLRident = LmsIdent lid { csvLRident = LmsIdent lid
, csvLRdate = LmsDay $ addDays (-dos) now_day , csvLRdate = LmsDay $ addDays (-dos) now_day
, csvLRresult = LmsState $ toEnum $ dos `mod` succ (fromEnum (maxBound :: LmsState)) , csvLRresult = toEnum $ dos `mod` succ (fromEnum (maxBound :: LmsState))
, csvLRlock = LmsBool $ even dos , csvLRlock = LmsBool $ even dos
} }
| (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch", "x2!y3-z4"] [1..] | (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch", "x2!y3-z4"] [1..]
@ -136,26 +150,30 @@ mkReportTable sid qsh qid = do
} }
where where
doEncode' = LmsReportTableCsv doEncode' = LmsReportTableCsv
<$> view (_dbrOutput . _entityVal . _lmsReportIdent) <$> view (_dbrOutput . _entityVal . _lmsReportIdent)
<*> view (_dbrOutput . _entityVal . _lmsReportDate . _lmsDay) <*> preview (_dbrOutput . _entityVal . _lmsReportDate . _Just . _lmsDay)
<*> view (_dbrOutput . _entityVal . _lmsReportResult . enum) <*> view (_dbrOutput . _entityVal . _lmsReportResult)
<*> view (_dbrOutput . _entityVal . _lmsReportLock . _lmsBool) <*> view (_dbrOutput . _entityVal . _lmsReportLock . _lmsBool)
dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later dbtCsvDecode = Just DBTCsvDecode -- Just save to DB; Job will process data later
{ dbtCsvRowKey = \LmsReportTableCsv{..} -> { dbtCsvRowKey = \LmsReportTableCsv{..} ->
fmap E.Value . MaybeT . getKeyBy $ UniqueLmsReport qid csvLRTident fmap E.Value . MaybeT . getKeyBy $ UniqueLmsReport qid csvLRident
, dbtCsvComputeActions = \case -- purpose is to show a diff to the user first , dbtCsvComputeActions = \case -- purpose is to show a diff to the user first
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew = LmsReportTableCsv{..}} -> do
yield $ LmsReportInsertData yield $ LmsReportInsertData
{ lmsReportInsertIdent = csvLRTident dbCsvNew { lmsReportCsvIdent = csvLRident
, lmsReportInsertSuccess = csvLRTsuccess dbCsvNew & lms2day , lmsReportCsvDate = csvLRdate <&> lms2day
} , lmsReportCsvResult = csvLRresult
, lmsReportCsvLock = csvLRlock
}
DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsReport was found, but the key no longer exists." -- TODO: how can this ever happen? Check Pagination-Code DBCsvDiffNew{dbCsvNewKey = Just _, dbCsvNew = _} -> error "UniqueLmsReport was found, but the key no longer exists." -- TODO: how can this ever happen? Check Pagination-Code
DBCsvDiffExisting{dbCsvNew = LmsReportTableCsv{..}, dbCsvOld} -> do DBCsvDiffExisting{dbCsvNew = LmsReportTableCsv{..}, dbCsvOld} -> do
let successDay = lms2day csvLRTsuccess let resultDay = csvLRdate <&> lms2day
when (successDay /= dbCsvOld ^. _dbrOutput . _entityVal . _lmsReportSuccess) $ when (resultDay > dbCsvOld ^. _dbrOutput . _entityVal . _lmsReportDate) $
yield $ LmsReportUpdateData yield $ LmsReportUpdateData
{ lmsReportInsertIdent = csvLRTident { lmsReportCsvIdent = csvLRident
, lmsReportInsertSuccess = successDay , lmsReportCsvDate = resultDay
, lmsReportCsvResult = csvLRresult
, lmsReportCsvLock = csvLRlock
} }
DBCsvDiffMissing{} -> return () -- no deletion DBCsvDiffMissing{} -> return () -- no deletion
, dbtCsvClassifyAction = \case , dbtCsvClassifyAction = \case
@ -171,37 +189,49 @@ mkReportTable sid qsh qid = do
void $ upsert void $ upsert
LmsReport LmsReport
{ lmsReportQualification = qid { lmsReportQualification = qid
, lmsReportIdent = lmsReportInsertIdent actionData , lmsReportIdent = lmsReportCsvIdent actionData
, lmsReportSuccess = lmsReportInsertSuccess actionData , lmsReportDate = lmsReportCsvDate actionData
, lmsReportTimestamp = now -- lmsReportInsertTimestamp -- does it matter which one to choose? , lmsReportResult = lmsReportCsvResult actionData
, lmsReportLock = lmsReportCsvLock actionData
, lmsReportTimestamp = now
} }
[ LmsReportSuccess =. lmsReportInsertSuccess actionData [ LmsReportDate =. lmsReportCsvDate actionData
, LmsReportResult =. lmsReportCsvResult actionData
, LmsReportLock =. lmsReportCsvLock actionData
, LmsReportTimestamp =. now , LmsReportTimestamp =. now
] ]
-- audit $ Transaction.. (add to Audit.Types) -- audit $ Transaction.. (add to Audit.Types)
lift . queueDBJob $ JobLmsReports qid lift . queueDBJob $ JobLmsReports qid -- TODO: V2
return $ LmsReportR sid qsh return $ LmsReportR sid qsh
, dbtCsvRenderKey = const $ \case , dbtCsvRenderKey = const $ \case
LmsReportInsertData{..} -> do -- TODO: i18n LmsReportInsertData{..} -> do -- TODO: i18n
[whamlet| [whamlet|
$newline never $newline never
Insert: Ident #{getLmsIdent lmsReportInsertIdent} # Insert: Ident #{getLmsIdent lmsReportCsvIdent} #
had success on ^{formatTimeW SelFormatDate lmsReportInsertSuccess} has status #{show lmsReportCsvResult} #
$if lmsReportCsvLock
and is locked #
$maybe d <- lmsReportCsvDate
on ^{formatTimeW SelFormatDate d}
|] |]
LmsReportUpdateData{..} -> do -- TODO: i18n LmsReportUpdateData{..} -> do -- TODO: i18n
[whamlet| [whamlet|
$newline never $newline never
Update: Ident #{getLmsIdent lmsReportInsertIdent} # Update: Ident #{getLmsIdent lmsReportCsvIdent} #
had success on ^{formatTimeW SelFormatDate lmsReportInsertSuccess} has status #{show lmsReportCsvResult} #
$if lmsReportCsvLock
and is locked #
$maybe d <- lmsReportCsvDate
on ^{formatTimeW SelFormatDate d}
|] |]
, dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure , dbtCsvRenderActionClass = toWidget <=< ap getMessageRender . pure
, dbtCsvRenderException = ap getMessageRender . pure :: LmsReportCsvException -> DB Text , dbtCsvRenderException = ap getMessageRender . pure :: LmsReportCsvException -> DB Text
} }
dbtExtraReps = [] dbtExtraReps = []
ReportDBTableValidator = def reportDBTableValidator = def
& defaultSorting [SortAscBy csvLmsIdent] & defaultSorting [SortAscBy csvLmsIdent]
dbTable ReportDBTableValidator ReportDBTable dbTable reportDBTableValidator reportDBTable
getLmsReportR, postLmsReportR :: SchoolId -> QualificationShorthand -> Handler Html getLmsReportR, postLmsReportR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsReportR = postLmsReportR getLmsReportR = postLmsReportR
@ -212,7 +242,7 @@ postLmsReportR sid qsh = do
view _2 <$> mkReportTable sid qsh qid view _2 <$> mkReportTable sid qsh qid
siteLayoutMsg MsgMenuLmsReport $ do siteLayoutMsg MsgMenuLmsReport $ do
setTitleI MsgMenuLmsReport setTitleI MsgMenuLmsReport
$(widgetFile "lms-Report") $(widgetFile "lms-report")
-- Direct File Upload/Download -- Direct File Upload/Download
@ -223,11 +253,15 @@ saveReportCsv qid i LmsReportTableCsv{..} = do
void $ upsert void $ upsert
LmsReport LmsReport
{ lmsReportQualification = qid { lmsReportQualification = qid
, lmsReportIdent = csvLRTident , lmsReportIdent = csvLRident
, lmsReportSuccess = csvLRTsuccess & lms2day , lmsReportDate = csvLRdate <&> lms2day
, lmsReportResult = csvLRresult
, lmsReportLock = csvLRlock
, lmsReportTimestamp = now , lmsReportTimestamp = now
} }
[ LmsReportSuccess =. (csvLRTsuccess & lms2day) [ LmsReportDate =. (csvLRdate <&> lms2day)
, LmsReportResult =. csvLRresult
, LmsReportLock =. csvLRlock
, LmsReportTimestamp =. now , LmsReportTimestamp =. now
] ]
return $ succ i return $ succ i
@ -238,8 +272,8 @@ makeReportUploadForm = renderAForm FormStandard $ fileAFormReq "Report CSV"
getLmsReportUploadR, postLmsReportUploadR :: SchoolId -> QualificationShorthand -> Handler Html getLmsReportUploadR, postLmsReportUploadR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsReportUploadR = postLmsReportUploadR getLmsReportUploadR = postLmsReportUploadR
postLmsReportUploadR sid qsh = do postLmsReportUploadR sid qsh = do
((Report,widget), enctype) <- runFormPost makeReportUploadForm ((report,widget), enctype) <- runFormPost makeReportUploadForm
case Report of case report of
FormSuccess file -> do FormSuccess file -> do
-- content <- fileSourceByteString file -- content <- fileSourceByteString file
-- return $ Just (fileName file, content) -- return $ Just (fileName file, content)

2
src/Jobs/Handler/LMS.hs
View File

@ -146,6 +146,8 @@ dispatchJobLmsEnqueueUser qid uid = JobHandlerAtomic act
, lmsUserReceived = Nothing , lmsUserReceived = Nothing
, lmsUserNotified = Nothing , lmsUserNotified = Nothing
, lmsUserEnded = Nothing , lmsUserEnded = Nothing
, lmsUserResetTries = False
, lmsUserLocked = True -- initially display locked, since it is not yet available until the first feedback
} }
-- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser)) -- startLmsUser :: YesodJobDB UniWorX (Maybe (Entity LmsUser))
startLmsUser = do startLmsUser = do

12
src/Model/Types/Lms.hs
View File

@ -55,7 +55,6 @@ instance Csv.ToField LmsStatus where
toField = Csv.toField . toPathPiece toField = Csv.toField . toPathPiece
-- | Default Block/Unblock reasons -- | Default Block/Unblock reasons
data QualificationBlockStandardReason data QualificationBlockStandardReason
= QualificationBlockFailedELearning = QualificationBlockFailedELearning
@ -93,7 +92,7 @@ instance Csv.FromField LmsBool where
parseField "1" = pure $ LmsBool True parseField "1" = pure $ LmsBool True
parseField _ = mempty parseField _ = mempty
-- | LMS interface communicating user status -- | Only to be used in LMS interface communicating user status
data LmsState = LmsFailed | LmsOpen | LmsPassed data LmsState = LmsFailed | LmsOpen | LmsPassed
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData, Universe, Finite) deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData, Universe, Finite)
@ -108,6 +107,15 @@ instance Csv.FromField LmsState where
parseField "2" = pure LmsPassed parseField "2" = pure LmsPassed
parseField _ = mempty parseField _ = mempty
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 1 -- remove lms from constructor
, fieldLabelModifier = camelToPathPiece' 1
, sumEncoding = UntaggedValue
} ''LmsState
derivePersistFieldJSON ''LmsState
nullaryPathPiece ''LmsState $ camelToPathPiece' 1
-- | LMS interface requires day format not compliant with iso8601; also LMS uses LOCAL TIMEZONE -- | LMS interface requires day format not compliant with iso8601; also LMS uses LOCAL TIMEZONE
newtype LmsDay = LmsDay { lms2day :: Day } newtype LmsDay = LmsDay { lms2day :: Day }
deriving (Eq, Ord, Read, Show, Generic) deriving (Eq, Ord, Read, Show, Generic)

11
templates/lms-report.hamlet Normal file
View File

@ -0,0 +1,11 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
<p>
^{lmsTable}
<p>
<a href=@{directUploadLink}>
_{MsgLmsDirectUpload}

12
test/Database/Fill.hs
View File

@ -731,12 +731,12 @@ fillDb = do
void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now void . insert' $ LmsUserlist qid_f (LmsIdent "hijklmn") False now
void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now void . insert' $ LmsUserlist qid_f (LmsIdent "abcdefg") True now
void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now void . insert' $ LmsUserlist qid_f (LmsIdent "ijk" ) False now
void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5)) void . insert' $ LmsUser qid_f jost (LmsIdent "ijk" ) "123" False now Nothing Nothing now Nothing (Just $ n_day' (-7)) (Just $ n_day' (-5)) False False
void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just LmsSuccess) (Just $ n_day 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing void . insert' $ LmsUser qid_f svaupel (LmsIdent "abcdefg") "abc" False now (Just LmsSuccess) (Just $ n_day 1) (n_day' (-1)) (Just now) (Just $ n_day' 0) Nothing True False
void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just LmsBlocked) (Just $ utctDay now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing void . insert' $ LmsUser qid_f gkleen (LmsIdent "hijklmn") "@#!" True now (Just LmsBlocked) (Just $ utctDay now) (n_day' (-2)) (Just now) (Just $ n_day' (-4)) Nothing False True
void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just LmsSuccess) (Just $ n_day (-22)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just LmsSuccess) (Just $ n_day (-22)) (n_day' (-3)) (Just $ n_day' (-1)) (Just $ n_day' (-1)) Nothing True True
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just LmsBlocked) (Just $ n_day (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just LmsBlocked) (Just $ n_day (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing True True
void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing Nothing now Nothing Nothing Nothing void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing Nothing now Nothing Nothing Nothing False False
void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing
void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk") void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk")