fix(lms): fix #161 lms for multiple joint qualifications
This commit is contained in:
parent
feb8d92bc1
commit
f869a829d2
@ -9,6 +9,7 @@ QualificationValidIndicator: Gültigkeit
|
||||
QualificationValidDuration: Gültigkeitsdauer
|
||||
QualificationAuditDuration: Aufbewahrung Audit Log
|
||||
QualificationAuditDurationTooltip n@Int: Optionaler Zeitraum zur Löschung von E‑Learning Daten. Hinweis: Der E‑Learning Server kann seine anonymisierten Daten schon früher löschen, aber spätestens #{n} Tage nach Abschluss.
|
||||
QualificationAuditDurationReuseError: Diese Qualifikation nutzt das E‑Learning einer anderen Qualifikation, für die derzeit keinen Löschzeitraum konfiguriert wurde.
|
||||
QualificationRefreshWithin: Erneurerungszeitraum
|
||||
QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des E‑Learnings und Versand einer Benachrichtigung per Brief oder Email.
|
||||
QualificationRefreshReminder: 2. Erinnerung
|
||||
@ -20,6 +21,8 @@ QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Q
|
||||
TableQualificationCountActive: Aktive
|
||||
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
|
||||
TableQualificationCountTotal: Gesamt
|
||||
TableQualificationLmsReuses: LMS nutzt
|
||||
TableQualificationLmsReusesTooltip: Diese Qualifikation hat kein eigenes E‑Learning, sondern wird über das E‑Learning der angegebenen Qualifikation abgewickelt.
|
||||
TableQualificationIsAvsLicence: AVS
|
||||
TableQualificationIsAvsLicenceTooltip: Unter welchem Namen wird diese Qualifikation mit dem Ausweisverwaltungssystem (AVS) synchronisiert? Betrifft nur Benutzer mit AVS PersonenID.
|
||||
TableQualificationSapExport: SAP
|
||||
|
||||
@ -9,6 +9,7 @@ QualificationValidIndicator: Validity
|
||||
QualificationValidDuration: Validity period
|
||||
QualificationAuditDuration: Audit log retention period
|
||||
QualificationAuditDurationTooltip n@Int: Optional period for deletion of e‑learning data. Note that the e‑learning server may delete its anonymised data earlier, at most #{n} days after closing.
|
||||
QualificationAuditDurationReuseError: This qualification reuses the e‑learning from another qualification, which has no audit duration configured.
|
||||
QualificationRefreshWithin: Refresh within
|
||||
QualificationRefreshWithinTooltip: Optional period before expiry to start e‑learning and send a notification by post or email.
|
||||
QualificationRefreshReminder: 2. Reminder
|
||||
@ -20,6 +21,8 @@ QualificationExpiryNotificationTooltip: Qualification holder are notfied upon in
|
||||
TableQualificationCountActive: Active
|
||||
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
|
||||
TableQualificationCountTotal: Total
|
||||
TableQualificationLmsReuses: Reuse LMS
|
||||
TableQualificationLmsReusesTooltip: This qualification reuses the e‑learning of the given qualification, instead of having a separate e‑learning of its own.
|
||||
TableQualificationIsAvsLicence: AVS driving license
|
||||
TableQualificationIsAvsLicenceTooltip: Under which name is this qualification synchronized with AVS, if any? Only applies to qualification holders having an AVS PersonID.
|
||||
TableQualificationSapExport: Sent to SAP
|
||||
|
||||
@ -14,13 +14,14 @@ Qualification
|
||||
refreshReminder CalendarDiffDays Maybe -- send a second notification about renewal within this number of month/days before expiry
|
||||
elearningStart Bool -- automatically schedule e-refresher
|
||||
elearningRenews Bool default=true -- successful E-learing automatically increases validity automatically by validDuration
|
||||
lmsReuses QualificationId Maybe -- if set, lms is also included within the given qualification's lms, but only for direct routes. AuditDuration is used from this Qualification instead.
|
||||
expiryNotification Bool default=true -- should expiryNotification be generated for this qualification?
|
||||
avsLicence AvsLicence Maybe -- if set, valid QualificationUsers are synchronized to AVS as a driving licence
|
||||
sapId Text Maybe -- if set, valid QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id
|
||||
SchoolQualificationShort school shorthand -- must be unique per school and shorthand
|
||||
SchoolQualificationName school name -- must be unique per school and name
|
||||
-- across all schools, only one qualification may be a driving licence:
|
||||
UniqueQualificationAvsLicence avsLicence !force -- either empty or unique
|
||||
-- across all schools, only one qualification may be a driving licence -- NO LONGER TRUE
|
||||
-- UniqueQualificationAvsLicence avsLicence !force -- either empty or unique
|
||||
-- NOTE: two NULL values are not equal for the purpose of Uniqueness constraints!
|
||||
deriving Show Eq Generic
|
||||
|
||||
|
||||
@ -311,6 +311,7 @@ resultUser = _dbrOutput . _3 . _Just
|
||||
mkProblemLogTable :: DB (FormResult (ProblemTableActionData, Set ProblemLogId), Widget)
|
||||
mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
|
||||
where
|
||||
-- TODO: query to collect all occurring problem types to use as tooltip for the problem filter, so that these don't run out of synch
|
||||
dbtIdent = "problem-log" :: Text
|
||||
dbtSQLQuery = \(problem `E.LeftOuterJoin` solver `E.LeftOuterJoin` usr) -> do
|
||||
-- EL.on (usr E.?. UserId E.==. E.text2num (problem E.^. ProblemLogInfo E.->>. "user")) -- works
|
||||
|
||||
@ -450,8 +450,8 @@ getProblemAvsSynchR = do
|
||||
|
||||
procRes alic (LicenceTableRevokeFDriveData{..}, apids) = do
|
||||
oks <- runDB $ do
|
||||
qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
|
||||
if qId /= licenceTableChangeFDriveQId
|
||||
qIds <- selectKeysList [QualificationAvsLicence ==. Just alic] [] -- sanity check
|
||||
if licenceTableChangeFDriveQId `notElem` qIds
|
||||
then return (-1)
|
||||
else do
|
||||
uids <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
|
||||
|
||||
@ -129,7 +129,7 @@ _userSheets = _dbrOutput . _7
|
||||
|
||||
-- _userQualifications :: Traversal' UserTableData [Entity Qualification]
|
||||
-- _userQualifications = _dbrOutput . _8 . (traverse _1)
|
||||
-- last part: ([Entity Qualification] -> f [Entity Qualification]) -> UserTableQualfications -> f UserTableQualifications
|
||||
-- last part: ([Entity Qualification] -> f [Entity Qualification]) -> UserTableQualifications -> f UserTableQualifications
|
||||
|
||||
_userQualifications :: Getter UserTableData [Entity Qualification]
|
||||
_userQualifications = _dbrOutput . _8 . to (fmap fst3)
|
||||
|
||||
@ -19,6 +19,7 @@ import Handler.Utils.LMS
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Csv as Csv
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Conduit.List as C
|
||||
-- import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
@ -175,13 +176,16 @@ getLmsLearnersR sid qsh = do
|
||||
getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
|
||||
getLmsLearnersDirectR sid qsh = do
|
||||
$logInfoS "LMS" $ "Direct Download Users for " <> tshow qsh <> " at " <> tshow sid
|
||||
(lms_users,cutoff) <- runDB $ do
|
||||
(lms_users,cutoff,qshs) <- runDB $ do
|
||||
(qid, cutoff) <- getQidCutoff sid qsh
|
||||
lms_users <- selectList [ LmsUserQualification ==. qid
|
||||
qidsReuse <- selectList [QualificationLmsReuses ==. Just qid] []
|
||||
let qids = qid : (entityKey <$> qidsReuse)
|
||||
qshs = qsh : (qualificationShorthand . entityVal <$> qidsReuse)
|
||||
lms_users <- selectList [ LmsUserQualification <-. qids
|
||||
, LmsUserEnded ==. Nothing
|
||||
-- , LmsUserReceived ==. Nothing ||. LmsUserResetPin ==. True ||. LmsUserStatus !=. Nothing -- send delta only NOTE: know-how no longer expects delta
|
||||
] [Asc LmsUserStarted, Asc LmsUserIdent]
|
||||
return (lms_users, cutoff)
|
||||
return (lms_users, cutoff, qshs)
|
||||
|
||||
{- To avoid exporting unneeded columns, we would need an SqlSelect instance for LmsUserTableCsv; probably not worth it
|
||||
Ex.select $ do
|
||||
@ -209,7 +213,7 @@ getLmsLearnersDirectR sid qsh = do
|
||||
csvOpts = def { csvFormat = fmtOpts }
|
||||
csvSheetName <- csvFilenameLmsUser qsh
|
||||
let nr = length lms_users
|
||||
msg = "Success. LMS user learners download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"
|
||||
msg = "Success. LMS user learners download file " <> csvSheetName <> " containing " <> tshow nr <> " rows for Qualifications " <> Text.intercalate ", " (ciOriginal <$> qshs)
|
||||
$logInfoS "LMS" msg
|
||||
addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
|
||||
csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered
|
||||
|
||||
@ -3,6 +3,7 @@
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Handler.LMS.Report
|
||||
( getLmsReportR, postLmsReportR
|
||||
@ -17,10 +18,13 @@ import Handler.Utils
|
||||
import Handler.Utils.Csv
|
||||
import Handler.Utils.LMS
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Csv as Csv
|
||||
import qualified Data.Conduit.List as C
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
-- import Database.Esqueleto.Experimental ((:&)(..))
|
||||
import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Jobs.Queue
|
||||
@ -246,8 +250,8 @@ postLmsReportR sid qsh = do
|
||||
|
||||
-- Direct File Upload/Download
|
||||
|
||||
saveReportCsv :: UTCTime -> QualificationId -> Int -> LmsReportTableCsv -> JobDB Int
|
||||
saveReportCsv now qid i LmsReportTableCsv{..} = do
|
||||
saveReportCsv :: UTCTime -> NonEmpty QualificationId -> Int -> LmsReportTableCsv -> JobDB Int
|
||||
saveReportCsv now (qid :| []) i LmsReportTableCsv{..} = do
|
||||
void $ upsert
|
||||
LmsReport
|
||||
{ lmsReportQualification = qid
|
||||
@ -263,6 +267,30 @@ saveReportCsv now qid i LmsReportTableCsv{..} = do
|
||||
, LmsReportTimestamp =. now
|
||||
]
|
||||
return $ succ i
|
||||
saveReportCsv now qids@(qid :| _) i lrtc@LmsReportTableCsv{..} = do
|
||||
ok <- E.insertSelectWithConflictCount UniqueLmsReport
|
||||
(do
|
||||
lusr <- E.from $ E.table @LmsUser
|
||||
E.where_ $ lusr E.^. LmsUserIdent E.==. E.val csvLRident
|
||||
E.&&. lusr E.^. LmsUserQualification `E.in_` E.vals qids
|
||||
return $ LmsReport
|
||||
E.<# (lusr E.^. LmsUserQualification)
|
||||
E.<&> E.val csvLRident
|
||||
E.<&> E.val (csvLRdate <&> lms2timestamp)
|
||||
E.<&> E.val csvLRresult
|
||||
E.<&> E.val (csvLRlock & lms2bool)
|
||||
E.<&> E.val now
|
||||
)
|
||||
(\_old _new ->
|
||||
[ LmsReportDate E.=. E.val (csvLRdate <&> lms2timestamp)
|
||||
, LmsReportResult E.=. E.val csvLRresult
|
||||
, LmsReportLock E.=. E.val (csvLRlock & lms2bool)
|
||||
, LmsReportTimestamp E.=. E.val now
|
||||
]
|
||||
)
|
||||
if ok > 0
|
||||
then return $ succ i
|
||||
else saveReportCsv now (qid :| []) i lrtc -- save unknown LmsIdent to primary qid regardless, so that the error can be tracked
|
||||
|
||||
makeReportUploadForm :: Form FileInfo
|
||||
makeReportUploadForm = renderAForm FormStandard $ fileAFormReq "Report CSV"
|
||||
@ -276,15 +304,18 @@ postLmsReportUploadR sid qsh = do
|
||||
FormSuccess file -> do
|
||||
-- content <- fileSourceByteString file
|
||||
-- return $ Just (fileName file, content)
|
||||
(nr, qid) <- runDBJobs $ do
|
||||
(nr, qids, qshs) <- runDBJobs $ do
|
||||
qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
|
||||
qidsReuse <- selectList [QualificationLmsReuses ==. Just qid] []
|
||||
let qids = qid :| (entityKey <$> qidsReuse)
|
||||
qshs = qsh : (qualificationShorthand . entityVal <$> qidsReuse)
|
||||
nr <- runConduit $ fileSource file
|
||||
.| decodeCsv
|
||||
.| foldMC (saveReportCsv now qid) 0
|
||||
return (nr, qid)
|
||||
addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen")
|
||||
.| foldMC (saveReportCsv now qids) 0
|
||||
return (nr, qids, qshs)
|
||||
addMessage Success $ toHtml $ pack "Erfolgreicher Upload der Datei " <> fileName file <> pack (" mit " <> show nr <> " Zeilen") <> " für Qualifikationen: " <> Text.intercalate ", " (ciOriginal <$> qshs)
|
||||
-- redirect $ LmsReportR sid qsh
|
||||
getLmsReportR sid qsh <* queueJob' (JobLmsReports qid) -- show uploaded data before processing
|
||||
getLmsReportR sid qsh <* forM_ qids (queueJob' . JobLmsReports) -- show uploaded data before processing
|
||||
|
||||
FormFailure errs -> do
|
||||
forM_ errs $ addMessage Error . toHtml
|
||||
@ -308,18 +339,21 @@ postLmsReportDirectR sid qsh = do
|
||||
lmsDecoder <- getLmsCsvDecoder
|
||||
runDBJobs $ do
|
||||
qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
|
||||
qidsReuse <- selectList [QualificationLmsReuses ==. Just qid] []
|
||||
let qids = qid :| (entityKey <$> qidsReuse)
|
||||
qshs = qsh : (qualificationShorthand . entityVal <$> qidsReuse)
|
||||
enr <- try $ runConduit $ fileSource file
|
||||
.| lmsDecoder
|
||||
.| foldMC (saveReportCsv now qid) 0
|
||||
.| foldMC (saveReportCsv now qids) 0
|
||||
case enr of
|
||||
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
|
||||
$logWarnS "LMS" $ "Report upload failed parsing: " <> tshow e
|
||||
$logWarnS "LMS" $ "Report upload failed parsing: " <> tshow e <> " for Qualification: " <> Text.intercalate ", " (ciOriginal <$> qshs)
|
||||
logInterface "LMS" (ciOriginal qsh) False Nothing ""
|
||||
return (badRequest400, "Exception: " <> tshow e)
|
||||
Right nr -> do
|
||||
let msg = "Success. LMS Report upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> ". "
|
||||
let msg = "Success. LMS Report upload file " <> fileName file <> " containing " <> tshow nr <> " rows for " <> fhead <> " and Qualifications: " <> Text.intercalate ", " (ciOriginal <$> qshs)
|
||||
$logInfoS "LMS" msg
|
||||
when (nr > 0) $ queueDBJob $ JobLmsReports qid
|
||||
when (nr > 0) $ forM_ qids (queueDBJob . JobLmsReports)
|
||||
logInterface "LMS" (ciOriginal qsh) True (Just nr) ""
|
||||
return (ok200, msg)
|
||||
[] -> do
|
||||
|
||||
@ -106,6 +106,8 @@ mkQualificationAllTable isAdmin = do
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationElearningRenews)
|
||||
, sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
|
||||
$ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
|
||||
, sortable Nothing (i18nCell MsgTableQualificationLmsReuses & cellTooltip MsgTableQualificationLmsReusesTooltip)
|
||||
$ \(view (resultAllQualification . _qualificationLmsReuses) -> reuseQid) -> maybeCell reuseQid qualificationIdShortCell
|
||||
, sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)
|
||||
$ \(view (resultAllQualification . _qualificationAvsLicence) -> licence) -> maybeCell licence $ textCell . T.singleton . licence2char
|
||||
, sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip)
|
||||
@ -528,14 +530,15 @@ postQualificationR sid qsh = do
|
||||
msgUnexpire <- messageIconI Info IconWarning MsgQualificationActUnexpireWarning
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
|
||||
((lmsRes, qualificationTable), Entity qid quali, lmsQualiReused) <- runDB $ do
|
||||
qent@Entity{
|
||||
entityKey=qid
|
||||
, entityVal=Qualification{
|
||||
qualificationAuditDuration=auditMonths
|
||||
, qualificationValidDuration=validMonths
|
||||
, qualificationLmsReuses =reuseQuali
|
||||
}} <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
|
||||
lmsQualiReused <- traverseJoin get reuseQuali
|
||||
-- Block copied to Handler/Qualifications TODO: refactor
|
||||
let getBlockReasons unblk = Ex.select $ do
|
||||
(quser :& qblock) <- Ex.from $ Ex.table @QualificationUser
|
||||
@ -608,7 +611,7 @@ postQualificationR sid qsh = do
|
||||
]
|
||||
psValidator = def & defaultSorting [SortDescBy "last-refresh"]
|
||||
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
||||
return (tbl, qent)
|
||||
return (tbl, qent, lmsQualiReused)
|
||||
|
||||
formResult lmsRes $ \case
|
||||
(QualificationActRenewData renewReason, selectedUsers) | isAdmin -> do
|
||||
|
||||
@ -57,7 +57,7 @@ instance ToNamedRecord SapUserTableCsv where
|
||||
, "Ausprägung" Csv..= csvSUTausprägung
|
||||
]
|
||||
|
||||
-- | Removes all personalNummer which are not numbers between 10000 and 99999 (also excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
|
||||
-- | Removes all personalNummer which are not numbers between 10000 and 99999 (also excludes E-Accounts), which should not be returned by the query anyway (only qualifications with sap id and users with internal personnel number must be transmitted)
|
||||
-- temporary suspensions are transmitted to SAP in multiple rows: firstheld->suspension1, reinstate1->suspension2, reinstate2->validTo
|
||||
sapRes2csv :: [(E.Value (Maybe Text), E.Value (Maybe Text), E.Value Day, E.Value Day, E.Value (Maybe [Maybe Day]), E.Value (Maybe [Maybe Bool]))] -> [SapUserTableCsv]
|
||||
sapRes2csv = concatMap procRes
|
||||
|
||||
@ -378,6 +378,25 @@ companyIdCell cid = companyCell csh csh False
|
||||
where
|
||||
csh = unCompanyKey cid
|
||||
|
||||
-- | Uses DB Lookup to link to a qualification by id only, use sparingly!
|
||||
qualificationIdCell :: (IsDBTable m c) => QualificationId -> DBCell m c
|
||||
qualificationIdCell qid = anchorCellM' qual link name
|
||||
where
|
||||
qual = liftHandler $ runDBRead $ get qid
|
||||
link (Just Qualification{..}) = QualificationR qualificationSchool qualificationShorthand
|
||||
link Nothing = HelpR
|
||||
name Nothing = text2widget "Error: unknown QID"
|
||||
name (Just Qualification{..}) = citext2widget qualificationName
|
||||
|
||||
qualificationIdShortCell :: (IsDBTable m c) => QualificationId -> DBCell m c
|
||||
qualificationIdShortCell qid = anchorCellM' qual link name
|
||||
where
|
||||
qual = liftHandler $ runDBRead $ get qid
|
||||
link (Just Qualification{..}) = QualificationR qualificationSchool qualificationShorthand
|
||||
link Nothing = HelpR
|
||||
name Nothing = text2widget "Error: unknown QID"
|
||||
name (Just Qualification{..}) = citext2widget qualificationShorthand
|
||||
|
||||
qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
|
||||
qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
|
||||
where
|
||||
|
||||
@ -914,7 +914,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||
|
||||
-- Qualifications and ongoing LMS
|
||||
-- LmsUser: insertSelectWithConflict impossible due to 2 simultaneous uniqueness constraints; UniqueLmsIdent requires proper update, prohibits insert and then delete
|
||||
-- updateWhere [ LmsUserUser ==. oldUserId ] [ LmsUserUser =. newUserId ] -- might fail due to UniqueLmsQualficationUuser
|
||||
-- updateWhere [ LmsUserUser ==. oldUserId ] [ LmsUserUser =. newUserId ] -- might fail due to UniqueLmsQualificationUuser
|
||||
oldLms <- selectList [ LmsUserUser ==. oldUserId ] [ Asc LmsUserQualification ]
|
||||
newLms <- selectList [ LmsUserUser ==. newUserId ] [ Asc LmsUserQualification ]
|
||||
let projQ = lmsUserQualification . entityVal
|
||||
|
||||
@ -265,7 +265,7 @@ dispatchJobLmsReports :: QualificationId -> JobHandler UniWorX
|
||||
dispatchJobLmsReports qid = JobHandlerAtomic act
|
||||
where
|
||||
-- act :: YesodJobDB UniWorX ()
|
||||
act = whenM (exists [LmsReportQualification ==. qid]) $ do -- executing twice must be prohibited due to assertion that ALL learners are always sent (D fails otherwise)
|
||||
act = whenM (exists [LmsReportQualification ==. qid]) $ do -- executing twice must be prohibited due to assertion that ALL learners are always sent (E fails otherwise)
|
||||
now <- liftIO getCurrentTime
|
||||
-- DEBUG 2rows; remove later
|
||||
totalrows <- count [LmsReportQualification ==. qid]
|
||||
|
||||
@ -12,4 +12,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<p>
|
||||
FRADrive supports training courses by handling #
|
||||
registration, correspondence, course homepages, examinations and #
|
||||
managing the gained qualfications.
|
||||
managing the gained qualifications.
|
||||
|
||||
@ -17,7 +17,19 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
$maybe daudit <- qualificationAuditDuration quali
|
||||
<dt .deflist__dt>_{MsgQualificationAuditDuration}
|
||||
<dd .deflist__dd>_{MsgMonths (fromIntegral daudit)}
|
||||
<dd .deflist__dd>
|
||||
$maybe lqre <- lmsQualiReused
|
||||
$maybe daudit <- qualificationAuditDuration lqre
|
||||
_{MsgMonths (fromIntegral daudit)}
|
||||
$nothing
|
||||
_{MsgQualificationAuditDurationReuseError}
|
||||
$nothing
|
||||
_{MsgMonths (fromIntegral daudit)}
|
||||
$nothing
|
||||
$maybe lqre <- lmsQualiReused
|
||||
$maybe daudit <- qualificationAuditDuration lqre
|
||||
<dt .deflist__dt>_{MsgQualificationAuditDuration}
|
||||
<dd .deflist__dd>_{MsgMonths (fromIntegral daudit)}
|
||||
|
||||
$maybe drefresh <- qualificationRefreshWithin quali
|
||||
<dt .deflist__dt>_{MsgQualificationRefreshWithin} ^{iconTooltip (msg2widget MsgQualificationRefreshWithinTooltip) Nothing True}
|
||||
@ -43,6 +55,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
$if drd > 0
|
||||
_{MsgDays (fromIntegral drd)}
|
||||
|
||||
$maybe lqre <- lmsQualiReused
|
||||
<dt .deflist__dt>_{MsgTableQualificationLmsReusesTooltip}
|
||||
<dd .deflist__dd>^{simpleLink (citext2widget (qualificationName lqre)) (QualificationR (qualificationSchool lqre) (qualificationShorthand lqre))}
|
||||
|
||||
<dt .deflist__dt>_{MsgQualificationElearningStart}
|
||||
<dd .deflist__dd>#{boolSymbol (qualificationElearningStart quali)}
|
||||
$if (qualificationElearningStart quali) && isNothing (qualificationRefreshWithin quali)
|
||||
|
||||
@ -753,18 +753,20 @@ fillDb = do
|
||||
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
|
||||
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
|
||||
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False True Nothing Nothing
|
||||
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just 8) (Just $ CalendarDiffDays 0 60) (Just $ CalendarDiffDays 0 14) True True Nothing True (Just AvsLicenceVorfeld) $ Just "F4466"
|
||||
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 12) (Just 6) (Just $ CalendarDiffDays 2 3) Nothing False False Nothing False (Just AvsLicenceRollfeld) $ Just "R2801"
|
||||
qid_rp <- insert' $ Qualification avn "R+" "Rollfeldführerschein-Plus" r_descr (Just 12) (Just 4) (Just $ CalendarDiffDays 2 3) Nothing False False (Just qid_r) False (Just AvsLicenceRollfeld) $ Just "R2802"
|
||||
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just 6) Nothing Nothing True False Nothing True Nothing Nothing
|
||||
qfjost <- insert' $ QualificationUser jost qid_f (n_day 11) (n_day $ -1) (n_day $ -22) True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert $ QualificationUserBlock qfjost False (n_day' $ -6) "First block" (Just svaupel)
|
||||
void . insert $ QualificationUserBlock qfjost True (n_day' $ -5) "Second unblock" (Just gkleen)
|
||||
void . insert $ QualificationUserBlock qfjost False (n_day' $ -4) "Third block" Nothing
|
||||
void . insert $ QualificationUserBlock qfjost True (n_day' $ -3) "Fourth unblock" (Just sbarth)
|
||||
void . insert $ QualificationUserBlock qfjost False (n_day' $ -1) "Fifth block" (Just svaupel)
|
||||
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates!
|
||||
qfkleen <- insert' $ QualificationUser gkleen qid_f (n_day 33) (n_day $ -4) (n_day $ -20) True (n_day' $ -9)
|
||||
void . insert' $ QualificationUser jost qid_r (n_day 99) (n_day $ -11) (n_day $ -222) True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_l (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates!
|
||||
void . insert' $ QualificationUser jost qid_rp (n_day 999) (n_day $ -111) (n_day $ -2222) True (n_day' $ -9) -- TODO: better dates!
|
||||
qfkleen <- insert' $ QualificationUser gkleen qid_f (n_day 33) (n_day $ -4) (n_day $ -20) True (n_day' $ -9)
|
||||
void . insert $ QualificationUserBlock qfkleen False (n_day' 1) "Future block" (Just svaupel)
|
||||
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8) False (n_day' $ -1)
|
||||
qfvaupel <- insert' $ QualificationUser svaupel qid_f (n_day 2) (n_day $ -1) (n_day $ -2) True (n_day' $ -9)
|
||||
|
||||
Reference in New Issue
Block a user