{-# LANGUAGE OverloadedStrings #-}

-- | Configuration types for the arbiter worker pool.
module Arbiter.Worker.Config
  ( -- * Worker Configuration
    WorkerConfig (..)
  , defaultWorkerConfig
  , defaultBatchedWorkerConfig
  , defaultRollupWorkerConfig
  , singleJobMode
  , mergedRollupHandler
  , mergeChildResults
  , HandlerMode (..)
  , LivenessConfig (..)

    -- * Worker State
  , WorkerState (..)
  , pauseWorker
  , resumeWorker
  , shutdownWorker
  , getWorkerState
  ) where

import Arbiter.Core.Job.Types (ObservabilityHooks, defaultObservabilityHooks)
import Arbiter.Core.MonadArbiter (BatchedJobHandler, JobHandler, MonadArbiter)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import Data.Foldable (fold)
import Data.Int (Int32, Int64)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Data.Time (NominalDiffTime)
import Data.UUID (toString)
import Data.UUID.V4 qualified as UUID
import System.Directory (getTemporaryDirectory)
import UnliftIO.MVar (MVar, newEmptyMVar)
import UnliftIO.STM (TVar, newTVarIO)
import UnliftIO.STM qualified as STM

import Arbiter.Worker.BackoffStrategy (BackoffStrategy, Jitter (..), exponentialBackoff)
import Arbiter.Worker.Cron (CronJob)
import Arbiter.Worker.Logger (LogConfig (..), defaultLogConfig)
import Arbiter.Worker.WorkerState (WorkerState (..))

-- | Handler mode determines both the handler type and claiming strategy.
--
-- __Single vs Batched Mode__
--
-- * __Single__: Processes one job at a time. Failures are independent. Handler receives @JobRead payload@.
--
-- * __Batched__: Claims and processes multiple jobs from the same group together.
--   All-or-nothing: if any job in batch fails, entire batch rolls back (automatic mode)
--   or is retried together. Uses minimum maxAttempts across batch.
--   Handler receives @NonEmpty (JobRead payload)@.
data HandlerMode m payload result
  = -- | Single job mode: claim 1 job per group, handler processes one at a time.
    --
    -- The handler receives:
    --
    -- 1. @Map childJobId (Either errorMsg result)@ — child results for rollup
    --    finalizers, empty for regular\/child jobs. @Left@ entries represent
    --    DLQ'd children or result decode failures.
    -- 2. @Map dlqPrimaryKey errorMsg@ — DLQ'd child failures, keyed by DLQ
    --    primary key (actionable with 'deleteDLQJob'). Empty for non-rollup jobs.
    SingleJobMode (Map Int64 (Either Text result) -> Map Int64 Text -> JobHandler m payload result)
  | -- | Batched mode: claim up to N jobs per group, handler receives batch.
    --
    -- __Rollup interaction:__ Batched mode has no rollup awareness — child results
    -- are not passed to the handler. Use 'SingleJobMode' for rollup finalizers.
    BatchedJobsMode Int (BatchedJobHandler m payload result)

-- | File-based liveness probe configuration.
--
-- The probe file is touched when the dispatcher claims jobs or the heartbeat
-- extends visibility, proving the worker is actively functioning. A timeout
-- fallback ensures the probe still updates during idle periods (no jobs to
-- process). If the file goes stale, the worker should be restarted.
data LivenessConfig = LivenessConfig
  { LivenessConfig -> FilePath
livenessPath :: FilePath
  -- ^ Path to the health check file
  , LivenessConfig -> MVar ()
livenessSignal :: MVar ()
  -- ^ MVar pulsed by the dispatcher after each claim cycle and by the
  -- heartbeat after each successful visibility extension
  , LivenessConfig -> Int
livenessInterval :: Int
  -- ^ Seconds between health file writes
  }

-- | Configuration for a worker pool.
--
-- __Time units:__ All time-related fields use 'NominalDiffTime' (seconds).
-- Sub-second precision is supported (e.g., @0.1@ for 100ms).
data WorkerConfig m payload result = WorkerConfig
  { forall (m :: * -> *) payload result.
WorkerConfig m payload result -> ByteString
connStr :: ByteString
  -- ^ PostgreSQL connection string (used for LISTEN/NOTIFY).
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Int
workerCount :: Int
  -- ^ Number of concurrent worker threads.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> HandlerMode m payload result
handlerMode :: HandlerMode m payload result
  -- ^ Job handler and claiming strategy (single or batched). Default: 'SingleJobMode'.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> NominalDiffTime
pollInterval :: NominalDiffTime
  -- ^ Polling interval in __seconds__ (fallback when no NOTIFY received).
  -- Also serves as the liveness heartbeat — the dispatcher signals the
  -- liveness probe after each poll cycle. Default: 5 seconds.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> NominalDiffTime
visibilityTimeout :: NominalDiffTime
  -- ^ Duration in __seconds__ a claimed job stays invisible to other workers.
  -- Must be greater than 'heartbeatInterval'. Sub-second values are
  -- rounded up to the nearest second. Default: 60.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Int
heartbeatInterval :: Int
  -- ^ Interval in __seconds__ for extending visibility timeout during processing.
  -- Must be less than 'visibilityTimeout' to prevent job reclaim. Default: 30.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Int32
maxAttempts :: Int32
  -- ^ Max retries before moving to DLQ (used when job's maxAttempts is Nothing).
  -- Default: 10.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> BackoffStrategy
backoffStrategy :: BackoffStrategy
  -- ^ Retry backoff strategy. Default: exponential with base 2, max 1048576 seconds.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Jitter
jitter :: Jitter
  -- ^ Jitter strategy for retry delays. Default: 'EqualJitter'.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Bool
useWorkerTransaction :: Bool
  -- ^ __Transaction Mode:__
  --
  -- * __True (Automatic)__: Handler runs in a transaction with automatic
  -- acking and rollback. Heartbeat prevents job reclaim during processing.
  -- Cannot control commit timing. If the ack fails then all database work is
  -- rolled back — this means 'BatchedJobsMode' can have a large blast radius
  -- because the batch is acked atomically. Default: True.
  --
  -- * __False (Manual)__: Full transaction control. Handler must explicitly ack jobs.
  -- Child results are __not__ automatically stored in the results table —
  -- the handler must call 'Arbiter.Core.HighLevel.insertResult' to make
  -- results visible to the rollup finalizer.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Maybe NominalDiffTime
transactionTimeout :: Maybe NominalDiffTime
  -- ^ Transaction statement timeout in __seconds__. Only applies when
  -- useWorkerTransaction is True. Default: Nothing (no timeout).
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> ObservabilityHooks m payload
observabilityHooks :: ObservabilityHooks m payload
  -- ^ Callbacks for metrics or tracing. Default: no-op hooks.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar :: TVar WorkerState
  -- ^ Worker state (Running, Paused, ShuttingDown). Managed internally.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Maybe LivenessConfig
livenessConfig :: Maybe LivenessConfig
  -- ^ File-based liveness probe configuration. Default: writes to
  -- @\/tmp\/arbiter-worker-\<uuid\>@ every 60 seconds.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Maybe NominalDiffTime
gracefulShutdownTimeout :: Maybe NominalDiffTime
  -- ^ Maximum time in __seconds__ to wait for in-flight jobs during graceful
  -- shutdown. If @Nothing@, waits indefinitely. If @Just n@, force-exits after
  -- n seconds. Default: @Just 30@.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> LogConfig
logConfig :: LogConfig
  -- ^ Logging configuration. Arbiter outputs structured JSON logs with job
  -- context automatically included. Use this to control log level, destination,
  -- and inject additional context (e.g., trace IDs). Default: Info level to stdout.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> Maybe (IO (Int, NominalDiffTime))
claimThrottle :: Maybe (IO (Int, NominalDiffTime))
  -- ^ Optional claim rate limiter. The @IO@ action returns
  -- @(maxClaims, window)@: at most @maxClaims@ jobs will be claimed
  -- per @window@ duration. The action is called each claim cycle, so
  -- limits can be adjusted dynamically.
  -- Default: @Nothing@ (no throttling).
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> [CronJob payload]
cronJobs :: [CronJob payload]
  -- ^ Cron schedules. When non-empty, the worker pool spawns a scheduler
  -- thread that opens a dedicated connection from 'connStr' and inserts
  -- jobs based on cron expressions. The @cron_schedules@ table is consulted
  -- for runtime overrides (expression, overlap, enabled). Default: @[]@.
  , forall (m :: * -> *) payload result.
WorkerConfig m payload result -> NominalDiffTime
groupReaperInterval :: NominalDiffTime
  -- ^ How often to recompute the groups table (correct drift in
  -- job_count, min_priority, min_id, in_flight_until).
  -- Default: @300@ (5 minutes).
  }

-- | Creates a t'WorkerConfig' with default settings.
defaultWorkerConfig
  :: (MonadArbiter n, MonadIO m)
  => ByteString
  -- ^ Connection string
  -> Int
  -- ^ Worker count
  -> JobHandler n payload result
  -> m (WorkerConfig n payload result)
defaultWorkerConfig :: forall (n :: * -> *) (m :: * -> *) payload result.
(MonadArbiter n, MonadIO m) =>
ByteString
-> Int
-> JobHandler n payload result
-> m (WorkerConfig n payload result)
defaultWorkerConfig ByteString
connStrVal Int
workerCnt JobHandler n payload result
handler =
  ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
forall (n :: * -> *) (m :: * -> *) payload result.
(Applicative n, MonadIO m) =>
ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
mkDefaultConfig ByteString
connStrVal Int
workerCnt (JobHandler n payload result -> HandlerMode n payload result
forall (m :: * -> *) payload result.
JobHandler m payload result -> HandlerMode m payload result
singleJobMode JobHandler n payload result
handler)

-- | Creates a t'WorkerConfig' for batched job processing.
--
-- Like 'defaultWorkerConfig' but for handlers that process multiple jobs at once.
defaultBatchedWorkerConfig
  :: (MonadArbiter n, MonadIO m)
  => ByteString
  -- ^ Connection string
  -> Int
  -- ^ Worker count
  -> Int
  -- ^ Batch size (max jobs per group to claim together)
  -> BatchedJobHandler n payload result
  -> m (WorkerConfig n payload result)
defaultBatchedWorkerConfig :: forall (n :: * -> *) (m :: * -> *) payload result.
(MonadArbiter n, MonadIO m) =>
ByteString
-> Int
-> Int
-> BatchedJobHandler n payload result
-> m (WorkerConfig n payload result)
defaultBatchedWorkerConfig ByteString
connStrVal Int
workerCnt Int
batchSize BatchedJobHandler n payload result
handler =
  ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
forall (n :: * -> *) (m :: * -> *) payload result.
(Applicative n, MonadIO m) =>
ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
mkDefaultConfig ByteString
connStrVal Int
workerCnt (Int
-> BatchedJobHandler n payload result
-> HandlerMode n payload result
forall (m :: * -> *) payload result.
Int
-> BatchedJobHandler m payload result
-> HandlerMode m payload result
BatchedJobsMode Int
batchSize BatchedJobHandler n payload result
handler)

-- | Creates a t'WorkerConfig' for rollup-aware job processing.
--
-- The handler receives:
--
-- 1. The monoidal merge of all successful child results (DLQ'd children
--    and decode failures contribute 'mempty').
-- 2. A @'Map' dlqPrimaryKey errorMessage@ of failed children, actionable
--    with 'Arbiter.Core.HighLevel.deleteDLQJob'.
--
-- Use 'SingleJobMode' directly for per-child result visibility.
defaultRollupWorkerConfig
  :: (MonadArbiter n, MonadIO m, Monoid result)
  => ByteString
  -- ^ Connection string
  -> Int
  -- ^ Worker count
  -> (result -> Map Int64 Text -> JobHandler n payload result)
  -> m (WorkerConfig n payload result)
defaultRollupWorkerConfig :: forall (n :: * -> *) (m :: * -> *) result payload.
(MonadArbiter n, MonadIO m, Monoid result) =>
ByteString
-> Int
-> (result -> Map Int64 Text -> JobHandler n payload result)
-> m (WorkerConfig n payload result)
defaultRollupWorkerConfig ByteString
connStrVal Int
workerCnt result -> Map Int64 Text -> JobHandler n payload result
handler =
  ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
forall (n :: * -> *) (m :: * -> *) payload result.
(Applicative n, MonadIO m) =>
ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
mkDefaultConfig ByteString
connStrVal Int
workerCnt ((result -> Map Int64 Text -> JobHandler n payload result)
-> HandlerMode n payload result
forall result (m :: * -> *) payload.
Monoid result =>
(result -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
mergedRollupHandler result -> Map Int64 Text -> JobHandler n payload result
handler)

-- | Wrap a simple handler that ignores child results.
--
-- Use this when your handler doesn't need rollup support:
--
-- @
-- singleJobMode (\\conn job -> pure ())
-- @
singleJobMode :: JobHandler m payload result -> HandlerMode m payload result
singleJobMode :: forall (m :: * -> *) payload result.
JobHandler m payload result -> HandlerMode m payload result
singleJobMode JobHandler m payload result
handler = (Map Int64 (Either Text result)
 -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
forall (m :: * -> *) payload result.
(Map Int64 (Either Text result)
 -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
SingleJobMode (\Map Int64 (Either Text result)
_ Map Int64 Text
_ -> JobHandler m payload result
handler)

-- | Wrap a rollup handler that receives merged child results and DLQ failures.
--
-- Successful child results are combined via their 'Monoid' instance.
-- Failed children (DLQ'd or with decode failures) contribute 'mempty' to the merge.
-- The second argument is a map from DLQ primary key to error message,
-- actionable with 'Arbiter.Core.HighLevel.deleteDLQJob'.
-- For regular\/child jobs the handler receives @('mempty', empty)@.
mergedRollupHandler
  :: (Monoid result) => (result -> Map Int64 Text -> JobHandler m payload result) -> HandlerMode m payload result
mergedRollupHandler :: forall result (m :: * -> *) payload.
Monoid result =>
(result -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
mergedRollupHandler result -> Map Int64 Text -> JobHandler m payload result
handler = (Map Int64 (Either Text result)
 -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
forall (m :: * -> *) payload result.
(Map Int64 (Either Text result)
 -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
SingleJobMode ((Map Int64 (Either Text result)
  -> Map Int64 Text -> JobHandler m payload result)
 -> HandlerMode m payload result)
-> (Map Int64 (Either Text result)
    -> Map Int64 Text -> JobHandler m payload result)
-> HandlerMode m payload result
forall a b. (a -> b) -> a -> b
$ \Map Int64 (Either Text result)
results Map Int64 Text
dlqFailures -> result -> Map Int64 Text -> JobHandler m payload result
handler (Map Int64 (Either Text result) -> result
forall a. Monoid a => Map Int64 (Either Text a) -> a
mergeChildResults Map Int64 (Either Text result)
results) Map Int64 Text
dlqFailures

-- | Merge child results from a rollup finalizer.
--
-- Folds all successful child results via their 'Monoid' instance.
-- @Left@ entries (DLQ failures and decode failures) map to 'mempty'.
-- Empty map for non-rollup jobs.
mergeChildResults :: (Monoid a) => Map Int64 (Either Text a) -> a
mergeChildResults :: forall a. Monoid a => Map Int64 (Either Text a) -> a
mergeChildResults = (Either Text a -> a) -> Map Int64 (Either Text a) -> a
forall m a. Monoid m => (a -> m) -> Map Int64 a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either Text a -> a
forall m. Monoid m => Either Text m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Internal helper to create a config with the given handler mode.
mkDefaultConfig
  :: (Applicative n, MonadIO m)
  => ByteString
  -> Int
  -> HandlerMode n payload result
  -> m (WorkerConfig n payload result)
mkDefaultConfig :: forall (n :: * -> *) (m :: * -> *) payload result.
(Applicative n, MonadIO m) =>
ByteString
-> Int
-> HandlerMode n payload result
-> m (WorkerConfig n payload result)
mkDefaultConfig ByteString
connStrVal Int
workerCnt HandlerMode n payload result
mode = do
  livenessMVar <- m (MVar ())
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
  shutdownTVar <- newTVarIO Running
  uuid <- liftIO UUID.nextRandom
  tmpDir <- liftIO getTemporaryDirectory
  let livenessFile = FilePath
tmpDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/arbiter-worker-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> UUID -> FilePath
toString UUID
uuid
  pure
    WorkerConfig
      { connStr = connStrVal
      , workerCount = workerCnt
      , handlerMode = mode
      , pollInterval = 5
      , visibilityTimeout = 60
      , heartbeatInterval = 30
      , maxAttempts = 10
      , backoffStrategy = exponentialBackoff 2.0 1_048_576
      , jitter = EqualJitter
      , useWorkerTransaction = True
      , transactionTimeout = Nothing
      , observabilityHooks = defaultObservabilityHooks
      , workerStateVar = shutdownTVar
      , livenessConfig = Just (LivenessConfig livenessFile livenessMVar 60)
      , gracefulShutdownTimeout = Just 30
      , logConfig = defaultLogConfig
      , claimThrottle = Nothing
      , cronJobs = []
      , groupReaperInterval = 300
      }

-- | Pause the worker pool
--
-- Stops claiming new jobs. In-flight jobs will complete normally.
-- Workers will wait in paused state until resumed or shut down.
pauseWorker :: (MonadIO m) => WorkerConfig n payload result -> m ()
pauseWorker :: forall (m :: * -> *) (n :: * -> *) payload result.
MonadIO m =>
WorkerConfig n payload result -> m ()
pauseWorker WorkerConfig n payload result
config = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (STM () -> IO ()) -> STM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  st <- TVar WorkerState -> STM WorkerState
forall a. TVar a -> STM a
STM.readTVar (WorkerConfig n payload result -> TVar WorkerState
forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar WorkerConfig n payload result
config)
  case st of
    WorkerState
ShuttingDown -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    WorkerState
_ -> TVar WorkerState -> WorkerState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar (WorkerConfig n payload result -> TVar WorkerState
forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar WorkerConfig n payload result
config) WorkerState
Paused

-- | Resume the worker pool from paused state
--
-- Workers will start claiming new jobs again.
resumeWorker :: (MonadIO m) => WorkerConfig n payload result -> m ()
resumeWorker :: forall (m :: * -> *) (n :: * -> *) payload result.
MonadIO m =>
WorkerConfig n payload result -> m ()
resumeWorker WorkerConfig n payload result
config = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (STM () -> IO ()) -> STM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  st <- TVar WorkerState -> STM WorkerState
forall a. TVar a -> STM a
STM.readTVar (WorkerConfig n payload result -> TVar WorkerState
forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar WorkerConfig n payload result
config)
  case st of
    WorkerState
ShuttingDown -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    WorkerState
_ -> TVar WorkerState -> WorkerState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar (WorkerConfig n payload result -> TVar WorkerState
forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar WorkerConfig n payload result
config) WorkerState
Running

-- | Initiate graceful shutdown of the worker pool
--
-- Stops claiming new jobs. In-flight jobs will complete, then the pool exits.
shutdownWorker :: (MonadIO m) => WorkerConfig n payload result -> m ()
shutdownWorker :: forall (m :: * -> *) (n :: * -> *) payload result.
MonadIO m =>
WorkerConfig n payload result -> m ()
shutdownWorker WorkerConfig n payload result
config = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (STM () -> IO ()) -> STM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar WorkerState -> WorkerState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar (WorkerConfig n payload result -> TVar WorkerState
forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar WorkerConfig n payload result
config) WorkerState
ShuttingDown

-- | Get the current worker state
getWorkerState :: (MonadIO m) => WorkerConfig n payload result -> m WorkerState
getWorkerState :: forall (m :: * -> *) (n :: * -> *) payload result.
MonadIO m =>
WorkerConfig n payload result -> m WorkerState
getWorkerState WorkerConfig n payload result
config = IO WorkerState -> m WorkerState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WorkerState -> m WorkerState)
-> (STM WorkerState -> IO WorkerState)
-> STM WorkerState
-> m WorkerState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM WorkerState -> IO WorkerState
forall (m :: * -> *) a. MonadIO m => STM a -> m a
STM.atomically (STM WorkerState -> m WorkerState)
-> STM WorkerState -> m WorkerState
forall a b. (a -> b) -> a -> b
$ TVar WorkerState -> STM WorkerState
forall a. TVar a -> STM a
STM.readTVar (WorkerConfig n payload result -> TVar WorkerState
forall (m :: * -> *) payload result.
WorkerConfig m payload result -> TVar WorkerState
workerStateVar WorkerConfig n payload result
config)