Create scheduler thread

.gitignore

@@ -1,4 +1,5 @@
 .cabal-sandbox
 .stack-work
 cabal.sandbox.config
-dist-stack
+dist-stack
+stack.yaml.lock

CHANGELOG.md

@@ -1,3 +1,7 @@
+* 0.3.0 Remeike Forbes 2022-11-23
+
+  Introduce batched jobs
+
 * 0.2.0 Remeike Forbes
 
   Coerce jobs to string (to work with Redis 5)

example/src/Main.hs

@@ -1,37 +1,57 @@
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-import           Control.Concurrent      (forkIO, threadDelay)
-import           Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar)
-import           Control.Monad           (forever)
-import           Data.Aeson              (FromJSON, ToJSON)
-import qualified Data.Text               as T
-import           GHC.Generics            (Generic)
+
+
+--------------------------------------------------------------------------------
+import           Control.Concurrent       ( forkIO, threadDelay )
+import           Control.Concurrent.MVar  ( MVar, newMVar, putMVar, takeMVar )
+import           Control.Monad            ( forever )
+import           Data.Aeson               ( FromJSON, ToJSON )
+import           GHC.Generics             ( Generic )
+--------------------------------------------------------------------------------
 import           System.Hworker
+--------------------------------------------------------------------------------
+
+
+data PrintJob
+  = PrintA
+  | PrintB
+  deriving (Generic, Show)
+
+
+newtype State =
+  State (MVar Int)
+
 
-data PrintJob = PrintA | PrintB deriving (Generic, Show)
-data State = State (MVar Int)
 instance ToJSON PrintJob
 instance FromJSON PrintJob
 
-loopForever :: a
-loopForever = loopForever
 
 instance Job State PrintJob where
-  job (State mvar) PrintA =
-    do v <- takeMVar mvar
-       if v == 0
-          then do putMVar mvar 0
-                  putStrLn "A" >> return Success
-          else do putMVar mvar (v - 1)
-                  error $ "Dying: " ++ show v
-
-  job _ PrintB = putStrLn "B" >> return Success
-
-main = do mvar <- newMVar 3
-          hworker <- create "printer" (State mvar)
-          forkIO (worker hworker)
-          forkIO (monitor hworker)
-          forkIO (forever $ queue hworker PrintA >> threadDelay 1000000)
-          forkIO (forever $ queue hworker PrintB >> threadDelay 500000)
-          forever (threadDelay 1000000)
+  job hw PrintA =
+    let
+      State mvar = hworkerState hw
+    in do
+    v <- takeMVar mvar
+    if v == 0
+      then do
+        putMVar mvar 0
+        putStrLn "A" >> return Success
+      else do
+        putMVar mvar (v - 1)
+        error $ "Dying: " ++ show v
+
+  job _ PrintB =
+    putStrLn "B" >> return Success
+
+
+main :: IO ()
+main = do
+  mvar <- newMVar 3
+  hworker <- create "printer" (State mvar)
+  _ <- forkIO (worker hworker)
+  _ <- forkIO (monitor hworker)
+  _ <- forkIO (forever $ queue hworker PrintA >> threadDelay 1000000)
+  _ <- forkIO (forever $ queue hworker PrintB >> threadDelay 500000)
+  forever (threadDelay 1000000)

hworker.cabal

@@ -1,5 +1,5 @@
 name:                hworker
-version:             0.2.0
+version:             0.3.0
 synopsis:            A reliable at-least-once job queue built on top of redis.
 description:         See README.
 homepage:            http://github.com/positiondev/hworker
@@ -13,7 +13,6 @@ cabal-version:       >=1.10
 
 library
   exposed-modules:     System.Hworker
-  other-modules:       Data.Aeson.Helpers
   build-depends:       base >= 4.7 && < 5
                      , aeson
                      , hedis >= 0.6.5
@@ -22,16 +21,19 @@ library
                      , time >= 1.5
                      , attoparsec
                      , uuid >= 1.2.6
+                     , mtl
+                     , conduit
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
 
 Test-Suite hworker-test
-  type:            exitcode-stdio-1.0
-  hs-source-dirs:  src test
-  main-is:         Spec.hs
-  other-modules: Data.Aeson.Helpers
-               , System.Hworker
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src test
+  main-is:             Spec.hs
+  other-modules:       System.Hworker
+  ghc-options:         -Wall
+                       -fno-warn-unused-do-bind
   build-depends:       base >= 4.7 && < 5
                      , aeson
                      , hedis >= 0.6.5
@@ -43,3 +45,5 @@ Test-Suite hworker-test
                      , hspec >= 2
                      , hspec-contrib
                      , HUnit
+                     , mtl
+                     , conduit