chore(lms): improve lms-status display within qualifications
This commit is contained in:
parent
97abc47cdf
commit
1633d7573a
@ -20,5 +20,5 @@ PrintCourse: Kurse
|
||||
PrintQualification: Qualifikation
|
||||
PrintPDF !ident-ok: PDF
|
||||
PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
|
||||
PrintLmsUser: E-Learning Id
|
||||
PrintLmsUser: E‑Learning Id
|
||||
PrintJobs: Druckaufräge
|
||||
@ -20,5 +20,5 @@ PrintCourse: Course
|
||||
PrintQualification: Qualification
|
||||
PrintPDF: PDF
|
||||
PrintManualRenewal: Manual sending of an apron driver's licence renewal letter
|
||||
PrintLmsUser: E-learning id
|
||||
PrintLmsUser: E‑learning id
|
||||
PrintJobs: Print jobs
|
||||
@ -8,8 +8,8 @@ QualificationDescription: Beschreibung
|
||||
QualificationValidDuration: Gültigkeitsdauer
|
||||
QualificationAuditDuration: Aufbewahrung Audit Log
|
||||
QualificationRefreshWithin: Erneurerungszeitraum
|
||||
QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E-Learning
|
||||
QualificationElearningStart: Wird das E-Learning automatisch gestartet?
|
||||
QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E‑Learning
|
||||
QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
|
||||
TableQualificationCountActive: Aktive
|
||||
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
|
||||
TableQualificationCountTotal: Gesamt
|
||||
@ -29,7 +29,7 @@ QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
|
||||
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
|
||||
QualificationBlockReason: Entzugsbegründung
|
||||
LmsUser: Inhaber
|
||||
LmsURL: Link E-Learning
|
||||
LmsURL: Link E‑Learning
|
||||
TableLmsEmail: E‑Mail
|
||||
TableLmsIdent: LMS Identifikation
|
||||
TableLmsElearning: E‑Learning
|
||||
@ -41,20 +41,25 @@ TableLmsStaff: Interner Mitarbeiter?
|
||||
TableLmsStarted: Begonnen
|
||||
TableLmsReceived: Letzte Rückmeldung
|
||||
TableLmsNotified: Versand Benachrichtigung
|
||||
TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E-Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann!
|
||||
TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E‑Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann!
|
||||
TableLmsEnded: Beended
|
||||
TableLmsStatus: Status E‑Learning
|
||||
TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt an, seit wann ein E-Learning offen ist oder wann es mit Bestanden oder Durchgefalen abgeschlossen wurde. #{maybeToMessage "Anzeige erlischt " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss."}
|
||||
TableLmsStatusDay: Datum letzte Statusänderung E-Learning
|
||||
TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt #{maybeToMessage "bis zu " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss"} den letzten Zustand eines E‑Learnings an:
|
||||
TableLmsStatusDay: Datum letzte Statusänderung E‑Learning
|
||||
TableLmsSuccess: Bestanden
|
||||
TableLmsFailed: Gesperrt
|
||||
LmsStatusBlocked: Durchgefallen wegen zu vieler Fehlversuche
|
||||
LmsStatusExpired: Durchgefallen nach Fristablauf
|
||||
LmsStatusSuccess: E#{nonBreakableDash}Learning bestanden
|
||||
LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade eröffnet (nur für Admin sichtbar)
|
||||
LmsStatusDelay: Hinweis: Statusänderung können in seltenen Fällen mehrere Stunden bis zur Anzeige benötigen.
|
||||
FilterLmsValid: Aktuell gültig
|
||||
FilterLmsRenewal: Erneuerung anstehend
|
||||
FilterLmsNotified: Benachrichtigt
|
||||
CsvColumnLmsIdent: E-Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
|
||||
CsvColumnLmsPin: PIN des E-Learning Zugangs
|
||||
CsvColumnLmsIdent: E‑Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
|
||||
CsvColumnLmsPin: PIN des E#{nonBreakableDash}Learning Zugangs
|
||||
CsvColumnLmsResetPin: Wird die PIN 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.)
|
||||
CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme (UTC)
|
||||
CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts
|
||||
@ -65,32 +70,33 @@ LmsResultUpdate: LMS Ergebnis aktualisierung
|
||||
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
||||
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
||||
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
|
||||
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
|
||||
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
|
||||
MailBodyQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst durch einen E-Learning erneuert werden. Ansprechpartner werden gebeten, die Anmeldedaten im Anhang vertraulich an den Prüfling zu übermitteln.
|
||||
MailBodyQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst durch einen E‑Learning erneuert werden. Ansprechpartner werden gebeten, die Anmeldedaten im Anhang vertraulich an den Prüfling zu übermitteln.
|
||||
MailBodyQualificationExpiry: Diese Qualifikation läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
|
||||
MailBodyQualificationExpired: Diese Qualifikation is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E-Learning.
|
||||
MailBodyQualificationExpired: Diese Qualifikation is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E‑Learning.
|
||||
QualificationActExpire: Auslaufend markieren - keine Benachrichtigung zur Erneuerung senden
|
||||
QualificationActUnexpire: Auslaufend aufheben - kostenpflichtige Benachrichtigung bei anstehender Erneuerung senden
|
||||
QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"}
|
||||
QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"}
|
||||
QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E‑Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"}
|
||||
QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E‑Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"}
|
||||
QualificationActBlockSupervisor: Dauerhaft entziehen, mit sofortiger Wirkung
|
||||
QualificationActBlock: Entziehen
|
||||
QualificationActUnblock: Entzug löschen
|
||||
QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} entzogen
|
||||
QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert
|
||||
LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
|
||||
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden.
|
||||
LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden
|
||||
LmsActRenewPin: Neue zufällige E-Learning PIN zuweisen
|
||||
LmsActRenewNotify: Neue zufällige E-Learning PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden
|
||||
LmsNotificationSend n@Int: E-Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet.
|
||||
LmsPinRenewal n@Int: E-Learning Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
|
||||
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden.
|
||||
LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden
|
||||
LmsActRenewPin: Neue zufällige E‑Learning PIN zuweisen
|
||||
LmsActRenewNotify: Neue zufällige E‑Learning PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden
|
||||
LmsStatusNotificationSent: Anmeldedaten wurden an Prüfling oder Ansprechpartner per Post oder E#{nonBreakableDash}Mail versendet; E#{nonBreakableDash}Learning ist derzeit offen
|
||||
LmsNotificationSend n@Int: E‑Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet.
|
||||
LmsPinRenewal n@Int: E‑Learning Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
|
||||
LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen.
|
||||
LmsStarted: E-Learning eröffnet
|
||||
LmsStarted: E‑Learning eröffnet
|
||||
LmsAutomaticQueuing n@Natural: Die folgenden Funktionen werden normalerweise einmal pro Tag um #{show n} Uhr ausgeführt.
|
||||
LmsManualQueuing: Die folgenden Funktionen sollten einmal pro Tag ausgeführt werden.
|
||||
BtnLmsEnqueue: Nutzer mit ablaufenden Qualifikationen zum E-Learning anmelden und benachrichtigen
|
||||
BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen
|
||||
BtnLmsEnqueue: Nutzer mit ablaufenden Qualifikationen zum E‑Learning anmelden und benachrichtigen
|
||||
BtnLmsDequeue: Nutzer mit beendetem E‑Learning ggf. benachrichtigen und aufräumen
|
||||
|
||||
@ -8,8 +8,8 @@ QualificationDescription: Description
|
||||
QualificationValidDuration: Validity period
|
||||
QualificationAuditDuration: Audit log keept
|
||||
QualificationRefreshWithin: Refresh within
|
||||
QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e-learning
|
||||
QualificationElearningStart: Is e-learning automatically started?
|
||||
QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e‑learning
|
||||
QualificationElearningStart: Is e‑learning automatically started?
|
||||
TableQualificationCountActive: Active
|
||||
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
|
||||
TableQualificationCountTotal: Total
|
||||
@ -41,19 +41,24 @@ TableLmsStaff: Staff?
|
||||
TableLmsStarted: Started
|
||||
TableLmsReceived: Last update
|
||||
TableLmsNotified: Notification sent
|
||||
TableLmsNotifiedTooltip: Notfications are not sent before the LMS acknowledges the opening of the e-learning course for the user, which may take several hours!
|
||||
TableLmsNotifiedTooltip: Notfications are not sent before the LMS acknowledges the opening of the e‑learning course for the user, which may take several hours!
|
||||
TableLmsEnded: Ended
|
||||
TableLmsStatus: Status e-learning
|
||||
TableLmsStatusTooltip mbMonth: Shows since when an e-learning is open or when it was closed, including the result. #{maybeToMessage "Shown for " (fmap (flip pluralENsN "month") mbMonth) " after closure."}
|
||||
TableLmsStatusDay: Date of last e-learning status change
|
||||
TableLmsStatus: Status e‑learning
|
||||
TableLmsStatusTooltip mbMonth: Shows #{maybeToMessage "for up to " (fmap (flip pluralENsN "month") mbMonth) " after closure"} the last e#{nonBreakableDash}learning status change:
|
||||
TableLmsStatusDay: Date of last e‑learning status change
|
||||
TableLmsSuccess: Completed
|
||||
TableLmsFailed: Blocked
|
||||
LmsStatusBlocked: Failed after too many attempts
|
||||
LmsStatusExpired: Failed due to expiry
|
||||
LmsStatusSuccess: Passed
|
||||
LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened (visible to Admins only)
|
||||
LmsStatusDelay: Note that status changes may occassionaly require more than a hour to be displayed here.
|
||||
FilterLmsValid: Currently valid
|
||||
FilterLmsRenewal: Renewal due
|
||||
FilterLmsNotified: Notified
|
||||
CsvColumnLmsIdent: E-learning identifier, unique for each qualification and user
|
||||
CsvColumnLmsPin: PIN for e-learning access
|
||||
CsvColumnLmsResetPin: Will the e-learning PIN be reset upon next synchronisation?
|
||||
CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user
|
||||
CsvColumnLmsPin: PIN for e#{nonBreakableDash}learning access
|
||||
CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning PIN be reset 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)
|
||||
CsvColumnLmsSuccess: Timestamp of successful completion (UTC)
|
||||
@ -69,13 +74,13 @@ LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically
|
||||
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
|
||||
MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
|
||||
MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
|
||||
MailBodyQualificationRenewal qname: The qualification #{qname} must be renewed soon by completing an e-learning course, otherwise it will expire. Supervisors are kindly requested to forward the login data confidentially to the examinee.
|
||||
MailBodyQualificationRenewal qname: The qualification #{qname} must be renewed soon by completing an e‑learning course, otherwise it will expire. Supervisors are kindly requested to forward the login data confidentially to the examinee.
|
||||
MailBodyQualificationExpiry: This qualification expires soon. You may then no longer execute any duties that require this qualification as a precondition!
|
||||
MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning.
|
||||
MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e‑learning.
|
||||
QualificationActExpire: Discontinue - qualification expires silently
|
||||
QualificationActUnexpire: Continue - send a possibly fee-paying notification upon due renewal
|
||||
QualificationSetExpire n: Expiry notification and e-learning deactivated for #{n} #{pluralENs n "person"}
|
||||
QualificationSetUnexpire n: Expiry notification and e-learning activated for #{n} #{pluralENs n "person"}
|
||||
QualificationSetExpire n: Expiry notification and e‑learning deactivated for #{n} #{pluralENs n "person"}
|
||||
QualificationSetUnexpire n: Expiry notification and e‑learning activated for #{n} #{pluralENs n "person"}
|
||||
QualificationActBlockSupervisor: Waive permanently, effective immediately
|
||||
QualificationActBlock: Revoke
|
||||
QualificationActUnblock: Clear revocation
|
||||
@ -83,14 +88,15 @@ QualificationStatusBlock l n m: #{n}/#{m} #{l} revoked
|
||||
QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated
|
||||
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter.
|
||||
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
|
||||
LmsActNotify: Resend e-learning notification by post or email
|
||||
LmsActRenewPin: Randomly replace e-learning PIN
|
||||
LmsActRenewNotify: Randomly replace e-learning PIN and re-send notification by post or email
|
||||
LmsActNotify: Resend e‑learning notification by post or email
|
||||
LmsActRenewPin: Randomly replace e‑learning PIN
|
||||
LmsActRenewNotify: Randomly replace e‑learning PIN and re-send notification by post or email
|
||||
LmsStatusNotificationSent: E-learning pin has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open
|
||||
LmsNotificationSend n: E-learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email.
|
||||
LmsPinRenewal n: E-learning pin replaced randomly for #{n} #{pluralENs n "examinee"}.
|
||||
LmsActionFailed n: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination.
|
||||
LmsStarted: E-learning open since
|
||||
LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock.
|
||||
LmsManualQueuing: The following functions should be executed daily.
|
||||
BtnLmsEnqueue: Enqueue users with expiring qualifications for e-learning and notify them.
|
||||
BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate.
|
||||
BtnLmsEnqueue: Enqueue users with expiring qualifications for e‑learning and notify them.
|
||||
BtnLmsDequeue: Dequeue users with finished e‑learning and notify, if appropriate.
|
||||
|
||||
@ -91,8 +91,8 @@ postLmsAllR = do
|
||||
|
||||
lmsTable <- runDB $ do
|
||||
view _2 <$> mkLmsAllTable isAdmin
|
||||
siteLayoutMsg MsgMenuQualifications $ do
|
||||
setTitleI MsgMenuQualifications
|
||||
siteLayoutMsg MsgMenuLms $ do
|
||||
setTitleI MsgMenuLms
|
||||
$(widgetFile "lms-all")
|
||||
|
||||
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
|
||||
@ -615,13 +615,13 @@ postLmsR sid qsh = do
|
||||
when (diffSelected /= 0) $ addMessageI Warning $ MsgLmsActionFailed diffSelected
|
||||
redirect currentRoute
|
||||
|
||||
let heading = citext2widget $ qualificationName quali
|
||||
let heading = citext2widget $ "LMS " <> qualificationName quali
|
||||
siteLayout heading $ do
|
||||
setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh
|
||||
setTitle $ toHtml $ "LMS " <> unSchoolKey sid <> "-" <> qsh
|
||||
$(widgetFile "lms")
|
||||
|
||||
|
||||
-- intended to be viewed primarily in a modal, vie lmsStatusPlusCell'
|
||||
-- intended to be viewed primarily in a modal, wie lmsStatusPlusCell
|
||||
getLmsUserR :: CryptoUUIDUser -> Handler Html
|
||||
getLmsUserR uuid = do
|
||||
uid <- decrypt uuid
|
||||
|
||||
@ -18,7 +18,7 @@ import Import
|
||||
-- import Jobs
|
||||
import Handler.Utils
|
||||
-- import Handler.Utils.Csv
|
||||
-- import Handler.Utils.LMS
|
||||
import Handler.Utils.LMS
|
||||
|
||||
|
||||
import qualified Data.Set as Set
|
||||
@ -460,8 +460,8 @@ postQualificationR sid qsh = do
|
||||
-- , sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
|
||||
-- $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||
-- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltip (MsgTableLmsStatusTooltip auditMonths))
|
||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell' linkLmsUser) lu
|
||||
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
|
||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu
|
||||
]
|
||||
psValidator = def & defaultSorting [SortDescBy "last-refresh"]
|
||||
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
||||
|
||||
@ -20,6 +20,7 @@ module Handler.Utils.LMS
|
||||
, lmsDeletionDate
|
||||
, lmsUserToDelete, _lmsUserToDelete
|
||||
, lmsUserToDeleteExpr
|
||||
, lmsStatusInfoCell
|
||||
, lmsStatusIcon, lmsUserStatusWidget
|
||||
, randomLMSIdent, randomLMSIdentBut
|
||||
, randomLMSpw, maxLmsUserIdentRetries
|
||||
@ -103,18 +104,18 @@ makeLmsFilename ftag (citext2lower -> qsh) = do
|
||||
getYMTH :: MonadHandler m => m Text
|
||||
getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
|
||||
|
||||
--
|
||||
--
|
||||
lmsDeletionDate :: Handler Day
|
||||
lmsDeletionDate = do
|
||||
lmsDeletionDate = do
|
||||
LmsConf{lmsDeletionDays} <- getsYesod $ view _appLmsConf
|
||||
addDays (fromIntegral $ negate lmsDeletionDays) . utctDay <$> liftIO getCurrentTime
|
||||
|
||||
-- | Decide whether LMS platform should delete an identifier
|
||||
lmsUserToDeleteExpr :: Day -> E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
|
||||
lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded)
|
||||
lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded)
|
||||
E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserStatus)
|
||||
E.&&. E.explicitUnsafeCoerceSqlExprValue "timestamp" ((lmslist E.^. LmsUserStatus) E.#>>. "{day}") E.<. E.val cutoff
|
||||
|
||||
|
||||
-- | Is everything since cutoff day or before?
|
||||
lmsUserToDelete :: Day -> LmsUser -> Bool
|
||||
lmsUserToDelete cutoff LmsUser{lmsUserEnded=Nothing, lmsUserStatus= Just lstat} = lmsStatusDay lstat < cutoff
|
||||
@ -154,29 +155,58 @@ randomLMSIdent = LmsIdent <$> randomText [] lengthIdent -- idents must not conta
|
||||
|
||||
randomLMSIdentBut :: MonadIO m => Set LmsIdent -> m (Maybe LmsIdent)
|
||||
randomLMSIdentBut banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk
|
||||
where
|
||||
getIdentOk = do
|
||||
where
|
||||
getIdentOk = do
|
||||
l <- randomLMSIdent
|
||||
return $ toMaybe (Set.notMember l banList) l
|
||||
|
||||
randomLMSpw :: MonadIO m => m Text -- may contain all kinds of symbols, but our users had trouble with some, like ',' '.' ':' '_'
|
||||
randomLMSpw = randomText extra lengthPassword
|
||||
randomLMSpw = randomText extra lengthPassword
|
||||
where
|
||||
extra = "+=!?" -- you cannot distinguish ;: and ., in printed letters
|
||||
|
||||
lmsStatusInfoCell :: Bool -> Maybe Int -> Widget
|
||||
lmsStatusInfoCell extendedInfo auditMonths =
|
||||
[whamlet|$newline never
|
||||
<p>
|
||||
_{MsgTableLmsStatusTooltip auditMonths}
|
||||
<p>
|
||||
<dl .glossary>
|
||||
$if extendedInfo
|
||||
<dt>^{icon IconPlanned}
|
||||
<dd>_{MsgLmsStatusPlanned}
|
||||
<dt>^{icon IconNotificationSent}
|
||||
<dd>_{MsgLmsStatusNotificationSent}
|
||||
<dt>^{icon IconNotOK}
|
||||
<dd>_{MsgLmsStatusBlocked}
|
||||
<dt>^{icon IconExpired}
|
||||
<dd>_{MsgLmsStatusExpired}
|
||||
<dt>^{icon IconOK}
|
||||
<dd>_{MsgLmsStatusSuccess}
|
||||
<p>
|
||||
_{MsgLmsStatusDelay}
|
||||
|]
|
||||
|
||||
lmsStatusIcon :: LmsStatus -> Icon
|
||||
lmsStatusIcon LmsSuccess{} = IconOK
|
||||
lmsStatusIcon LmsExpired{} = IconExpired
|
||||
lmsStatusIcon _other = IconNotOK
|
||||
|
||||
lmsUserStatusWidget :: LmsUser -> Widget
|
||||
lmsUserStatusWidget LmsUser{lmsUserStatus=Just lStat} =
|
||||
lmsUserStatusWidget :: Bool -> LmsUser -> Widget
|
||||
lmsUserStatusWidget _ LmsUser{lmsUserStatus=Just lStat} =
|
||||
[whamlet|$newline never
|
||||
^{formatTimeW SelFormatDate (lmsStatusDay lStat)}
|
||||
\ ^{icon (lmsStatusIcon lStat)}
|
||||
^{formatTimeW SelFormatDate (lmsStatusDay lStat)}
|
||||
\ ^{icon (lmsStatusIcon lStat)}
|
||||
|]
|
||||
lmsUserStatusWidget LmsUser{lmsUserStarted} =
|
||||
-- previously: IconWaitingForUser for lmsUserStatus==Nothing
|
||||
lmsUserStatusWidget _ LmsUser{lmsUserNotified=Just d} =
|
||||
[whamlet|$newline never
|
||||
^{formatTimeW SelFormatDate lmsUserStarted}
|
||||
\ ^{icon IconWaitingForUser}
|
||||
|]
|
||||
^{formatTimeW SelFormatDate d}
|
||||
\ ^{icon IconNotificationSent}
|
||||
|]
|
||||
lmsUserStatusWidget True LmsUser{lmsUserStarted} = -- E-Learning started, but not yet notified; only intended for Admins
|
||||
[whamlet|$newline never
|
||||
^{formatTimeW SelFormatDate lmsUserStarted}
|
||||
\ ^{icon IconPlanned}
|
||||
|]
|
||||
lmsUserStatusWidget _ _ = mempty
|
||||
|
||||
@ -218,6 +218,16 @@ cellHasUserModal toLink user =
|
||||
cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
||||
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
|
||||
|
||||
cellHasMatrikelnummerLinked :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a
|
||||
cellHasMatrikelnummerLinked usr
|
||||
| Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do
|
||||
uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey
|
||||
modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid)
|
||||
| otherwise = mempty
|
||||
where
|
||||
usrEntity = usr ^. hasEntityUser
|
||||
|
||||
|
||||
cellHasEMail :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
||||
cellHasEMail = emailCell . view _userDisplayEmail
|
||||
|
||||
@ -357,15 +367,15 @@ cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece
|
||||
lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
|
||||
lmsStatusCell ls = iconCell (lmsStatusIcon ls) <> spacerCell <> dayCell (lmsStatusDay ls)
|
||||
|
||||
lmsStatusPlusCell :: IsDBTable m a => LmsUser -> DBCell m a
|
||||
lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat
|
||||
lmsStatusPlusCell LmsUser{lmsUserStarted} = iconCell IconWaitingForUser <> spacerCell <> dateCell lmsUserStarted
|
||||
-- lmsStatusPlusCell :: IsDBTable m a => LmsUser -> DBCell m a
|
||||
-- lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat
|
||||
-- lmsStatusPlusCell LmsUser{lmsUserStarted} = iconCell IconWaitingForUser <> spacerCell <> dateCell lmsUserStarted
|
||||
|
||||
lmsStatusPlusCell' :: IsDBTable m a => Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a
|
||||
lmsStatusPlusCell' Nothing lu = wgtCell $ lmsUserStatusWidget lu
|
||||
lmsStatusPlusCell' (Just toLink) lu = cell $ do
|
||||
lmsStatusPlusCell :: IsDBTable m a => Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a
|
||||
lmsStatusPlusCell Nothing lu = wgtCell $ lmsUserStatusWidget False lu
|
||||
lmsStatusPlusCell (Just toLink) lu = cell $ do
|
||||
uuid <- liftHandler $ encrypt $ lu ^. _lmsUserUser
|
||||
modal (lmsUserStatusWidget lu) (Left $ SomeRoute $ toLink uuid)
|
||||
modal (lmsUserStatusWidget True lu) (Left $ SomeRoute $ toLink uuid)
|
||||
|
||||
qualificationBlockedCellNoReason :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
||||
qualificationBlockedCellNoReason Nothing = mempty
|
||||
|
||||
@ -48,7 +48,7 @@ module Handler.Utils.Table.Pagination
|
||||
, linkEitherCell, linkEitherCellM, linkEitherCellM'
|
||||
, maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
|
||||
, anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM'
|
||||
, cellTooltip, cellTooltipIcon
|
||||
, cellTooltip, cellTooltipIcon, cellTooltipWgt
|
||||
, listCell, listCell', listCellOf, listCellOf'
|
||||
, ilistCell, ilistCell', ilistCellOf, ilistCellOf'
|
||||
, formCell, DBFormResult(..), getDBFormResult
|
||||
@ -1700,9 +1700,12 @@ cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -
|
||||
cellTooltip = cellTooltipIcon Nothing
|
||||
|
||||
cellTooltipIcon :: (RenderMessage UniWorX msg, IsDBTable m a) => Maybe Icon -> msg -> DBCell m a -> DBCell m a
|
||||
cellTooltipIcon icn msg = cellContents.mapped %~ (<> tipWdgt)
|
||||
cellTooltipIcon icn = cellTooltipWgt icn . msg2widget
|
||||
|
||||
cellTooltipWgt :: (IsDBTable m a) => Maybe Icon -> Widget-> DBCell m a -> DBCell m a
|
||||
cellTooltipWgt icn wgt = cellContents.mapped %~ (<> tipWdgt)
|
||||
where
|
||||
tipWdgt = iconTooltip (msg2widget msg) icn True
|
||||
tipWdgt = iconTooltip wgt icn True
|
||||
|
||||
-- | Always display widget; maybe a link if user is Authorized.
|
||||
-- Also see variant `linkEmptyCell`
|
||||
|
||||
@ -68,11 +68,14 @@ data Icon
|
||||
| IconRegisterTemplate
|
||||
| IconNoCorrectors
|
||||
| IconTooltipDefault
|
||||
| IconNotificationSuccess
|
||||
| IconNotificationSuccess -- used for popups
|
||||
| IconNotificationInfo
|
||||
| IconNotificationWarning
|
||||
| IconNotificationError
|
||||
| IconNotificationNonactive
|
||||
| IconNotification -- used for email and lettes
|
||||
| IconNoNotification
|
||||
| IconNotificationSent
|
||||
| IconFavourite
|
||||
| IconLanguage
|
||||
| IconNavContainerClose | IconPageActionChildrenClose
|
||||
@ -93,7 +96,6 @@ data Icon
|
||||
| IconFileUploadSession
|
||||
| IconStandaloneFieldError
|
||||
| IconFileUser
|
||||
| IconNotification | IconNoNotification
|
||||
| IconPersonalIdentification
|
||||
| IconMenuWorkflows
|
||||
| IconVideo
|
||||
@ -106,7 +108,7 @@ data Icon
|
||||
| IconLetter
|
||||
| IconAt
|
||||
| IconSupervisor
|
||||
| IconWaitingForUser
|
||||
-- | IconWaitingForUser
|
||||
| IconExpired
|
||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
|
||||
deriving anyclass (Universe, Finite, NFData)
|
||||
@ -180,6 +182,7 @@ iconText = \case
|
||||
IconStandaloneFieldError -> "exclamation"
|
||||
IconFileUser -> "file-user"
|
||||
IconNotification -> "envelope"
|
||||
IconNotificationSent -> "envelope-open" -- "paper-plane", "shipping-fast", "hourglass-half"
|
||||
IconNoNotification -> "bell-slash"
|
||||
IconPersonalIdentification -> "id-card"
|
||||
IconMenuWorkflows -> "project-diagram"
|
||||
@ -192,7 +195,7 @@ iconText = \case
|
||||
IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well
|
||||
IconAt -> "at"
|
||||
IconSupervisor -> "head-side" -- must be notably different to user
|
||||
IconWaitingForUser -> "user-cog" -- Waiting on a user to do something
|
||||
-- IconWaitingForUser -> "user-cog" -- Waiting on a user to do something
|
||||
IconExpired -> "hourglass-end"
|
||||
|
||||
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
||||
|
||||
@ -34,7 +34,7 @@ $else
|
||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime (lmsUserStarted lmsUsr)}
|
||||
$maybe _ <- lmsUserStatus lmsUsr
|
||||
<dt .deflist__dt>_{MsgTableLmsStatus}
|
||||
<dd .deflist__dd>^{lmsUserStatusWidget lmsUsr}
|
||||
<dd .deflist__dd>^{lmsUserStatusWidget True lmsUsr}
|
||||
<dt .deflist__dt>_{MsgTableLmsIdent}
|
||||
<dd .deflist__dd .email>#{getLmsIdent (lmsUserIdent lmsUsr)}
|
||||
<dt .deflist__dt>_{MsgTableLmsPin}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user