From 904e3ee044879bc2f8fc2ab7e570cc9441225fc9 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 24 Mar 2022 16:16:24 +0100 Subject: [PATCH] chore(lms): create job for processing lms results --- models/lms.model | 2 +- src/Handler/LMS.hs | 18 +++++++++++---- src/Jobs.hs | 1 + src/Jobs/Handler/LMS.hs | 49 +++++++++++++++++++++++++++++++++++++++++ src/Jobs/Types.hs | 2 ++ 5 files changed, 67 insertions(+), 5 deletions(-) create mode 100644 src/Jobs/Handler/LMS.hs diff --git a/models/lms.model b/models/lms.model index da54d513f..c74b9d71f 100644 --- a/models/lms.model +++ b/models/lms.model @@ -94,7 +94,7 @@ LmsUser pin Text resetPin Bool default=false -- should pin be reset? success Bool Maybe -- open, success or failure; isJust indicates user will be deleted from LMS - -- success LmsStatus -- this would also encode Day information?! + -- success LmsStatus -- this would also encode Day information?! --toDelete encoded by Handler.Utils.LMS.lmsUserToDelete started UTCTime default=now() received UTCTime Maybe -- last acknowledgement by LMS diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 97485ff6b..e95a19ebe 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -54,16 +54,26 @@ mkLmsAllTable = do let resultDBTable = DBTable{..} where - dbtSQLQuery quali = do + dbtSQLQuery quali = do + -- 1. Just a constant dummy for debugging: -- let x = E.val (42::Word64) + -- return (quali, x) -- + -- 2. SubSelect with old syntax: -- x <- pure . E.subSelectCount . E.from $ \quser -> -- E.where_ $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId + -- return (quali, x) -- + -- 3. SubSelect with new syntax: x <- pure . Ex.subSelectCount $ do - quser <- Ex.from $ Ex.table @QualificationUser - Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId - return (quali, x) + quser <- Ex.from $ Ex.table @QualificationUser + Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId + return (quali, x) + -- + -- 4. Join / GroupBy + --Ex.on $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId + --Ex.groupBy (quali E.^. QualificationId) + --return (quali, count $ quser E.^. QualificationUserId) dbtRowKey = (E.^. QualificationId) dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? dbtColonnade = dbColonnade $ mconcat diff --git a/src/Jobs.hs b/src/Jobs.hs index 7fe2fcf9c..43395c8c7 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -74,6 +74,7 @@ import Jobs.Handler.Files import Jobs.Handler.PersonalisedSheetFiles import Jobs.Handler.PruneOldSentMails import Jobs.Handler.StudyFeatures +import Jobs.Handler.LMS import Jobs.HealthReport diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs new file mode 100644 index 000000000..a1291685f --- /dev/null +++ b/src/Jobs/Handler/LMS.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE TypeApplications #-} + +module Jobs.Handler.LMS + ( dispatchJobLmsResults + , dispatchJobLmsUserlist + ) where + +import Import + +-- import Jobs.Handler.Intervals.Utils +import qualified Database.Esqueleto.Experimental as E +--import qualified Database.Esqueleto.Legacy as E +import qualified Database.Esqueleto.PostgreSQL as E +import qualified Database.Esqueleto.Utils as E + + +dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX +dispatchJobLmsResults qid = JobHandlerAtomic act + where + -- act :: YesodJobDB UniWorX () + act = hoist lift $ do + _now <- liftIO getCurrentTime + E.insertSelectWithConflict + (UniqueLmsUser $ error "insertSelectWithConflict inspected constraint") -- never executed, just a type hint + (do + (luser E.:& lresult) <- + E.from $ E.table @LmsUser `E.innerJoin` E.table @LmsResult `E.on` (\(luser E.:& lresult) -> luser E.^. LmsUserIdent E.==. lresult E.^. LmsResultIdent + E.&&. luser E.^. LmsUserQualification E.==. lresult E.^. LmsResultQualification + ) + E.where_ $ lresult E.^. LmsResultQualification E.==. E.val qid + return $ LmsUser E.<# E.val qid + E.<&> (luser E.^. LmsUserUser) + E.<&> (luser E.^. LmsUserIdent) + E.<&> (luser E.^. LmsUserPin) + E.<&> (luser E.^. LmsUserResetPin) + E.<&> E.justVal True -- how to convert Day to LmsStatus here? + E.<&> (luser E.^. LmsUserStarted) + E.<&> E.just (lresult E.^. LmsResultTimestamp) + E.<&> (luser E.^. LmsUserEnded) + ) + (\current _excluded -> + [ LmsUserSuccess E.=. E.justVal True, LmsUserReceived E.=. current E.^. LmsUserReceived ] -- I believe this list could just be empty, since excluded is not uses?! + ) + -- Unclear how to delete here + return () + + +dispatchJobLmsUserlist :: QualificationId -> JobHandler UniWorX +dispatchJobLmsUserlist _qid = JobHandlerAtomic $ return () \ No newline at end of file diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 94afb6b53..315f5f82d 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -105,6 +105,8 @@ data Job , jEpoch , jIteration :: Natural } + | JobLmsUserlist { jQualification :: QualificationId } + | JobLmsResults { jQualification :: QualificationId } deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }