chore(job): add sleep job for testing

also show running job workers

config/test-settings.yml

@@ -15,3 +15,5 @@ log-settings:
 
 auth-dummy-login: true
 server-session-acid-fallback: true
+
+job-workers: 20

src/Handler/Admin/Crontab.hs

@@ -196,6 +196,7 @@ postAdminJobsR = do
       (First (Just act), jobMap) <- inp
       let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
       return (act, jobSet)
+  void . queueJob' $ JobSleep 42 -- debug add sleep job
   (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)
 
   formResult jobActRes $ \case
@@ -218,11 +219,20 @@ postAdminJobsR = do
       addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
       reloadKeepGetParams AdminJobsR
 
+  -- gather some data on job worles
+  (nrWorkers, jobStateVar) <- getsYesod (view _appJobWorkers &&& appJobState)
+  jState <- atomically $ tryReadTMVar jobStateVar
+  let running = Map.size . jobWorkers <$> jState
 
   siteLayoutMsg MsgMenuAdminJobs $ do
     setTitleI MsgMenuAdminJobs
     [whamlet|
-      ^{jobsTable}
+      <section>
+        ^{jobsTable}
+      <section>
+        <ul>
+          <li> #{running} job workers currently running
+          <li> #{nrWorkers} job workers configured to run
     |]
   where
     doEnc :: ToJSON a => a -> _

src/Jobs/Handler/SendTestEmail.hs

@@ -4,6 +4,7 @@
 
 module Jobs.Handler.SendTestEmail
   ( dispatchJobSendTestEmail
+  , dispatchJobSleep
   ) where
 
 import Import
@@ -14,6 +15,8 @@ import Text.Hamlet
 -- import Handler.Utils.I18n
 -- import Text.Blaze.Internal
 
+import UnliftIO.Concurrent (threadDelay)
+
 dispatchJobSendTestEmail :: Email -> MailContext -> JobHandler UniWorX
 dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMailContext $ do
   _mailTo .= [Address Nothing jEmail]
@@ -61,3 +64,12 @@ dispatchJobSendTestEmail jEmail jMailContext = JobHandlerException . mailT jMail
   --
   --test2 <- liftHandler $(i18nHamletFile "test")
   --addHtmlMarkdownAlternatives test2
+
+
+dispatchJobSleep :: Int -> JobHandler UniWorX
+dispatchJobSleep sleepTime = JobHandlerAtomic act
+  where
+    act = do
+      $logInfoS "JOBS" [st|Sleep job #{sleepTime}s started.|]
+      threadDelay (sleepTime * 1000000)
+      $logInfoS "JOBS" [st|Sleep job #{sleepTime}s ended.|]

src/Jobs/Types.hs

@@ -141,8 +141,9 @@ data Job
   | JobLmsReports     { jQualification :: QualificationId }
   | JobPrintAck
   | JobPrintAckAgain
-
+  | JobSleep          { jSleep :: Int } -- dummy job that just sleeps to test job system
   deriving (Eq, Ord, Show, Read, Generic)
+
 data Notification
   = NotificationSubmissionRated { nSubmission :: SubmissionId }
   | NotificationSheetActive { nSheet :: SheetId }