chore(lms): create job for processing lms results

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 

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
+                quser <- Ex.from $ Ex.table @QualificationUser
-                  Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId                  
+                Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId                  
-          return (quali, x)
+          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

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
 

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 ()

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 }