content: {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE NamedFieldPuns        #-}
  {-# LANGUAGE NoImplicitPrelude     #-}
  
  {-| This module contains all logic related to error handling when spawning threads
    to execute Worker sub-routines
  -}
  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
  
  -- | Decorates the given @IO ()@ sub-routine with failure handling
  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
        }
  
  -- | Internal function that forks a worker thread on the Capataz thread; note
  -- this is different from the public @forkWorker@ function which sends a message
  -- to the capataz loop
  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
  