-- | Run a worker in 'OrvilleDb' with its handlers and hooks written in the base monad:
--
-- @
-- import Arbiter.Orville.Worker qualified as ArbO
-- import Arbiter.Worker qualified as Worker
--
-- config <- Worker.manualWorkerConfig 5 (ArbO.orvilleBatchedHandler processJob)
-- let config' = config {Worker.observabilityHooks = ArbO.orvilleHooks appHooks}
-- @
module Arbiter.Orville.Worker
  ( orvilleBatchedHandler
  , orvilleHooks
  ) where

import Arbiter.Core.Job.Types (ObservabilityHooks, hoistObservabilityHooks)
import Arbiter.Worker.Config (BatchCallbacks, hoistBatchCallbacks)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT (..))

import Arbiter.Orville.OrvilleDb (OrvilleDb (..), runOrvilleDb)

-- | A batched or manual handler written in the base monad. Its callbacks run in the
-- worker's own 'OrvilleDb' env, on the handler's connection and inside any
-- transaction the handler opens.
orvilleBatchedHandler
  :: (jobs -> BatchCallbacks m payload result -> m ())
  -> jobs
  -> BatchCallbacks (OrvilleDb registry m) payload result
  -> OrvilleDb registry m ()
orvilleBatchedHandler :: forall jobs (m :: * -> *) payload result
       (registry :: JobPayloadRegistry).
(jobs -> BatchCallbacks m payload result -> m ())
-> jobs
-> BatchCallbacks (OrvilleDb registry m) payload result
-> OrvilleDb registry m ()
orvilleBatchedHandler jobs -> BatchCallbacks m payload result -> m ()
handler jobs
jobs BatchCallbacks (OrvilleDb registry m) payload result
callbacks =
  ReaderT (OrvilleEnv registry) m () -> OrvilleDb registry m ()
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
ReaderT (OrvilleEnv registry) m a -> OrvilleDb registry m a
OrvilleDb (ReaderT (OrvilleEnv registry) m () -> OrvilleDb registry m ())
-> ((OrvilleEnv registry -> m ())
    -> ReaderT (OrvilleEnv registry) m ())
-> (OrvilleEnv registry -> m ())
-> OrvilleDb registry m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OrvilleEnv registry -> m ()) -> ReaderT (OrvilleEnv registry) m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((OrvilleEnv registry -> m ()) -> OrvilleDb registry m ())
-> (OrvilleEnv registry -> m ()) -> OrvilleDb registry m ()
forall a b. (a -> b) -> a -> b
$ \OrvilleEnv registry
env ->
    jobs -> BatchCallbacks m payload result -> m ()
handler jobs
jobs ((forall a. OrvilleDb registry m a -> m a)
-> BatchCallbacks (OrvilleDb registry m) payload result
-> BatchCallbacks m payload result
forall (m :: * -> *) (n :: * -> *) payload result.
(forall a. m a -> n a)
-> BatchCallbacks m payload result
-> BatchCallbacks n payload result
hoistBatchCallbacks (OrvilleEnv registry -> OrvilleDb registry m a -> m a
forall (registry :: JobPayloadRegistry) (m :: * -> *) a.
OrvilleEnv registry -> OrvilleDb registry m a -> m a
runOrvilleDb OrvilleEnv registry
env) BatchCallbacks (OrvilleDb registry m) payload result
callbacks)

-- | Hooks written in the base monad.
orvilleHooks :: (Monad m) => ObservabilityHooks m payload -> ObservabilityHooks (OrvilleDb registry m) payload
orvilleHooks :: forall (m :: * -> *) payload (registry :: JobPayloadRegistry).
Monad m =>
ObservabilityHooks m payload
-> ObservabilityHooks (OrvilleDb registry m) payload
orvilleHooks = (forall a. m a -> OrvilleDb registry m a)
-> ObservabilityHooks m payload
-> ObservabilityHooks (OrvilleDb registry m) payload
forall (m :: * -> *) (n :: * -> *) payload.
(forall a. m a -> n a)
-> ObservabilityHooks m payload -> ObservabilityHooks n payload
hoistObservabilityHooks m a -> OrvilleDb registry m a
forall a. m a -> OrvilleDb registry m a
forall (m :: * -> *) a. Monad m => m a -> OrvilleDb registry m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift