refactor(lms): clean lms handling code
This commit is contained in:
parent
ae4470333e
commit
cdb23115ef
@ -741,7 +741,7 @@ postLmsR sid qsh = do
|
||||
forM_ shortUsers $ upsertQualificationUser qid nowaday cutoff Nothing
|
||||
|
||||
fromIntegral <$> (if isReset
|
||||
then updateWhereCount ([LmsUserQualification ==. qid, LmsUserUser <-. usersList, LmsUserResetTries ==. False] -- , LmsUserLocked ==. True] -- needs to be locked for reset, but this is counter-intuitive for users; should be harmles, but delays reset until lock is effective
|
||||
then updateWhereCount ([LmsUserQualification ==. qid, LmsUserUser <-. usersList, LmsUserResetTries ==. False, LmsUserEnded ==. Nothing] -- , LmsUserLocked ==. True] -- needs to be locked for reset, but this is counter-intuitive for users; should be harmles, but delays reset until lock is effective
|
||||
++ ([LmsUserStatus ==. Just LmsBlocked] ||. [LmsUserStatus ==. Just LmsExpired])) [LmsUserResetTries =. True]
|
||||
else deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList]
|
||||
)
|
||||
@ -768,7 +768,7 @@ postLmsR sid qsh = do
|
||||
numExaminees <- runDB $ do
|
||||
okUsers <- selectList [ LmsUserQualification ==. qid -- matching qualification
|
||||
, LmsUserEnded ==. Nothing -- not yet deleted
|
||||
, LmsUserStatus ==. Nothing -- not yet decided
|
||||
-- , LmsUserStatus ==. Nothing -- not yet decided
|
||||
, LmsUserUser <-. Set.toList selectedUsers -- selected
|
||||
] []
|
||||
forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do
|
||||
|
||||
@ -204,7 +204,7 @@ getLmsLearnersDirectR sid qsh = do
|
||||
csvOpts = def { csvFormat = fmtOpts }
|
||||
csvSheetName <- csvFilenameLmsUser qsh
|
||||
let nr = length lms_users
|
||||
msg = "Success. LMS Users download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"
|
||||
msg = "Success. LMS user learners download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"
|
||||
$logInfoS "LMS" msg
|
||||
addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
|
||||
csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered
|
||||
|
||||
@ -263,7 +263,7 @@ qualificationUserBlocking qid uids unblock mbBlockTime (qualificationBlockReason
|
||||
, qualificationUserBlockBlocker = authUsr
|
||||
})) toChange
|
||||
E.insertMany_ (snd <$> newBlocks)
|
||||
unless notify $ updateWhere [QualificationUserId <-. (qualificationUserBlockQualificationUser . snd <$> newBlocks)] [QualificationUserLastNotified =. now]
|
||||
unless notify $ updateWhere [QualificationUserId <-. (qualificationUserBlockQualificationUser . snd <$> newBlocks)] [QualificationUserLastNotified =. addUTCTime 1 blockTime]
|
||||
forM_ newBlocks $ \(uid, qub) -> audit TransactionQualificationUserBlocking
|
||||
{ transactionQualification = qid
|
||||
, transactionUser = uid
|
||||
|
||||
@ -196,7 +196,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
|
||||
E.&&. luser E.^. LmsUserQualification E.==. E.val qid
|
||||
E.&&. E.isNothing (luser E.^. LmsUserStatus)
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded)
|
||||
-- E.&&. E.isNothing (luser E.^. LmsUserEnded)
|
||||
E.&&. E.not_ (validQualification now quser)
|
||||
pure (luser E.^. LmsUserId)
|
||||
nrExpired <- E.updateCount $ \luser -> do
|
||||
@ -205,7 +205,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
|
||||
E.&&. luser E.^. LmsUserQualification E.==. E.val qid
|
||||
$logInfoS "LMS" $ "Expired lms users " <> tshow nrExpired <> " for qualification " <> qshort
|
||||
|
||||
when (quali ^. _qualificationExpiryNotification) $ do
|
||||
when (quali ^. _qualificationExpiryNotification) $ do -- notifies expired and previously lms-failed drivers
|
||||
notifyInvalidDrivers <- E.select $ do
|
||||
quser <- E.from $ E.table @QualificationUser
|
||||
E.where_ $ E.not_ (validQualification now quser) -- currently invalid
|
||||
@ -254,119 +254,121 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
|
||||
act = whenM (exists [LmsReportQualification ==. qid]) $ do -- executing twice must be prohibited due to assertion that ALL learners are always sent (D fails otherwise)
|
||||
now <- liftIO getCurrentTime
|
||||
-- DEBUG 2rows; remove later
|
||||
totalrows <- count [LmsReportQualification ==. qid]
|
||||
totalrows <- count [LmsReportQualification ==. qid]
|
||||
$logInfoS "LMS" $ "Report processing " <> tshow totalrows <> " rows for qualification " <> tshow qid
|
||||
let -- locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now -- no longer necessary, since LMS reports dates only
|
||||
-- DB query for LmsUserUser, provided a matching LmsReport exists
|
||||
luserQry luFltr repFltr = E.select $ do
|
||||
luser <- E.from $ E.table @LmsUser
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners
|
||||
E.&&. luFltr luser
|
||||
E.&&. E.exists (do
|
||||
when (totalrows > 0) $ do
|
||||
let -- locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now -- no longer necessary, since LMS reports dates only
|
||||
-- DB query for LmsUserUser, provided a matching LmsReport exists
|
||||
luserQry luFltr repFltr = E.select $ do
|
||||
luser <- E.from $ E.table @LmsUser
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners
|
||||
E.&&. luFltr luser
|
||||
E.&&. E.exists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. repFltr luser lreport
|
||||
)
|
||||
return $ luser E.^. LmsUserUser
|
||||
-- DB query for LmsUser innerJoin LmsReport
|
||||
lrepQry lrFltr = E.select $ do
|
||||
(luser :& lreport) <- E.from $ E.table @LmsUser`E.innerJoin` E.table @LmsReport
|
||||
`E.on` (\(luser :& lreport) -> luser E.^. LmsUserIdent E.==. lreport E.^. LmsReportIdent
|
||||
E.&&. luser E.^. LmsUserQualification E.==. lreport E.^. LmsReportQualification)
|
||||
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners
|
||||
E.&&. lrFltr luser lreport
|
||||
return (luser, lreport)
|
||||
-- A) reset status for learners that had their tries just resetted as indicated by LmsOpen
|
||||
E.update $ \luser -> do
|
||||
E.set luser [ LmsUserStatus E.=. E.nothing
|
||||
, LmsUserStatusDay E.=. E.nothing
|
||||
, LmsUserResetTries E.=. E.false ]
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded ) -- must still exist at server
|
||||
E.&&. E.isJust (luser E.^. LmsUserReceived) -- seen before, for otherwise it might not have been started yet
|
||||
E.&&. luser E.^. LmsUserResetTries
|
||||
E.&&. E.exists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. repFltr luser lreport
|
||||
)
|
||||
return $ luser E.^. LmsUserUser
|
||||
-- DB query for LmsUser innerJoin LmsReport
|
||||
lrepQry lrFltr = E.select $ do
|
||||
(luser :& lreport) <- E.from $ E.table @LmsUser`E.innerJoin` E.table @LmsReport
|
||||
`E.on` (\(luser :& lreport) -> luser E.^. LmsUserIdent E.==. lreport E.^. LmsReportIdent
|
||||
E.&&. luser E.^. LmsUserQualification E.==. lreport E.^. LmsReportQualification)
|
||||
E.where_ $ luser E.^. LmsUserQualification E.==. E.val qid
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded) -- ignore all closed learners
|
||||
E.&&. lrFltr luser lreport
|
||||
return (luser, lreport)
|
||||
-- A) reset status for learners that had their tries just resetted as indicated by LmsOpen
|
||||
E.update $ \luser -> do
|
||||
E.set luser [ LmsUserStatus E.=. E.nothing
|
||||
, LmsUserResetTries E.=. E.false ]
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded ) -- must still exist at server
|
||||
E.&&. E.isJust (luser E.^. LmsUserReceived) -- seen before, for otherwise it might not have been started yet
|
||||
E.&&. luser E.^. LmsUserResetTries
|
||||
E.&&. E.exists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. lreport E.^. LmsReportResult E.==. E.val LmsOpen
|
||||
E.&&. lreport E.^. LmsReportLock E.==. E.true
|
||||
)
|
||||
-- B) notify all newly reported users that lms is available
|
||||
let luserFltrNew luser = E.isNothing $ luser E.^. LmsUserReceived -- not seen before, just starting
|
||||
notifyNewLearner (E.Value uid) = queueDBJob JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } }
|
||||
in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner
|
||||
-- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit)
|
||||
let lrFltrBlock luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsFailed
|
||||
procBlock (Entity luid luser, Entity _ lreport) = do
|
||||
let repDay = lmsReportDate lreport <|> Just now
|
||||
ok_block <- qualificationUserBlocking qid [lmsUserUser luser] False (lmsReportDate lreport) (Right QualificationBlockFailedELearning) True -- only valid qualifications are blocked; transcribes to audit log
|
||||
update luid [LmsUserStatus =. Just LmsBlocked, LmsUserStatusDay =. repDay]
|
||||
return $ Sum ok_block
|
||||
in lrepQry lrFltrBlock
|
||||
>>= foldMapM procBlock
|
||||
>>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " status set to blocked for qualification " <> tshow qid -- debug, remove later
|
||||
-- D) renew qualifications for all successfull learners
|
||||
let lrFltrSuccess luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsPassed
|
||||
procRenew (Entity luid luser, Entity _ lreport) = do
|
||||
let repDay = lmsReportDate lreport <|> Just now
|
||||
-- LMS WORKAROUND 2: [supposedly fixed now] sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
|
||||
-- let reason_undo = Left $ "LMS Workaround undoing: " <> qualificationBlockedReasonText QualificationBlockFailedELearning
|
||||
-- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
|
||||
-- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
|
||||
-- END LMS WORKAROUND 2
|
||||
ok_renew <- renewValidQualificationUsers qid repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
|
||||
update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
|
||||
return $ Sum ok_renew
|
||||
in lrepQry lrFltrSuccess
|
||||
>>= foldMapM procRenew
|
||||
>>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " renewed and status set to success for qualification " <> tshow qid -- debug, remove later
|
||||
-- E) mark all previuosly reported, but now unreported users as ended (LMS deleted them as expected)
|
||||
E.update $ \luser -> do
|
||||
E.set luser [ LmsUserEnded E.=. E.justVal now ]
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded )
|
||||
E.&&. E.isJust (luser E.^. LmsUserStatus ) -- status is decided
|
||||
E.&&. E.isJust (luser E.^. LmsUserReceived) -- seen before, for otherwise it might not have been started yet
|
||||
E.&&. E.notExists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
)
|
||||
|
||||
-- F) lock expired learners: happens during JobLmsDequeue only
|
||||
-- G) update lock and received
|
||||
let updateReceivedLocked lockstatus = E.updateCount $ \luser -> do -- due to the absence of UPDATE..FROM in esqueleto, we call update twice
|
||||
E.set luser [ LmsUserReceived E.=. E.justVal now
|
||||
, LmsUserLocked E.=. E.val lockstatus ]
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded)
|
||||
E.&&. E.exists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. lreport E.^. LmsReportLock E.==. E.val lockstatus -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock)
|
||||
E.&&. lreport E.^. LmsReportResult E.==. E.val LmsOpen
|
||||
E.&&. lreport E.^. LmsReportLock E.==. E.true
|
||||
)
|
||||
-- NOTE: this code leads to a runtime errror; apparently from-clauses are not allowed in updates yet
|
||||
-- let updateReceivedLocked lockstatus = E.update $ \luser -> do -- attempt to use 'from'-clause in update as per PostgreSQL
|
||||
-- E.set luser [ LmsUserReceived E.=. E.justVal now
|
||||
-- , LmsUserLocked E.=. E.val lockstatus ]
|
||||
-- lreport <- E.from $ E.table @LmsReport
|
||||
-- E.where_ $ E.isNothing (luser E.^. LmsUserEnded)
|
||||
-- E.&&. luser E.^. LmsUserQualification E.==. E.val qid
|
||||
-- E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
-- E.&&. lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
-- E.&&. lreport E.^. LmsReportLock E.==. E.val lockstatus -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock)
|
||||
updateReceivedLocked False
|
||||
>>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as unlocked and received for qualification " <> tshow qid -- debug, remove later
|
||||
updateReceivedLocked True
|
||||
>>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as locked and received for qualification " <> tshow qid -- debug, remove later
|
||||
-- G) Truncate LmsReport for qid and log
|
||||
repProc <- deleteWhereCount [LmsReportQualification ==. qid]
|
||||
$logInfoS "LMS" [st|Processed #{tshow repProc} e-learning status reports for qualification #{tshow qid}.|]
|
||||
-- B) notify all newly reported users that lms is available
|
||||
let luserFltrNew luser = E.isNothing $ luser E.^. LmsUserReceived -- not seen before, just starting
|
||||
notifyNewLearner (E.Value uid) = queueDBJob JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } }
|
||||
in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner
|
||||
-- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit), notified during expiry
|
||||
let lrFltrBlock luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsFailed
|
||||
procBlock (Entity luid luser, Entity _ lreport) = do
|
||||
let repDay = lmsReportDate lreport <|> Just now
|
||||
ok_block <- qualificationUserBlocking qid [lmsUserUser luser] False (lmsReportDate lreport) (Right QualificationBlockFailedELearning) True -- only valid qualifications are blocked; transcribes to audit log
|
||||
update luid [LmsUserStatus =. Just LmsBlocked, LmsUserStatusDay =. repDay]
|
||||
return $ Sum ok_block
|
||||
in lrepQry lrFltrBlock
|
||||
>>= foldMapM procBlock
|
||||
>>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " status set to blocked for qualification " <> tshow qid -- debug, remove later
|
||||
-- D) renew qualifications for all successfull learners
|
||||
let lrFltrSuccess luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsPassed
|
||||
procRenew (Entity luid luser, Entity _ lreport) = do
|
||||
let repDay = lmsReportDate lreport <|> Just now
|
||||
-- LMS WORKAROUND 2: [supposedly fixed now] sometimes we receive success and failure simultaneously; success is correct, hence we must unblock if the reason was e-learning
|
||||
-- let reason_undo = Left $ "LMS Workaround undoing: " <> qualificationBlockedReasonText QualificationBlockFailedELearning
|
||||
-- ok_unblock <- qualificationUserUnblockByReason qid [lmsUserUser luser] repTime (Right QualificationBlockFailedELearning) reason_undo False -- affects audit log
|
||||
-- when (ok_unblock > 0) ($logWarnS "LMS" [st|LMS Result: workaround triggered, unblocking #{tshow ok_unblock} e-learners for #{tshow qid} having success reported after initially failed e-learning|])
|
||||
-- END LMS WORKAROUND 2
|
||||
ok_renew <- renewValidQualificationUsers qid repDay [lmsUserUser luser]-- only valid qualifications are truly renewed; transcribes to audit log
|
||||
update luid [LmsUserStatus =. Just LmsSuccess, LmsUserStatusDay =. repDay]
|
||||
return $ Sum ok_renew
|
||||
in lrepQry lrFltrSuccess
|
||||
>>= foldMapM procRenew
|
||||
>>= \s -> $logInfoS "LMS" $ "Report processing: " <> tshow (getSum s) <> " renewed and status set to success for qualification " <> tshow qid -- debug, remove later
|
||||
-- E) mark all previuosly reported, but now unreported users as ended (LMS deleted them as expected)
|
||||
E.update $ \luser -> do
|
||||
E.set luser [ LmsUserEnded E.=. E.justVal now ]
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
E.&&. E.isNothing (luser E.^. LmsUserEnded )
|
||||
E.&&. E.isJust (luser E.^. LmsUserStatus ) -- status is decided
|
||||
E.&&. E.isJust (luser E.^. LmsUserReceived) -- seen before, for otherwise it might not have been started yet
|
||||
E.&&. E.notExists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
)
|
||||
|
||||
-- F) lock expired learners: happens during JobLmsDequeue only
|
||||
-- G) update lock and received
|
||||
let updateReceivedLocked lockstatus = E.updateCount $ \luser -> do -- due to the absence of UPDATE..FROM in esqueleto, we call update twice
|
||||
E.set luser [ LmsUserReceived E.=. E.justVal now
|
||||
, LmsUserLocked E.=. E.val lockstatus ]
|
||||
E.where_ $ E.val qid E.==. luser E.^. LmsUserQualification
|
||||
-- E.&&. E.isNothing (luser E.^. LmsUserEnded) -- should always be true, but maybe there is a bug?
|
||||
E.&&. E.exists (do
|
||||
lreport <- E.from $ E.table @LmsReport
|
||||
E.where_ $ lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
E.&&. lreport E.^. LmsReportLock E.==. E.val lockstatus -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock)
|
||||
)
|
||||
-- NOTE: this code leads to a runtime errror; apparently from-clauses are not allowed in updates yet
|
||||
-- let updateReceivedLocked lockstatus = E.update $ \luser -> do -- attempt to use 'from'-clause in update as per PostgreSQL
|
||||
-- E.set luser [ LmsUserReceived E.=. E.justVal now
|
||||
-- , LmsUserLocked E.=. E.val lockstatus ]
|
||||
-- lreport <- E.from $ E.table @LmsReport
|
||||
-- E.where_ $ E.isNothing (luser E.^. LmsUserEnded)
|
||||
-- E.&&. luser E.^. LmsUserQualification E.==. E.val qid
|
||||
-- E.&&. lreport E.^. LmsReportQualification E.==. E.val qid
|
||||
-- E.&&. lreport E.^. LmsReportIdent E.==. luser E.^. LmsUserIdent
|
||||
-- E.&&. lreport E.^. LmsReportLock E.==. E.val lockstatus -- Maybe more efficient, but less readable: bool E.not_ id lockstatus (lreport E.^. LmsReport Lock)
|
||||
updateReceivedLocked False
|
||||
>>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as unlocked and received for qualification " <> tshow qid -- debug, remove later
|
||||
updateReceivedLocked True
|
||||
>>= \nr -> $logInfoS "LMS" $ "Report processing marked " <> tshow nr <> " rows as locked and received for qualification " <> tshow qid -- debug, remove later
|
||||
-- G) Truncate LmsReport for qid and log
|
||||
repProc <- deleteWhereCount [LmsReportQualification ==. qid]
|
||||
$logInfoS "LMS" [st|Processed #{tshow repProc} e-learning status reports for qualification #{tshow qid}.|]
|
||||
|
||||
|
||||
-- DEPRECATED processes received results and lengthen qualifications, if applicable
|
||||
|
||||
Loading…
Reference in New Issue
Block a user