content: {-# LANGUAGE DeriveGeneric         #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE NamedFieldPuns        #-}
  {-# LANGUAGE NoImplicitPrelude     #-}
  {-# LANGUAGE OverloadedStrings     #-}
  
  {-| This module contains all the types used across all the other modules -}
  module Control.Concurrent.Capataz.Internal.Types where
  
  import RIO
  import RIO.Time (NominalDiffTime, UTCTime)
  
  import Control.Teardown (HasTeardown (..), Teardown)
  import Data.UUID        (UUID)
  
  import qualified Control.Exception as UnsafeE
  import           Data.Typeable     (cast)
  
  import           Data.Text.Prettyprint.Doc (Pretty (..), (<+>))
  import qualified Data.Text.Prettyprint.Doc as Pretty
  import           Text.Show.Pretty          (ppShow)
  
  type CapatazId = UUID
  type WorkerId = UUID
  type SupervisorId = UUID
  type ProcessId = UUID
  type WorkerAction m = WorkerId -> m ()
  type ProcessName = Text
  type CapatazName = Text
  type SupervisorName = Text
  type WorkerName = Text
  type RestartCount = Int
  type ProcessMap m = HashMap ProcessId (Process m)
  type ParentSupervisor = Supervisor
  
  -- | Wrapper for 'ThreadId'
  --
  -- @since 0.2.0.0
  newtype ProcessThreadId
    = PTID ThreadId
    deriving (Generic, Eq, Show)
  
  -- | @since 0.2.0.0
  instance Pretty ProcessThreadId where
    pretty (PTID tid) =
      case words (show tid) of
        (_:threadNumber:_) -> pretty threadNumber
        _                  -> "unknown"
  
  -- | Event delivered to the 'notifyEvent' callback sub-routine; these events can
  -- be used to monitor the capataz system and track what is doing, providing high
  -- levels of telemetry for all supervisors and workers of a capataz system,
  -- ergo, should be used for logging, monitoring and testing purposes.
  --
  -- @since 0.1.0.0
  data CapatazEvent
    = InvalidSupervisorStatusReached {
      supervisorId   :: !SupervisorId
    , supervisorName :: !SupervisorName
    , eventTime      :: !UTCTime
    }
    | SupervisorStatusChanged {
      supervisorId         :: !SupervisorId
    , supervisorName       :: !SupervisorName
    , prevSupervisorStatus :: !SupervisorStatus
    , newSupervisorStatus  :: !SupervisorStatus
    , eventTime            :: !UTCTime
    }
    | ProcessTerminated {
      supervisorId      :: !SupervisorId
    , supervisorName    :: !SupervisorName
    , processThreadId   :: !ProcessThreadId
    , processId         :: !ProcessId
    , processName       :: !ProcessName
    , processType       :: !ProcessType
    , terminationReason :: !Text
    , eventTime         :: !UTCTime
    }
    | ProcessStarted {
      supervisorId    :: !SupervisorId
    , supervisorName  :: !SupervisorName
    , processThreadId :: !ProcessThreadId
    , processId       :: !ProcessId
    , processName     :: !ProcessName
    , processType     :: !ProcessType
    , eventTime       :: !UTCTime
    }
    | ProcessRestarted {
      supervisorId        :: !SupervisorId
    , supervisorName      :: !SupervisorName
    , processThreadId     :: !ProcessThreadId
    , processId           :: !ProcessId
    , processName         :: !ProcessName
    , processType         :: !ProcessType
    , processRestartCount :: !Int
    , eventTime           :: !UTCTime
    }
    | ProcessCompleted {
      supervisorId    :: !SupervisorId
    , supervisorName  :: !SupervisorName
    , processThreadId :: !ProcessThreadId
    , processId       :: !ProcessId
    , processName     :: !ProcessName
    , processType     :: !ProcessType
    , eventTime       :: !UTCTime
    }
    | ProcessFailed {
      supervisorName  :: !SupervisorName
    , supervisorId    :: !SupervisorId
    , processThreadId :: !ProcessThreadId
    , processId       :: !ProcessId
    , processName     :: !ProcessName
    , processType     :: !ProcessType
    , processError    :: !SomeException
    , eventTime       :: !UTCTime
    }
    | ProcessCallbackExecuted {
      supervisorId         :: !SupervisorId
    , supervisorName       :: !SupervisorName
    , processThreadId      :: !ProcessThreadId
    , processId            :: !ProcessId
    , processName          :: !ProcessName
    , processType          :: !ProcessType
    , processCallbackError :: !(Maybe SomeException)
    , processCallbackType  :: !CallbackType
    , eventTime            :: !UTCTime
    }
    | ProcessTerminationStarted {
      supervisorName    :: !SupervisorName
    , supervisorId      :: !SupervisorId
    , terminationReason :: !Text
    , eventTime         :: !UTCTime
    }
    | ProcessTerminationFinished {
      supervisorName    :: !SupervisorName
    , supervisorId      :: !SupervisorId
    , terminationReason :: !Text
    , eventTime         :: !UTCTime
    }
    | CapatazFailed {
      supervisorId    :: !SupervisorId
    , supervisorName  :: !SupervisorName
    , supervisorError :: !SomeException
    , eventTime       :: !UTCTime
    }
    | CapatazTerminated {
      supervisorName :: !SupervisorName
    , supervisorId   :: !SupervisorId
    , eventTime      :: !UTCTime
    }
    deriving (Generic, Show)
  
  -- | @since 0.2.0.0
  instance Pretty CapatazEvent where
    pretty ev =
      case ev of
        InvalidSupervisorStatusReached {supervisorId, supervisorName} ->
          "Supervisor got into an state that should never have happened, please"
          <+> "report a ticket to"
          <+> "https://github.com/roman/Haskell-capataz/issues/new with title:"
          <+> Pretty.dquotes "InvalidSupervisorStatusReached error"
          <> prettyAttributes [("Supervisor ID"
                               , prettySupervisorId supervisorId supervisorName)]
  
        SupervisorStatusChanged {
            supervisorId
          , supervisorName
          , prevSupervisorStatus
          , newSupervisorStatus
          } ->
          "Supervisor changed state"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              , ("Previous State"
                                , Pretty.dquotes $ Pretty.pretty prevSupervisorStatus)
                              , ("New State"
                                , Pretty.dquotes (Pretty.pretty newSupervisorStatus))
                              ]
  
        ProcessStarted {
            supervisorId
          , supervisorName
          , processId
          , processThreadId
          , processName
          , processType
          } ->
          "Supervisor spawned new process"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              , ( "Process ID"
                                , prettyProcessId processId processName processThreadId)
                              , ( "Process Type",
                                  pretty processType)
                              ]
  
        ProcessFailed {
            processId
          , processThreadId
          , processName
          , processType
          , processError
          } ->
          "Process failed with error"
          <> prettyAttributes [ ( "Process ID"
                                , prettyProcessId processId processName processThreadId)
                              , ( "Process Type", pretty processType)
                              , ( "Error"
                                , Pretty.nest 2 (Pretty.hardline
                                                 <> "|" <+> pretty (ppShow processError)))
                              ]
  
        ProcessRestarted {
            supervisorId
          , supervisorName
          , processId
          , processThreadId
          , processName
          , processType
          } ->
          "Supervisor restarted failed process"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              , ( "Process ID"
                                , prettyProcessId processId processName processThreadId)
                              , ( "Process Type", pretty processType)
                              ]
  
        ProcessTerminated {
            supervisorId
          , supervisorName
          , processId
          , processThreadId
          , processName
          , processType
          , terminationReason
          } ->
          "Supervisor terminated process"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              , ( "Process ID"
                                , prettyProcessId processId processName processThreadId)
                              , ( "Process Type", pretty processType)
                              , ( "Reason"
                                , Pretty.nest 2
                                    (Pretty.fillBreak 10 $ pretty terminationReason))
                              ]
  
  
        ProcessCompleted {
            processId
          , processThreadId
          , processName
          , processType
          } ->
          "Process completed execution with no errors"
          <> prettyAttributes [ ( "Process ID"
                                , prettyProcessId processId processName processThreadId)
                              , ( "Process Type", pretty processType)
                              ]
  
        ProcessCallbackExecuted {
            processId
          , processThreadId
          , processName
          , processType
          , processCallbackError
          , processCallbackType
          } ->
          case processCallbackError of
            Nothing ->
              "Process executed callback"
               <> prettyAttributes [ ( "Process ID"
                                     , prettyProcessId processId processName processThreadId)
                                   , ( "Process Type", pretty processType)
                                   , ( "Callback", pretty processCallbackType)
                                   ]
            Just err ->
              "Process executed callback and it failed"
               <> prettyAttributes [ ( "Process ID"
                                     , prettyProcessId processId processName processThreadId)
                                   , ( "Process Type", pretty processType)
                                   , ( "Callback", pretty processCallbackType)
                                   , ( "Error"
                                     , Pretty.nest 2
                                         (Pretty.hardline
                                           <> "|"
                                           <+> pretty (ppShow err)))
                                   ]
  
        ProcessTerminationStarted {
            supervisorId
          , supervisorName
          , terminationReason
          } ->
          "Supervisor started termination of its children"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              , ( "Reason"
                                , Pretty.nest 2
                                    (Pretty.fillBreak 10 $ pretty terminationReason))
                              ]
  
        ProcessTerminationFinished {
            supervisorId
          , supervisorName
          } ->
          "Supervisor finished termination of its children"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              ]
  
        CapatazFailed {
            supervisorId
          , supervisorName
          , supervisorError
          } ->
          "Root Supervisor had a fatal failure"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              , ( "Error"
                                , Pretty.nest 2
                                    (Pretty.hardline
                                      <> "|"
                                      <+> pretty (ppShow supervisorError)))
                              ]
  
        CapatazTerminated {
            supervisorId
          , supervisorName
          } ->
          "Root supervisor was terminated"
          <> prettyAttributes [ ("Supervisor ID"
                                , prettySupervisorId supervisorId supervisorName)
                              ]
      where
        prettyAttributes attrList =
          Pretty.nest 4
            (Pretty.hardline
             <> Pretty.vsep (map (\(k, v) -> Pretty.fill 20 (k <> ":") <+> v)
                                  attrList))
  
        prettySupervisorId supId supName =
          Pretty.angles
          $ pretty (show supId) <> "/" <> pretty supName
  
        prettyProcessId procId procName procTid =
          Pretty.angles
          $ pretty (show procId) <> "/" <> pretty procName <> "/" <> pretty procTid
  
  -- | @since 0.2.0.0
  instance Display CapatazEvent where
    display = displayShow . pretty
  
  -- | Defines how a 'Worker' process termination should be handled by its
  -- supervisor.
  --
  -- @since 0.0.0.0
  data WorkerTerminationPolicy
    -- | Supervisor waits until infinity for the worker termination callback to
    -- finish execution.
    = Infinity
  
    -- | Supervisor terminates worker process without a chance to call its
    -- termination callback.
    | BrutalTermination
  
    -- | Supervisor allows a number of milliseconds for worker termination
    --  callback complete, if not completed by specified milliseconds the
    --  termination is cancelled via a "BrutalTermination" signal.
    | TimeoutMillis !Int
    deriving (Generic, Show, Eq, Ord)
  
  -- | Default worker termination is a timeout of three (3) seconds.
  --
  -- @since 0.2.0.0
  defWorkerTerminationPolicy :: WorkerTerminationPolicy
  defWorkerTerminationPolicy = TimeoutMillis 3000
  
  instance NFData WorkerTerminationPolicy
  
  -- | Internal helper record that assesses if a Supervisor error intensity has
  -- been breached.
  data ProcessRestartAction
    -- | Indicates a Supervisor to restart a failed process _and_ reset the
    -- restart count given this Supervisor's intensity period timeout has passed.
    = ResetRestartCount
  
    -- | Indicates a Supervisor to restart the failed process _and_ increase the restart
    -- count (normal operation) of the supervised process.
    | IncreaseRestartCount
  
    -- | Indicates a Supervisor stop executing given the error intensity has been
    -- breached.
    | HaltSupervisor
    deriving (Generic, Show, Eq)
  
  instance NFData ProcessRestartAction
  
  -- | Specifies the order in which supervised process should be terminated by a
  -- Supervisor in case of a restart or shutdown.
  --
  -- @since 0.0.0.0
  data ProcessTerminationOrder
    -- | Supervisor terminates supervised process from most recent to oldest.
    = NewestFirst
    -- | Supervisor terminates supervised process from oldest to most recent.
    | OldestFirst
    deriving (Generic, Show, Eq, Ord)
  
  -- | Default termination order is 'OldestFirst'.
  --
  -- @since 0.2.0.0
  defProcessTerminationOrder :: ProcessTerminationOrder
  defProcessTerminationOrder = OldestFirst
  
  instance NFData ProcessTerminationOrder
  
  -- | Specifies how a Supervisor restarts a failing process.
  --
  -- @since 0.0.0.0
  data SupervisorRestartStrategy
    -- | Supervisor terminates all sibling supervised processes that didn't fail,
    -- and then restarts all of them together. This strategy serves best when all
    -- processes depend upon each other.
    = AllForOne
  
    -- | Supervisor only restarts the supervised process that failed.
    | OneForOne
    deriving (Generic, Show, Eq, Ord)
  
  -- | Default restart strategy is 'OneForOne'.
  --
  -- @since 0.2.0.0
  defSupervisorRestartStategy :: SupervisorRestartStrategy
  defSupervisorRestartStategy = OneForOne
  
  instance NFData SupervisorRestartStrategy
  
  -- | Allows to:
  --
  -- * Specify options for the root 'Supervisor' of a capataz system.
  --
  -- * Provide a 'notifyEvent' callback to monitor or log a capataz system.
  --
  -- @since 0.1.0.0
  data CapatazOptions m
    = CapatazOptions {
      supervisorName                    :: !SupervisorName
    , supervisorIntensity               :: !Int
    , supervisorPeriodSeconds           :: !NominalDiffTime
    , supervisorRestartStrategy         :: !SupervisorRestartStrategy
    , supervisorProcessSpecList         :: ![ProcessSpec m]
    , supervisorProcessTerminationOrder :: !ProcessTerminationOrder
    , supervisorOnIntensityReached      :: !(m ())
      -- | Callback sub-routine that gets executed when the root supervisor fails.
    , supervisorOnFailure               :: !(SomeException -> m ())
      -- | Callback used for telemetry purposes.
    , notifyEvent                       :: !(CapatazEvent -> m ())
    }
  
  
  -- | Specifies how a Supervisor deals with the lifecycle of worker process in
  -- case of completion without errors and failure.
  data WorkerRestartStrategy
    -- | Supervisor will __always__ restart a worker process, in both completion
    -- and failure scenarios.
    = Permanent
  
    -- | Supervisor will __only__ restart worker process if it has a failure in
    -- execution.
    | Transient
  
    -- | Supervisor will __never__ restart a worker, even on failure.
    | Temporary
  
    deriving (Generic, Show, Eq)
  
  instance NFData WorkerRestartStrategy
  
  -- |  A worker default restart strategy is "Transient".
  defWorkerRestartStrategy :: WorkerRestartStrategy
  defWorkerRestartStrategy = Transient
  
  -- | Specifies all options that can be used to create a Worker Process. You may
  -- create a record of this type via the smart constructor 'buildWorkerOptions'.
  --
  -- @since 0.1.0.0
  data WorkerOptions m
    = WorkerOptions {
      -- | An @IO ()@ sub-routine that will be executed when the worker
      -- thread is created, this attribute is lazy given we want to this
      -- value on a worker thread environment.
      workerAction            :: WorkerAction m
      -- | Name of the Worker (present on "CapatazEvent" records)
    , workerName              :: !WorkerName
      -- | Callback used when the worker fails with an error
    , workerOnFailure         :: !(SomeException -> m ())
      -- | Callback used when the worker completes execution without error
    , workerOnCompletion      :: !(m ())
      -- | Callback used when the worker is terminated
    , workerOnTermination     :: !(m ())
      -- | Indicates how a worker should be terminated
    , workerTerminationPolicy :: !WorkerTerminationPolicy
      -- | Indicates how a worker should be restarted
    , workerRestartStrategy   :: !WorkerRestartStrategy
    }
    deriving (Generic)
  
  -- | Record that contains the "Async" record (thread reference) of a worker
  --
  -- @since 0.1.0.0
  data Worker m
    = Worker {
      -- | Unique identifier for a worker that is executing
      workerId           :: !WorkerId
      -- | "Async" thread of a worker, this Async executes the @IO ()@ sub-routine
    , workerAsync        :: !(Async ())
      -- | Time where this worker was created (used for error intensity checks)
    , workerCreationTime :: !UTCTime
      -- | Name of the Worker (present on "CapatazEvent" records)
    , workerName         :: !WorkerName
      -- | "WorkerOptions" contains all the options around restart and termination
      -- policies
    , workerOptions      :: !(WorkerOptions m)
    }
  
  data ProcessEnv
    = ProcessEnv {
      processId              :: !ProcessId
    , processName            :: !ProcessName
    , processAsync           :: !(Async ())
    , processCreationTime    :: !UTCTime
    , processRestartStrategy :: !WorkerRestartStrategy
    }
  
  data SupervisorOptions m
    = SupervisorOptions {
      -- | Name of the Supervisor (present on "CapatazEvent" records)
      supervisorName                    :: Text
      -- | How many errors is the Supervisor be able to handle; check:
      -- http://erlang.org/doc/design_principles/sup_princ.html#max_intensity
    , supervisorIntensity               :: !Int
      -- | Period of time where the Supervisor can receive "supervisorIntensity" amount
      -- of errors
    , supervisorPeriodSeconds           :: !NominalDiffTime
      -- | What is the "SupervisorRestartStrategy" for this Capataz
    , supervisorRestartStrategy         :: !SupervisorRestartStrategy
      -- | Static set of workers that start as soon as the "Capataz" is created
    , supervisorProcessSpecList         :: ![ProcessSpec m]
      -- | In which order the "Supervisor" record is going to terminate it's workers
    , supervisorProcessTerminationOrder :: !ProcessTerminationOrder
      -- | Callback used when the error intensity is reached
    , supervisorOnIntensityReached      :: !(m ())
    , supervisorOnFailure               :: !(SomeException -> m ())
    }
  
  data Supervisor m
    = Supervisor {
      supervisorId           :: !SupervisorId
    , supervisorName         :: !SupervisorName
    , supervisorOptions      :: !(SupervisorOptions m)
    , supervisorCreationTime :: !UTCTime
    , supervisorAsync        :: !(Async ())
    , supervisorNotify       :: SupervisorMessage m -> m ()
    , supervisorEnv          :: !(SupervisorEnv m)
    }
  
  -- | Internal record that represents an action being sent from threads using
  -- the Capataz public API.
  data ControlAction m
    = ForkWorker {
      workerOptions  :: !(WorkerOptions m)
    , returnWorkerId :: !(WorkerId -> m ())
    }
    | ForkSupervisor {
      supervisorOptions :: !(SupervisorOptions m)
    , returnSupervisor  :: !(Supervisor m -> m ())
    }
    | TerminateProcess {
      processId                :: !ProcessId
    , processTerminationReason :: !Text
    , notifyProcessTermination :: !(Bool -> m ())
    }
    deriving (Generic)
  
  -- | Internal exception thrown to the Capataz loop to indicate termination of
  -- execution
  data CapatazSignal
    = CapatazFailure
    | RestartProcessException
    | TerminateProcessException {
        processId                :: !ProcessId
      , processTerminationReason :: !Text
      }
    | BrutallyTerminateProcessException {
        processId                :: !ProcessId
      , processTerminationReason :: !Text
      }
      deriving (Generic, Show)
  
  instance Exception CapatazSignal
  instance NFData CapatazSignal
  
  -- | Internal exception triggered when a Worker violates error intensity
  -- specification
  data CapatazError
    = SupervisorIntensityReached {
      processId           :: !ProcessId
    , processName         :: !ProcessName
    , processRestartCount :: !Int
    }
    deriving (Generic, Show)
  
  instance Exception CapatazError
  instance NFData CapatazError
  
  -- | Internal record that indicates what type of callback function is being
  -- invoked; this is used for telemetry purposes
  data CallbackType
    = OnCompletion
    | OnFailure
    | OnTermination
    deriving (Generic, Show, Eq)
  
  instance Pretty CallbackType where
    pretty = Pretty.pretty . show
  
  data ProcessType
    = SupervisorType
    | WorkerType
    deriving (Show, Eq)
  
  instance Pretty ProcessType  where
    pretty ty =
      case ty of
        SupervisorType -> "Supervisor"
        WorkerType     -> "Worker"
  
  -- | Internal exception triggered when a callback of a Worker fails
  data ProcessError
    = ProcessCallbackFailed {
        processId            :: !WorkerId
      , processError         :: !(Maybe SomeException)
      , processCallbackError :: !SomeException
      , processCallbackType  :: !CallbackType
      }
      deriving (Generic, Show)
  
  instance Exception ProcessError
  
  -- | Internal event delivered from Worker threads to the Capataz thread to
  -- indicate completion, failure or termination
  data MonitorEvent
    = ProcessTerminated' {
      processId                :: !ProcessId
    , processName              :: !ProcessName
    , processRestartCount      :: !RestartCount
    , processTerminationReason :: !Text
    , monitorEventTime         :: !UTCTime
    }
    | ProcessFailed' {
      processId           :: !WorkerId
    , processName         :: !WorkerName
    , processRestartCount :: !RestartCount
    , processError        :: !SomeException
    , monitorEventTime    :: !UTCTime
    }
    | ProcessCompleted' {
      processId        :: !ProcessId
    , processName      :: !ProcessName
    , monitorEventTime :: !UTCTime
    }
    | ProcessForcedRestart {
      processId        :: !ProcessId
    , processName      :: !ProcessName
    , monitorEventTime :: !UTCTime
    }
    deriving (Show)
  
  -- | Internal record used as a state machine, indicating the state of a
  -- supervisor process
  data SupervisorStatus
    -- | This state is set when the process is created and it starts spawning its
    -- static process list.
    = Initializing
    -- | This state is set when the supervisor process starts listenting to both
    -- "ControlAction" and "MonitorEvent" messages.
    | Running
    -- | This state is set when the supervisor process is terminating it's
    -- assigned worker
    | Halting
    -- | This state is set when the supervisor process is finished
    | Halted
    deriving (Generic, Show, Eq)
  
  instance NFData SupervisorStatus
  
  instance Pretty SupervisorStatus where
    pretty =
      pretty . show
  
  -- | Internal message delivered to a supervisor process that can either be a
  -- call from public API or an event from its monitored worker process.
  data SupervisorMessage m
    -- | Represents a request from done to the supervisor thread from another
    -- thread using the public API
    = ControlAction !(ControlAction m)
    -- | Represents an event (failure, completion, etc) from a monitored worker
    -- process to the supervisor
    | MonitorEvent !MonitorEvent
    deriving (Generic)
  
  -- | Internal Type to manage both 'Worker' and 'Supervisor' processes
  --
  -- @since 0.1.0.0
  data Process m
    = WorkerProcess  !(Worker m)
    | SupervisorProcess !(Supervisor m)
  
  -- | Record used to specify how to __build__ a runtime 'Process' in a static
  -- supervision tree; to create values of this type, you must use:
  --
  -- * 'workerSpec' or 'workerSpecWithDefaults' to build a worker process
  --
  -- * 'supervisorSpec' or 'supervisorSpecWithDefaults' to build a supervisor
  -- process
  --
  -- @since 0.1.0.0
  data ProcessSpec m
    = WorkerSpec (WorkerOptions m)
    | SupervisorSpec (SupervisorOptions m)
  
  -- | Record that contains the environment of a capataz monitor, this is used as
  -- the main record to create workers and to stop the supervisor thread.
  --
  -- @since 0.0.0.0
  data Capataz m
    = Capataz {
      capatazSupervisor :: !(Supervisor m)
    , capatazTeardown   :: !Teardown
    }
  
  instance HasTeardown (Capataz m) where
    getTeardown Capataz {capatazTeardown} =
      capatazTeardown
  
  -- | Internal utility record used to hold part of the runtime information of a
  -- supervisor that acts as a parent of another supervisor.
  data ParentSupervisorEnv m
    = ParentSupervisorEnv {
      supervisorId     :: !SupervisorId
    , supervisorName   :: !SupervisorName
    , supervisorNotify :: !(SupervisorMessage m -> m ())
    , notifyEvent      :: !(CapatazEvent -> m ())
    }
  
  -- | Convenience internal utility record that contains all values related to a
  -- supervisor process.
  data SupervisorEnv m
    = SupervisorEnv {
      supervisorId                      :: !SupervisorId
    , supervisorName                    :: !SupervisorName
    , supervisorNotify                  :: !(SupervisorMessage m -> m ())
    , supervisorGetNotification         :: !(STM (SupervisorMessage m))
    , supervisorProcessMap              :: !(IORef (ProcessMap m))
    , supervisorStatusVar               :: !(TVar SupervisorStatus)
    , supervisorOptions                 :: !(SupervisorOptions m)
    , supervisorIntensity               :: !Int
      -- ^ http://erlang.org/doc/design_principles/sup_princ.html#max_intensity
    , supervisorPeriodSeconds           :: !NominalDiffTime
    , supervisorRestartStrategy         :: !SupervisorRestartStrategy
    , supervisorProcessTerminationOrder :: !ProcessTerminationOrder
    , supervisorOnIntensityReached      :: !(m ())
    , supervisorOnIntensityReached      :: !(SomeException -> m ())
    , notifyEvent                       :: !(CapatazEvent -> m ())
    }
  
  -- | Builds a 'CapatazOptions' record with defaults on how to create a capataz
  -- root supervisor, these defaults are:
  --
  -- * Intensity error tolerance is set to 1 error every 5 seconds
  --
  -- * A 'SupervisorRestartStrategy' of 'OneForOne'
  --
  -- * A 'ProcessTerminationOrder' of 'OldestFirst'
  --
  -- This function is intended to be used in combination with 'forkCapataz'.
  --
  -- @since 0.1.0.0
  defCapatazOptions
    :: Monad m
    => Text
    -> (CapatazOptions m -> CapatazOptions m) -- ^ Function to modify root supervisor
    -> CapatazOptions m
  defCapatazOptions supervisorName modFn = modFn CapatazOptions
    { supervisorName
    , supervisorIntensity               = 2
    , supervisorPeriodSeconds           = 5
    , supervisorRestartStrategy         = defSupervisorRestartStategy
    , supervisorProcessSpecList         = []
    , supervisorProcessTerminationOrder = OldestFirst
    , supervisorOnIntensityReached      = return ()
    , supervisorOnFailure               = const $ return ()
    , notifyEvent                       = const $ return ()
    }
  
  -- | Builds a 'ProcessSpec' record for a supervisor process with defaults from
  -- 'supervisorSpecWithDefaults'. This function allows overrides of these
  -- defaults using lenses.
  --
  -- This function is used when building a supervisor branch in a static
  -- supervision trees.
  --
  -- @since 0.1.0.0
  supervisorSpec
    :: Monad m
    => SupervisorName -- ^ Name used for telemetry purposes
    -> (SupervisorOptions m -> SupervisorOptions m) -- ^ 'SupervisorOptions' modifier
    -> ProcessSpec m
  supervisorSpec sName modFn =
    SupervisorSpec (buildSupervisorOptions sName modFn)
  {-# INLINE supervisorSpec #-}
  
  -- | Builds a 'ProcessSpec' record for a supervisor process with defaults from
  --  'buildSupervisorOptionsWithDefaults'.
  --
  -- This function is used when building a supervisor branch in a static
  -- supervision trees.
  --
  -- @since 0.1.0.0
  supervisorSpecWithDefaults
    :: Monad m
    => SupervisorName -- ^ Name used for telemetry purposes
    -> ProcessSpec m
  supervisorSpecWithDefaults sName = supervisorSpec sName id
  {-# INLINE supervisorSpecWithDefaults #-}
  
  -- | Builds a 'ProcessSpec' record for a worker process with defaults from
  -- 'workerSpecWithDefaults'. This function allows overrides of these
  -- defaults using lenses.
  --
  -- This function is used when building a worker in a static supervision tree.
  --
  -- @since 0.1.0.0
  workerSpec
    :: Monad m
    => WorkerName -- ^ Name used for telemetry purposes
    -> m () -- ^ 'IO' sub-routine to be supervised
    -> (WorkerOptions m -> WorkerOptions m) -- ^ Function to modify default worker
                                        -- options
    -> ProcessSpec m
  workerSpec wName wAction modFn =
    WorkerSpec (buildWorkerOptions wName wAction modFn)
  {-# INLINE workerSpec #-}
  
  -- | Builds a 'ProcessSpec' record for a worker process with defaults from
  -- 'workerSpecWithDefaults'. This function allows overrides of these
  -- defaults using lenses.
  --
  -- This function is used when building a worker in a static supervision tree.
  -- The given sub-routine will receive the 'WorkerId' as a parameter
  --
  -- @since 0.2.0.0
  workerSpec1
    :: Monad m
    => WorkerName -- ^ Name used for telemetry purposes
    -> (WorkerId -> m ()) -- ^ sub-routine to be supervised
    -> (WorkerOptions m -> WorkerOptions m) -- ^ Function to modify default worker
                                        -- options
    -> ProcessSpec m
  workerSpec1 wName wAction modFn =
    WorkerSpec (buildWorkerOptions1 wName wAction modFn)
  {-# INLINE workerSpec1 #-}
  
  -- | Builds a 'ProcessSpec' record for a worker process with defaults from
  -- 'buildSupervisorOptionsWithDefaults'.
  --
  -- This function is used when building a worker in a static supervision tree.
  --
  -- @since 0.1.0.0
  workerSpecWithDefaults
    :: Monad m
    => WorkerName -- ^ Name used for telemetry purposes
    -> m () -- ^ IO sub-routine to be supervised
    -> ProcessSpec m
  workerSpecWithDefaults wName wAction = workerSpec wName wAction id
  {-# INLINE workerSpecWithDefaults #-}
  
  -- | Builds a 'SupervisorOptions' record with defaults from
  -- 'buildSupervisorOptionsWithDefaults'. This function allows overrides of these
  -- defaults using lenses.
  --
  -- This function is intended to be used in combination with 'forkSupervisor'.
  --
  -- @since 0.1.0.0
  buildSupervisorOptions
    :: Monad m
    => SupervisorName -- ^ Name used for telemetry purposes
    -> (SupervisorOptions m -> SupervisorOptions m) -- ^ Function to modify default
                                                -- supervisor options
    -> SupervisorOptions m
  buildSupervisorOptions supervisorName modFn = modFn SupervisorOptions
    { supervisorName
    , supervisorIntensity               = 2
    , supervisorPeriodSeconds           = 5
    , supervisorRestartStrategy         = defSupervisorRestartStategy
    , supervisorProcessSpecList         = []
    , supervisorProcessTerminationOrder = OldestFirst
    , supervisorOnIntensityReached      = return ()
    , supervisorOnFailure               = const $ return ()
    }
  {-# INLINE buildSupervisorOptions #-}
  
  -- | Builds a 'SupervisorOptions' record with defaults to create a supervisor
  -- process, these defaults are:
  --
  -- * Intensity error tolerance is set to 1 error every 5 seconds
  --
  -- * A 'SupervisorRestartStrategy' of 'OneForOne'
  --
  -- * A 'ProcessTerminationOrder' of 'OldestFirst'
  --
  -- This function is intended to be used in combination with 'forkSupervisor'.
  --
  -- @since 0.1.0.0
  buildSupervisorOptionsWithDefaults
    :: Monad m
    => SupervisorName -- ^ Name used for telemetry purposes
    -> SupervisorOptions m
  buildSupervisorOptionsWithDefaults = flip buildSupervisorOptions id
  {-# INLINE buildSupervisorOptionsWithDefaults #-}
  
  -- | Builds a 'WorkerOptions' record, keeps the defaults from
  --   'buildWorkerOptionsWithDefaults' but allows overrides using lenses.
  --
  -- This function is intended to be used in combination with 'forkWorker'. See the
  -- capataz-simple-example project in the examples directory for a demonstration.
  --
  -- @since 0.1.0.0
  buildWorkerOptions
    :: Monad m
    => WorkerName -- ^ Name used for telemetry purposes
    -> m () -- ^ Process sub-routine to be supervised
    -> (WorkerOptions m -> WorkerOptions m) -- ^ Function to modify default worker
                                        -- options
    -> WorkerOptions m
  buildWorkerOptions workerName workerAction f =
    buildWorkerOptions1 workerName (const workerAction) f
  {-# INLINE buildWorkerOptions #-}
  
  -- | Builds a 'WorkerOptions' record, keeps the defaults from
  --   'buildWorkerOptionsWithDefaults' but allows overrides using lenses.
  --
  -- This function is intended to be used in combination with 'forkWorker'. See the
  -- capataz-simple-example project in the examples directory for a demonstration.
  --
  -- The given sub-routine will receive the 'WorkerId' as a parameter.
  --
  -- @since 0.2.0.0
  buildWorkerOptions1
    :: Monad m
    => WorkerName -- ^ Name used for telemetry purposes
    -> (WorkerId -> m ()) -- ^ Process sub-routine to be supervised
    -> (WorkerOptions m -> WorkerOptions m) -- ^ Function to modify default worker
                                        -- options
    -> WorkerOptions m
  buildWorkerOptions1 workerName workerAction f = f WorkerOptions
    { workerName
    , workerAction            = workerAction
    , workerOnFailure         = const $ return ()
    , workerOnCompletion      = return ()
    , workerOnTermination     = return ()
    , workerTerminationPolicy = defWorkerTerminationPolicy
    , workerRestartStrategy   = defWorkerRestartStrategy
    }
  {-# INLINE buildWorkerOptions1 #-}
  
  
  -- | Builds a 'WorkerOptions' record with defaults to create a worker process,
  -- the defaults are:
  --
  -- * A 'Transient' 'WorkerRestartStrategy'
  --
  -- * A 'WorkerTerminationPolicy' of a 3 seconds timeout
  --
  -- * A _completion_ callback that just returns unit
  --
  -- * A _termination_ callback that just returns unit
  --
  -- * A _failure_ callback that just returns unit
  --
  -- This function is intended to be used in combination with 'forkWorker', for creating a
  -- worker in an static supervision tree, use 'workerSpecWithDefaults' instead. See the
  -- capataz-simple-example project in the examples directory for a demonstration.
  --
  -- @since 0.1.0.0
  buildWorkerOptionsWithDefaults
    :: Monad m
    => WorkerName -- ^ Name used for telemetry purposes
    -> m () -- ^ 'IO' sub-routine to be supervised
    -> WorkerOptions m
  buildWorkerOptionsWithDefaults wName wAction =
    buildWorkerOptions wName wAction id
  {-# INLINE buildWorkerOptionsWithDefaults #-}
  
  -- | Used for debugging purposes
  getMaskingState :: MonadIO m => m UnsafeE.MaskingState
  getMaskingState = liftIO UnsafeE.getMaskingState
  
  -- | Given we want to capture async exceptions to send them back to a supervisor
  -- and we are running on masked states, we need to have a try that catches all
  -- kinds of exceptions
  unsafeTry :: (Exception e, MonadUnliftIO m) => m a -> m (Either e a)
  unsafeTry action = withRunInIO $ \run -> UnsafeE.try (run action)
  
  -- | Given unliftio wraps exceptions in 3 layers of Exceptions, and we are using
  -- vanilla exceptions, we need to make sure that we account for all different
  -- exception types
  fromAnyException :: Exception e => SomeException -> Maybe e
  fromAnyException ex = case UnsafeE.fromException ex of
    Just (UnsafeE.SomeAsyncException innerEx1) -> case cast innerEx1 of
      Just (AsyncExceptionWrapper innerEx2) -> cast innerEx2
      Nothing                               -> cast innerEx1
    Nothing -> fromException ex
  