{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Control.Concurrent.Capataz.Internal.Worker where
import RIO
import RIO.Time (getCurrentTime)
import qualified Data.UUID.V4 as UUID
import qualified Control.Concurrent.Capataz.Internal.Process as Process
import qualified Control.Concurrent.Capataz.Internal.Util as Util
import Control.Concurrent.Capataz.Internal.Types
workerMain
:: (MonadUnliftIO m)
=> ParentSupervisorEnv m
-> WorkerOptions m
-> WorkerId
-> RestartCount
-> m (Worker m)
workerMain env@ParentSupervisorEnv { supervisorNotify } workerOptions@WorkerOptions { workerName, workerAction } workerId restartCount
= do
workerCreationTime <- getCurrentTime
workerAsync <- asyncWithUnmask $ \unmask -> do
Util.setProcessThreadName workerId workerName
eResult <- unsafeTry $ unmask (workerAction workerId)
resultEvent <- case eResult of
Left err -> Process.handleProcessException unmask
env
(WorkerSpec workerOptions)
workerId
restartCount
err
Right _ -> Process.handleProcessCompletion unmask
env
(WorkerSpec workerOptions)
workerId
restartCount
supervisorNotify (MonitorEvent resultEvent)
return Worker
{ workerId
, workerName
, workerAsync
, workerCreationTime
, workerOptions
}
forkWorker
:: (MonadUnliftIO m)
=> ParentSupervisorEnv m
-> WorkerOptions m
-> Maybe (WorkerId, RestartCount)
-> m (Worker m)
forkWorker env workerOptions mRestartInfo = do
(workerId, restartCount) <- case mRestartInfo of
Just (workerId, restartCount) -> pure (workerId, restartCount)
Nothing -> (,) <$> liftIO UUID.nextRandom <*> pure 0
worker <- workerMain env workerOptions workerId restartCount
Process.notifyProcessStarted mRestartInfo env (WorkerProcess worker)
return worker