{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE DeriveDataTypeable  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Distributed.Process.Supervisor.Types
-- Copyright   :  (c) Tim Watson 2012
-- License     :  BSD3 (see the file LICENSE)
--
-- Maintainer  :  Tim Watson <watson.timothy@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires concurrency)
--
-----------------------------------------------------------------------------
module Control.Distributed.Process.Supervisor.Types
  ( -- * Defining and Running a Supervisor
    ChildSpec(..)
  , ChildKey
  , ChildType(..)
  , ChildStopPolicy(..)
  , ChildStart(..)
  , RegisteredName(LocalName, CustomRegister)
  , RestartPolicy(..)
  , ChildRef(..)
  , isRunning
  , isRestarting
  , Child
  , StaticLabel
  , SupervisorPid
  , ChildPid
    -- * Limits and Defaults
  , MaxRestarts(..)
  , maxRestarts
  , RestartLimit(..)
  , limit
  , defaultLimits
  , RestartMode(..)
  , RestartOrder(..)
  , RestartStrategy(..)
  , ShutdownMode(..)
  , restartOne
  , restartAll
  , restartLeft
  , restartRight
    -- * Adding and Removing Children
  , AddChildResult(..)
  , StartChildResult(..)
  , StopChildResult(..)
  , DeleteChildResult(..)
  , RestartChildResult(..)
    -- * Additional (Misc) Types
  , SupervisorStats(..)
  , StartFailure(..)
  , ChildInitFailure(..)
  , MxSupervisor(..)
  ) where

import GHC.Generics
import Data.Typeable (Typeable)
import Data.Binary

import Control.DeepSeq (NFData)
import Control.Distributed.Process hiding (call)
import Control.Distributed.Process.Serializable()
import Control.Distributed.Process.Extras.Internal.Types
  ( ExitReason(..)
  )
import Control.Distributed.Process.Extras.Time
import Control.Distributed.Process.Extras.Internal.Primitives hiding (monitor)
import Control.Exception (Exception)
import Data.Hashable (Hashable)

-- aliases for api documentation purposes

-- | The "ProcessId" of a supervisor.
type SupervisorPid = ProcessId

-- | The "ProcessId" of a supervised /child/.
type ChildPid = ProcessId

-- | The maximum number of restarts a supervisor will tollerate, created by
-- evaluating "maxRestarts".
newtype MaxRestarts = MaxR { MaxRestarts -> Int
maxNumberOfRestarts :: Int }
  deriving (Typeable, (forall x. MaxRestarts -> Rep MaxRestarts x)
-> (forall x. Rep MaxRestarts x -> MaxRestarts)
-> Generic MaxRestarts
forall x. Rep MaxRestarts x -> MaxRestarts
forall x. MaxRestarts -> Rep MaxRestarts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MaxRestarts -> Rep MaxRestarts x
from :: forall x. MaxRestarts -> Rep MaxRestarts x
$cto :: forall x. Rep MaxRestarts x -> MaxRestarts
to :: forall x. Rep MaxRestarts x -> MaxRestarts
Generic, Int -> MaxRestarts -> ShowS
[MaxRestarts] -> ShowS
MaxRestarts -> String
(Int -> MaxRestarts -> ShowS)
-> (MaxRestarts -> String)
-> ([MaxRestarts] -> ShowS)
-> Show MaxRestarts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxRestarts -> ShowS
showsPrec :: Int -> MaxRestarts -> ShowS
$cshow :: MaxRestarts -> String
show :: MaxRestarts -> String
$cshowList :: [MaxRestarts] -> ShowS
showList :: [MaxRestarts] -> ShowS
Show, MaxRestarts -> MaxRestarts -> Bool
(MaxRestarts -> MaxRestarts -> Bool)
-> (MaxRestarts -> MaxRestarts -> Bool) -> Eq MaxRestarts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxRestarts -> MaxRestarts -> Bool
== :: MaxRestarts -> MaxRestarts -> Bool
$c/= :: MaxRestarts -> MaxRestarts -> Bool
/= :: MaxRestarts -> MaxRestarts -> Bool
Eq)
instance Binary MaxRestarts where
instance Hashable MaxRestarts where
instance NFData MaxRestarts where

-- | Smart constructor for @MaxRestarts@. The maximum restart count must be a
-- positive integer, otherwise you will see @error "MaxR must be >= 0"@.
maxRestarts :: Int -> MaxRestarts
maxRestarts :: Int -> MaxRestarts
maxRestarts Int
r | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = Int -> MaxRestarts
MaxR Int
r
              | Bool
otherwise = String -> MaxRestarts
forall a. HasCallStack => String -> a
error String
"MaxR must be >= 0"

-- | A compulsary limit on the number of restarts that a supervisor will
-- tolerate before it stops all child processes and then itself.
-- If > @MaxRestarts@ occur within the specified @TimeInterval@, the child
-- will be stopped. This prevents the supervisor from entering an infinite loop
-- of child process stops and restarts.
--
data RestartLimit =
  RestartLimit
  { RestartLimit -> MaxRestarts
maxR :: !MaxRestarts
  , RestartLimit -> TimeInterval
maxT :: !TimeInterval
  }
  deriving (Typeable, (forall x. RestartLimit -> Rep RestartLimit x)
-> (forall x. Rep RestartLimit x -> RestartLimit)
-> Generic RestartLimit
forall x. Rep RestartLimit x -> RestartLimit
forall x. RestartLimit -> Rep RestartLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RestartLimit -> Rep RestartLimit x
from :: forall x. RestartLimit -> Rep RestartLimit x
$cto :: forall x. Rep RestartLimit x -> RestartLimit
to :: forall x. Rep RestartLimit x -> RestartLimit
Generic, Int -> RestartLimit -> ShowS
[RestartLimit] -> ShowS
RestartLimit -> String
(Int -> RestartLimit -> ShowS)
-> (RestartLimit -> String)
-> ([RestartLimit] -> ShowS)
-> Show RestartLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestartLimit -> ShowS
showsPrec :: Int -> RestartLimit -> ShowS
$cshow :: RestartLimit -> String
show :: RestartLimit -> String
$cshowList :: [RestartLimit] -> ShowS
showList :: [RestartLimit] -> ShowS
Show)
instance Binary RestartLimit where
instance NFData RestartLimit where

-- | Smart constructor for "RestartLimit".
limit :: MaxRestarts -> TimeInterval -> RestartLimit
limit :: MaxRestarts -> TimeInterval -> RestartLimit
limit MaxRestarts
mr = MaxRestarts -> TimeInterval -> RestartLimit
RestartLimit MaxRestarts
mr

-- | Default "RestartLimit" of @MaxR 1@ within @Seconds 1@.
defaultLimits :: RestartLimit
defaultLimits :: RestartLimit
defaultLimits = MaxRestarts -> TimeInterval -> RestartLimit
limit (Int -> MaxRestarts
MaxR Int
1) (Int -> TimeInterval
seconds Int
1)

-- | Specifies the order in which a supervisor should apply restarts.
data RestartOrder = LeftToRight | RightToLeft
  deriving (Typeable, (forall x. RestartOrder -> Rep RestartOrder x)
-> (forall x. Rep RestartOrder x -> RestartOrder)
-> Generic RestartOrder
forall x. Rep RestartOrder x -> RestartOrder
forall x. RestartOrder -> Rep RestartOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RestartOrder -> Rep RestartOrder x
from :: forall x. RestartOrder -> Rep RestartOrder x
$cto :: forall x. Rep RestartOrder x -> RestartOrder
to :: forall x. Rep RestartOrder x -> RestartOrder
Generic, RestartOrder -> RestartOrder -> Bool
(RestartOrder -> RestartOrder -> Bool)
-> (RestartOrder -> RestartOrder -> Bool) -> Eq RestartOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestartOrder -> RestartOrder -> Bool
== :: RestartOrder -> RestartOrder -> Bool
$c/= :: RestartOrder -> RestartOrder -> Bool
/= :: RestartOrder -> RestartOrder -> Bool
Eq, Int -> RestartOrder -> ShowS
[RestartOrder] -> ShowS
RestartOrder -> String
(Int -> RestartOrder -> ShowS)
-> (RestartOrder -> String)
-> ([RestartOrder] -> ShowS)
-> Show RestartOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestartOrder -> ShowS
showsPrec :: Int -> RestartOrder -> ShowS
$cshow :: RestartOrder -> String
show :: RestartOrder -> String
$cshowList :: [RestartOrder] -> ShowS
showList :: [RestartOrder] -> ShowS
Show)
instance Binary RestartOrder where
instance Hashable RestartOrder where
instance NFData RestartOrder where

-- | Instructs a supervisor on how to restart its children.
data RestartMode =
    RestartEach     { RestartMode -> RestartOrder
order :: !RestartOrder }
    {- ^ stop then start each child sequentially, i.e., @foldlM stopThenStart children@ -}
  | RestartInOrder  { order :: !RestartOrder }
    {- ^ stop all children first, then restart them sequentially -}
  | RestartRevOrder { order :: !RestartOrder }
    {- ^ stop all children in the given order, but start them in reverse -}
  deriving (Typeable, (forall x. RestartMode -> Rep RestartMode x)
-> (forall x. Rep RestartMode x -> RestartMode)
-> Generic RestartMode
forall x. Rep RestartMode x -> RestartMode
forall x. RestartMode -> Rep RestartMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RestartMode -> Rep RestartMode x
from :: forall x. RestartMode -> Rep RestartMode x
$cto :: forall x. Rep RestartMode x -> RestartMode
to :: forall x. Rep RestartMode x -> RestartMode
Generic, Int -> RestartMode -> ShowS
[RestartMode] -> ShowS
RestartMode -> String
(Int -> RestartMode -> ShowS)
-> (RestartMode -> String)
-> ([RestartMode] -> ShowS)
-> Show RestartMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestartMode -> ShowS
showsPrec :: Int -> RestartMode -> ShowS
$cshow :: RestartMode -> String
show :: RestartMode -> String
$cshowList :: [RestartMode] -> ShowS
showList :: [RestartMode] -> ShowS
Show, RestartMode -> RestartMode -> Bool
(RestartMode -> RestartMode -> Bool)
-> (RestartMode -> RestartMode -> Bool) -> Eq RestartMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestartMode -> RestartMode -> Bool
== :: RestartMode -> RestartMode -> Bool
$c/= :: RestartMode -> RestartMode -> Bool
/= :: RestartMode -> RestartMode -> Bool
Eq)
instance Binary RestartMode where
instance Hashable RestartMode where
instance NFData RestartMode where

-- | Instructs a supervisor on how to instruct its children to stop running
-- when the supervisor itself is shutting down.
data ShutdownMode = SequentialShutdown !RestartOrder
                      | ParallelShutdown
  deriving (Typeable, (forall x. ShutdownMode -> Rep ShutdownMode x)
-> (forall x. Rep ShutdownMode x -> ShutdownMode)
-> Generic ShutdownMode
forall x. Rep ShutdownMode x -> ShutdownMode
forall x. ShutdownMode -> Rep ShutdownMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShutdownMode -> Rep ShutdownMode x
from :: forall x. ShutdownMode -> Rep ShutdownMode x
$cto :: forall x. Rep ShutdownMode x -> ShutdownMode
to :: forall x. Rep ShutdownMode x -> ShutdownMode
Generic, Int -> ShutdownMode -> ShowS
[ShutdownMode] -> ShowS
ShutdownMode -> String
(Int -> ShutdownMode -> ShowS)
-> (ShutdownMode -> String)
-> ([ShutdownMode] -> ShowS)
-> Show ShutdownMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShutdownMode -> ShowS
showsPrec :: Int -> ShutdownMode -> ShowS
$cshow :: ShutdownMode -> String
show :: ShutdownMode -> String
$cshowList :: [ShutdownMode] -> ShowS
showList :: [ShutdownMode] -> ShowS
Show, ShutdownMode -> ShutdownMode -> Bool
(ShutdownMode -> ShutdownMode -> Bool)
-> (ShutdownMode -> ShutdownMode -> Bool) -> Eq ShutdownMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShutdownMode -> ShutdownMode -> Bool
== :: ShutdownMode -> ShutdownMode -> Bool
$c/= :: ShutdownMode -> ShutdownMode -> Bool
/= :: ShutdownMode -> ShutdownMode -> Bool
Eq)
instance Binary ShutdownMode where
instance Hashable ShutdownMode where
instance NFData ShutdownMode where

-- | Strategy used by a supervisor to handle child restarts, whether due to
-- unexpected child failure or explicit restart requests from a client.
--
-- Some terminology: We refer to child processes managed by the same supervisor
-- as /siblings/. When restarting a child process, the 'RestartNone' policy
-- indicates that sibling processes should be left alone, whilst the 'RestartAll'
-- policy will cause /all/ children to be restarted (in the same order they were
-- started).
--
-- The other two restart strategies refer to /prior/ and /subsequent/
-- siblings, which describe's those children's configured position in insertion
-- order in the child specs. These latter modes allow one to control the order
-- in which siblings are restarted, and to exclude some siblings from restarting,
-- without having to resort to grouping them using a child supervisor.
--
data RestartStrategy =
    RestartOne
    { RestartStrategy -> RestartLimit
intensity        :: !RestartLimit
    } -- ^ restart only the failed child process
  | RestartAll
    { intensity        :: !RestartLimit
    , RestartStrategy -> RestartMode
mode             :: !RestartMode
    } -- ^ also restart all siblings
  | RestartLeft
    { intensity        :: !RestartLimit
    , mode             :: !RestartMode
    } -- ^ restart prior siblings (i.e., prior /start order/)
  | RestartRight
    { intensity        :: !RestartLimit
    , mode             :: !RestartMode
    } -- ^ restart subsequent siblings (i.e., subsequent /start order/)
  deriving (Typeable, (forall x. RestartStrategy -> Rep RestartStrategy x)
-> (forall x. Rep RestartStrategy x -> RestartStrategy)
-> Generic RestartStrategy
forall x. Rep RestartStrategy x -> RestartStrategy
forall x. RestartStrategy -> Rep RestartStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RestartStrategy -> Rep RestartStrategy x
from :: forall x. RestartStrategy -> Rep RestartStrategy x
$cto :: forall x. Rep RestartStrategy x -> RestartStrategy
to :: forall x. Rep RestartStrategy x -> RestartStrategy
Generic, Int -> RestartStrategy -> ShowS
[RestartStrategy] -> ShowS
RestartStrategy -> String
(Int -> RestartStrategy -> ShowS)
-> (RestartStrategy -> String)
-> ([RestartStrategy] -> ShowS)
-> Show RestartStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestartStrategy -> ShowS
showsPrec :: Int -> RestartStrategy -> ShowS
$cshow :: RestartStrategy -> String
show :: RestartStrategy -> String
$cshowList :: [RestartStrategy] -> ShowS
showList :: [RestartStrategy] -> ShowS
Show)
instance Binary RestartStrategy where
instance NFData RestartStrategy where

-- | Provides a default 'RestartStrategy' for @RestartOne@.
-- > restartOne = RestartOne defaultLimits
--
restartOne :: RestartStrategy
restartOne :: RestartStrategy
restartOne = RestartLimit -> RestartStrategy
RestartOne RestartLimit
defaultLimits

-- | Provides a default 'RestartStrategy' for @RestartAll@.
-- > restartOne = RestartAll defaultLimits (RestartEach LeftToRight)
--
restartAll :: RestartStrategy
restartAll :: RestartStrategy
restartAll = RestartLimit -> RestartMode -> RestartStrategy
RestartAll RestartLimit
defaultLimits (RestartOrder -> RestartMode
RestartEach RestartOrder
LeftToRight)

-- | Provides a default 'RestartStrategy' for @RestartLeft@.
-- > restartOne = RestartLeft defaultLimits (RestartEach LeftToRight)
--
restartLeft :: RestartStrategy
restartLeft :: RestartStrategy
restartLeft = RestartLimit -> RestartMode -> RestartStrategy
RestartLeft RestartLimit
defaultLimits (RestartOrder -> RestartMode
RestartEach RestartOrder
LeftToRight)

-- | Provides a default 'RestartStrategy' for @RestartRight@.
-- > restartOne = RestartRight defaultLimits (RestartEach LeftToRight)
--
restartRight :: RestartStrategy
restartRight :: RestartStrategy
restartRight = RestartLimit -> RestartMode -> RestartStrategy
RestartRight RestartLimit
defaultLimits (RestartOrder -> RestartMode
RestartEach RestartOrder
LeftToRight)

-- | Identifies a child process by name.
type ChildKey = String

-- | A reference to a (possibly running) child.
data ChildRef =
    ChildRunning !ChildPid     -- ^ a reference to the (currently running) child
  | ChildRunningExtra !ChildPid !Message -- ^ also a currently running child, with /extra/ child info
  | ChildRestarting !ChildPid  -- ^ a reference to the /old/ (previous) child (now restarting)
  | ChildStopped               -- ^ indicates the child is not currently running
  | ChildStartIgnored          -- ^ a non-temporary child exited with 'ChildInitIgnore'
  deriving (Typeable, (forall x. ChildRef -> Rep ChildRef x)
-> (forall x. Rep ChildRef x -> ChildRef) -> Generic ChildRef
forall x. Rep ChildRef x -> ChildRef
forall x. ChildRef -> Rep ChildRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChildRef -> Rep ChildRef x
from :: forall x. ChildRef -> Rep ChildRef x
$cto :: forall x. Rep ChildRef x -> ChildRef
to :: forall x. Rep ChildRef x -> ChildRef
Generic, Int -> ChildRef -> ShowS
[ChildRef] -> ShowS
ChildRef -> String
(Int -> ChildRef -> ShowS)
-> (ChildRef -> String) -> ([ChildRef] -> ShowS) -> Show ChildRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildRef -> ShowS
showsPrec :: Int -> ChildRef -> ShowS
$cshow :: ChildRef -> String
show :: ChildRef -> String
$cshowList :: [ChildRef] -> ShowS
showList :: [ChildRef] -> ShowS
Show)
instance Binary ChildRef where
instance NFData ChildRef where

instance Eq ChildRef where
  ChildRunning      ChildPid
p1   == :: ChildRef -> ChildRef -> Bool
== ChildRunning      ChildPid
p2   = ChildPid
p1 ChildPid -> ChildPid -> Bool
forall a. Eq a => a -> a -> Bool
== ChildPid
p2
  ChildRunningExtra ChildPid
p1 Message
_ == ChildRunningExtra ChildPid
p2 Message
_ = ChildPid
p1 ChildPid -> ChildPid -> Bool
forall a. Eq a => a -> a -> Bool
== ChildPid
p2
  ChildRestarting   ChildPid
p1   == ChildRestarting   ChildPid
p2   = ChildPid
p1 ChildPid -> ChildPid -> Bool
forall a. Eq a => a -> a -> Bool
== ChildPid
p2
  ChildRef
ChildStopped           == ChildRef
ChildStopped           = Bool
True
  ChildRef
ChildStartIgnored      == ChildRef
ChildStartIgnored      = Bool
True
  ChildRef
_                      == ChildRef
_                      = Bool
False

-- | @True@ if "ChildRef" is running.
isRunning :: ChildRef -> Bool
isRunning :: ChildRef -> Bool
isRunning (ChildRunning ChildPid
_)        = Bool
True
isRunning (ChildRunningExtra ChildPid
_ Message
_) = Bool
True
isRunning ChildRef
_                       = Bool
False

-- | @True@ if "ChildRef" is restarting
isRestarting :: ChildRef -> Bool
isRestarting :: ChildRef -> Bool
isRestarting (ChildRestarting ChildPid
_) = Bool
True
isRestarting ChildRef
_                   = Bool
False

instance Resolvable ChildRef where
  resolve :: ChildRef -> Process (Maybe ChildPid)
resolve (ChildRunning ChildPid
pid)        = Maybe ChildPid -> Process (Maybe ChildPid)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChildPid -> Process (Maybe ChildPid))
-> Maybe ChildPid -> Process (Maybe ChildPid)
forall a b. (a -> b) -> a -> b
$ ChildPid -> Maybe ChildPid
forall a. a -> Maybe a
Just ChildPid
pid
  resolve (ChildRunningExtra ChildPid
pid Message
_) = Maybe ChildPid -> Process (Maybe ChildPid)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChildPid -> Process (Maybe ChildPid))
-> Maybe ChildPid -> Process (Maybe ChildPid)
forall a b. (a -> b) -> a -> b
$ ChildPid -> Maybe ChildPid
forall a. a -> Maybe a
Just ChildPid
pid
  resolve ChildRef
_                         = Maybe ChildPid -> Process (Maybe ChildPid)
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ChildPid
forall a. Maybe a
Nothing

-- these look a bit odd, but we basically want to avoid resolving
-- or sending to (ChildRestarting oldPid)
instance Routable ChildRef where
  sendTo :: forall m.
(Serializable m, Resolvable ChildRef) =>
ChildRef -> m -> Process ()
sendTo (ChildRunning ChildPid
addr) = ChildPid -> m -> Process ()
forall m.
(Serializable m, Resolvable ChildPid) =>
ChildPid -> m -> Process ()
forall a m.
(Routable a, Serializable m, Resolvable a) =>
a -> m -> Process ()
sendTo ChildPid
addr
  sendTo ChildRef
_                   = String -> m -> Process ()
forall a. HasCallStack => String -> a
error String
"invalid address for child process"

  unsafeSendTo :: forall m.
(NFSerializable m, Resolvable ChildRef) =>
ChildRef -> m -> Process ()
unsafeSendTo (ChildRunning ChildPid
ch) = ChildPid -> m -> Process ()
forall a m.
(Routable a, NFSerializable m, Resolvable a) =>
a -> m -> Process ()
forall m.
(NFSerializable m, Resolvable ChildPid) =>
ChildPid -> m -> Process ()
unsafeSendTo ChildPid
ch
  unsafeSendTo ChildRef
_                 = String -> m -> Process ()
forall a. HasCallStack => String -> a
error String
"invalid address for child process"

-- | Specifies whether the child is another supervisor, or a worker.
data ChildType = Worker | Supervisor
  deriving (Typeable, (forall x. ChildType -> Rep ChildType x)
-> (forall x. Rep ChildType x -> ChildType) -> Generic ChildType
forall x. Rep ChildType x -> ChildType
forall x. ChildType -> Rep ChildType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChildType -> Rep ChildType x
from :: forall x. ChildType -> Rep ChildType x
$cto :: forall x. Rep ChildType x -> ChildType
to :: forall x. Rep ChildType x -> ChildType
Generic, Int -> ChildType -> ShowS
[ChildType] -> ShowS
ChildType -> String
(Int -> ChildType -> ShowS)
-> (ChildType -> String)
-> ([ChildType] -> ShowS)
-> Show ChildType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildType -> ShowS
showsPrec :: Int -> ChildType -> ShowS
$cshow :: ChildType -> String
show :: ChildType -> String
$cshowList :: [ChildType] -> ShowS
showList :: [ChildType] -> ShowS
Show, ChildType -> ChildType -> Bool
(ChildType -> ChildType -> Bool)
-> (ChildType -> ChildType -> Bool) -> Eq ChildType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChildType -> ChildType -> Bool
== :: ChildType -> ChildType -> Bool
$c/= :: ChildType -> ChildType -> Bool
/= :: ChildType -> ChildType -> Bool
Eq)
instance Binary ChildType where
instance NFData ChildType where

-- | Describes when a stopped child process should be restarted.
data RestartPolicy =
    Permanent  -- ^ a permanent child will always be restarted
  | Temporary  -- ^ a temporary child will /never/ be restarted
  | Transient  -- ^ A transient child will be restarted only if it stops abnormally
  | Intrinsic  -- ^ as 'Transient', but if the child exits normally, the supervisor also exits normally
  deriving (Typeable, (forall x. RestartPolicy -> Rep RestartPolicy x)
-> (forall x. Rep RestartPolicy x -> RestartPolicy)
-> Generic RestartPolicy
forall x. Rep RestartPolicy x -> RestartPolicy
forall x. RestartPolicy -> Rep RestartPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RestartPolicy -> Rep RestartPolicy x
from :: forall x. RestartPolicy -> Rep RestartPolicy x
$cto :: forall x. Rep RestartPolicy x -> RestartPolicy
to :: forall x. Rep RestartPolicy x -> RestartPolicy
Generic, RestartPolicy -> RestartPolicy -> Bool
(RestartPolicy -> RestartPolicy -> Bool)
-> (RestartPolicy -> RestartPolicy -> Bool) -> Eq RestartPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestartPolicy -> RestartPolicy -> Bool
== :: RestartPolicy -> RestartPolicy -> Bool
$c/= :: RestartPolicy -> RestartPolicy -> Bool
/= :: RestartPolicy -> RestartPolicy -> Bool
Eq, Int -> RestartPolicy -> ShowS
[RestartPolicy] -> ShowS
RestartPolicy -> String
(Int -> RestartPolicy -> ShowS)
-> (RestartPolicy -> String)
-> ([RestartPolicy] -> ShowS)
-> Show RestartPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestartPolicy -> ShowS
showsPrec :: Int -> RestartPolicy -> ShowS
$cshow :: RestartPolicy -> String
show :: RestartPolicy -> String
$cshowList :: [RestartPolicy] -> ShowS
showList :: [RestartPolicy] -> ShowS
Show)
instance Binary RestartPolicy where
instance NFData RestartPolicy where

-- | Governs how the supervisor will instruct child processes to stop.
data ChildStopPolicy =
    StopTimeout !Delay
  | StopImmediately
  deriving (Typeable, (forall x. ChildStopPolicy -> Rep ChildStopPolicy x)
-> (forall x. Rep ChildStopPolicy x -> ChildStopPolicy)
-> Generic ChildStopPolicy
forall x. Rep ChildStopPolicy x -> ChildStopPolicy
forall x. ChildStopPolicy -> Rep ChildStopPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChildStopPolicy -> Rep ChildStopPolicy x
from :: forall x. ChildStopPolicy -> Rep ChildStopPolicy x
$cto :: forall x. Rep ChildStopPolicy x -> ChildStopPolicy
to :: forall x. Rep ChildStopPolicy x -> ChildStopPolicy
Generic, ChildStopPolicy -> ChildStopPolicy -> Bool
(ChildStopPolicy -> ChildStopPolicy -> Bool)
-> (ChildStopPolicy -> ChildStopPolicy -> Bool)
-> Eq ChildStopPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChildStopPolicy -> ChildStopPolicy -> Bool
== :: ChildStopPolicy -> ChildStopPolicy -> Bool
$c/= :: ChildStopPolicy -> ChildStopPolicy -> Bool
/= :: ChildStopPolicy -> ChildStopPolicy -> Bool
Eq, Int -> ChildStopPolicy -> ShowS
[ChildStopPolicy] -> ShowS
ChildStopPolicy -> String
(Int -> ChildStopPolicy -> ShowS)
-> (ChildStopPolicy -> String)
-> ([ChildStopPolicy] -> ShowS)
-> Show ChildStopPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildStopPolicy -> ShowS
showsPrec :: Int -> ChildStopPolicy -> ShowS
$cshow :: ChildStopPolicy -> String
show :: ChildStopPolicy -> String
$cshowList :: [ChildStopPolicy] -> ShowS
showList :: [ChildStopPolicy] -> ShowS
Show)
instance Binary ChildStopPolicy where
instance NFData ChildStopPolicy where

-- | Represents a registered name, for registration /locally/ using the
-- @register@ primitive, or via a @Closure (ChildPid -> Process ())@ such that
-- registration can be performed using alternative process registries.
data RegisteredName =
    LocalName          !String
  | CustomRegister     !(Closure (ChildPid -> Process ()))
  deriving (Typeable, (forall x. RegisteredName -> Rep RegisteredName x)
-> (forall x. Rep RegisteredName x -> RegisteredName)
-> Generic RegisteredName
forall x. Rep RegisteredName x -> RegisteredName
forall x. RegisteredName -> Rep RegisteredName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegisteredName -> Rep RegisteredName x
from :: forall x. RegisteredName -> Rep RegisteredName x
$cto :: forall x. Rep RegisteredName x -> RegisteredName
to :: forall x. Rep RegisteredName x -> RegisteredName
Generic)
instance Binary RegisteredName where
instance NFData RegisteredName where

instance Show RegisteredName where
  show :: RegisteredName -> String
show (CustomRegister Closure (ChildPid -> Process ())
_) = String
"Custom Register"
  show (LocalName      String
n) = String
n

-- | Defines the way in which a child process is to be started.
data ChildStart =
    RunClosure !(Closure (Process ()))
  | CreateHandle !(Closure (SupervisorPid -> Process (ChildPid, Message)))
  deriving (Typeable, (forall x. ChildStart -> Rep ChildStart x)
-> (forall x. Rep ChildStart x -> ChildStart) -> Generic ChildStart
forall x. Rep ChildStart x -> ChildStart
forall x. ChildStart -> Rep ChildStart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChildStart -> Rep ChildStart x
from :: forall x. ChildStart -> Rep ChildStart x
$cto :: forall x. Rep ChildStart x -> ChildStart
to :: forall x. Rep ChildStart x -> ChildStart
Generic, Int -> ChildStart -> ShowS
[ChildStart] -> ShowS
ChildStart -> String
(Int -> ChildStart -> ShowS)
-> (ChildStart -> String)
-> ([ChildStart] -> ShowS)
-> Show ChildStart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildStart -> ShowS
showsPrec :: Int -> ChildStart -> ShowS
$cshow :: ChildStart -> String
show :: ChildStart -> String
$cshowList :: [ChildStart] -> ShowS
showList :: [ChildStart] -> ShowS
Show)
instance Binary ChildStart where
instance NFData ChildStart  where

-- | Specification for a child process. The child must be uniquely identified
-- by it's @childKey@ within the supervisor. The supervisor will start the child
-- itself, therefore @childRun@ should contain the child process' implementation
-- e.g., if the child is a long running server, this would be the server /loop/,
-- as with e.g., @ManagedProces.start@.
data ChildSpec = ChildSpec {
    ChildSpec -> String
childKey          :: !ChildKey
  , ChildSpec -> ChildType
childType         :: !ChildType
  , ChildSpec -> RestartPolicy
childRestart      :: !RestartPolicy
  , ChildSpec -> Maybe TimeInterval
childRestartDelay :: !(Maybe TimeInterval)
  , ChildSpec -> ChildStopPolicy
childStop         :: !ChildStopPolicy
  , ChildSpec -> ChildStart
childStart        :: !ChildStart
  , ChildSpec -> Maybe RegisteredName
childRegName      :: !(Maybe RegisteredName)
  } deriving (Typeable, (forall x. ChildSpec -> Rep ChildSpec x)
-> (forall x. Rep ChildSpec x -> ChildSpec) -> Generic ChildSpec
forall x. Rep ChildSpec x -> ChildSpec
forall x. ChildSpec -> Rep ChildSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChildSpec -> Rep ChildSpec x
from :: forall x. ChildSpec -> Rep ChildSpec x
$cto :: forall x. Rep ChildSpec x -> ChildSpec
to :: forall x. Rep ChildSpec x -> ChildSpec
Generic, Int -> ChildSpec -> ShowS
[ChildSpec] -> ShowS
ChildSpec -> String
(Int -> ChildSpec -> ShowS)
-> (ChildSpec -> String)
-> ([ChildSpec] -> ShowS)
-> Show ChildSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildSpec -> ShowS
showsPrec :: Int -> ChildSpec -> ShowS
$cshow :: ChildSpec -> String
show :: ChildSpec -> String
$cshowList :: [ChildSpec] -> ShowS
showList :: [ChildSpec] -> ShowS
Show)
instance Binary ChildSpec where
instance NFData ChildSpec where

-- | A child process failure during init will be reported using this datum
data ChildInitFailure =
    ChildInitFailure !String -- ^ The init failed with the corresponding message
  | ChildInitIgnore -- ^ The child told the supervisor to ignore its startup procedure
  deriving (Typeable, (forall x. ChildInitFailure -> Rep ChildInitFailure x)
-> (forall x. Rep ChildInitFailure x -> ChildInitFailure)
-> Generic ChildInitFailure
forall x. Rep ChildInitFailure x -> ChildInitFailure
forall x. ChildInitFailure -> Rep ChildInitFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChildInitFailure -> Rep ChildInitFailure x
from :: forall x. ChildInitFailure -> Rep ChildInitFailure x
$cto :: forall x. Rep ChildInitFailure x -> ChildInitFailure
to :: forall x. Rep ChildInitFailure x -> ChildInitFailure
Generic, Int -> ChildInitFailure -> ShowS
[ChildInitFailure] -> ShowS
ChildInitFailure -> String
(Int -> ChildInitFailure -> ShowS)
-> (ChildInitFailure -> String)
-> ([ChildInitFailure] -> ShowS)
-> Show ChildInitFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildInitFailure -> ShowS
showsPrec :: Int -> ChildInitFailure -> ShowS
$cshow :: ChildInitFailure -> String
show :: ChildInitFailure -> String
$cshowList :: [ChildInitFailure] -> ShowS
showList :: [ChildInitFailure] -> ShowS
Show)
instance Binary ChildInitFailure where
instance NFData ChildInitFailure where
instance Exception ChildInitFailure where

-- | Statistics about a running supervisor
data SupervisorStats = SupervisorStats {
    SupervisorStats -> Int
_children          :: Int
  , SupervisorStats -> Int
_supervisors       :: Int
  , SupervisorStats -> Int
_workers           :: Int
  , SupervisorStats -> Int
_running           :: Int
  , SupervisorStats -> Int
_activeSupervisors :: Int
  , SupervisorStats -> Int
_activeWorkers     :: Int
  -- TODO: usage/restart/freq stats
  , SupervisorStats -> Int
totalRestarts      :: Int
  } deriving (Typeable, (forall x. SupervisorStats -> Rep SupervisorStats x)
-> (forall x. Rep SupervisorStats x -> SupervisorStats)
-> Generic SupervisorStats
forall x. Rep SupervisorStats x -> SupervisorStats
forall x. SupervisorStats -> Rep SupervisorStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SupervisorStats -> Rep SupervisorStats x
from :: forall x. SupervisorStats -> Rep SupervisorStats x
$cto :: forall x. Rep SupervisorStats x -> SupervisorStats
to :: forall x. Rep SupervisorStats x -> SupervisorStats
Generic, Int -> SupervisorStats -> ShowS
[SupervisorStats] -> ShowS
SupervisorStats -> String
(Int -> SupervisorStats -> ShowS)
-> (SupervisorStats -> String)
-> ([SupervisorStats] -> ShowS)
-> Show SupervisorStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SupervisorStats -> ShowS
showsPrec :: Int -> SupervisorStats -> ShowS
$cshow :: SupervisorStats -> String
show :: SupervisorStats -> String
$cshowList :: [SupervisorStats] -> ShowS
showList :: [SupervisorStats] -> ShowS
Show)
instance Binary SupervisorStats where
instance NFData SupervisorStats where

-- | Supervisor event data published to the management API
data MxSupervisor =
    SupervisorBranchRestarted
    {
      MxSupervisor -> ChildPid
supervisorPid  :: SupervisorPid
    , MxSupervisor -> String
childSpecKey   :: ChildKey
    , MxSupervisor -> DiedReason
diedReason     :: DiedReason
    , MxSupervisor -> RestartStrategy
branchStrategy :: RestartStrategy
    } -- ^ A branch restart took place
  | SupervisedChildRestarting
    { supervisorPid :: SupervisorPid
    , MxSupervisor -> Maybe ChildPid
childInScope  :: Maybe ChildPid
    , childSpecKey  :: ChildKey
    , MxSupervisor -> ExitReason
exitReason    :: ExitReason
    } -- ^ A child is being restarted
  | SupervisedChildStarted
    { supervisorPid :: SupervisorPid
    , MxSupervisor -> ChildRef
childRef      :: ChildRef
    , childSpecKey  :: ChildKey
    } -- ^ A child has been started
  | SupervisedChildStartFailure
    { supervisorPid :: SupervisorPid
    , MxSupervisor -> StartFailure
startFailure  :: StartFailure
    , childSpecKey  :: ChildKey
    } -- ^ A child failed to start
  | SupervisedChildDied
    { supervisorPid :: SupervisorPid
    , MxSupervisor -> ChildPid
childPid      :: ChildPid
    , exitReason    :: ExitReason
    } -- ^ A child process death was detected
  | SupervisedChildInitFailed
    { supervisorPid :: SupervisorPid
    , childPid      :: ChildPid
    , MxSupervisor -> ChildInitFailure
initFailure   :: ChildInitFailure
    } -- ^ A child failed during init
  | SupervisedChildStopped
    { supervisorPid :: SupervisorPid
    , childRef      :: ChildRef
    , diedReason    :: DiedReason
    } -- ^ A child has been stopped
  | SupervisorShutdown
    { supervisorPid :: SupervisorPid
    , MxSupervisor -> ShutdownMode
shutdownMode  :: ShutdownMode
    , MxSupervisor -> ExitReason
exitRason     :: ExitReason
    } -- ^ A supervisor is shutting down
    deriving (Typeable, (forall x. MxSupervisor -> Rep MxSupervisor x)
-> (forall x. Rep MxSupervisor x -> MxSupervisor)
-> Generic MxSupervisor
forall x. Rep MxSupervisor x -> MxSupervisor
forall x. MxSupervisor -> Rep MxSupervisor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MxSupervisor -> Rep MxSupervisor x
from :: forall x. MxSupervisor -> Rep MxSupervisor x
$cto :: forall x. Rep MxSupervisor x -> MxSupervisor
to :: forall x. Rep MxSupervisor x -> MxSupervisor
Generic, Int -> MxSupervisor -> ShowS
[MxSupervisor] -> ShowS
MxSupervisor -> String
(Int -> MxSupervisor -> ShowS)
-> (MxSupervisor -> String)
-> ([MxSupervisor] -> ShowS)
-> Show MxSupervisor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MxSupervisor -> ShowS
showsPrec :: Int -> MxSupervisor -> ShowS
$cshow :: MxSupervisor -> String
show :: MxSupervisor -> String
$cshowList :: [MxSupervisor] -> ShowS
showList :: [MxSupervisor] -> ShowS
Show)
instance Binary MxSupervisor where
instance NFData MxSupervisor where

-- | Static labels (in the remote table) are strings.
type StaticLabel = String

-- | Provides failure information when (re-)start failure is indicated.
data StartFailure =
    StartFailureDuplicateChild !ChildRef -- ^ a child with this 'ChildKey' already exists
  | StartFailureAlreadyRunning !ChildRef -- ^ the child is already up and running
  | StartFailureBadClosure !StaticLabel  -- ^ a closure cannot be resolved
  | StartFailureDied !DiedReason         -- ^ a child died (almost) immediately on starting
  deriving (Typeable, (forall x. StartFailure -> Rep StartFailure x)
-> (forall x. Rep StartFailure x -> StartFailure)
-> Generic StartFailure
forall x. Rep StartFailure x -> StartFailure
forall x. StartFailure -> Rep StartFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StartFailure -> Rep StartFailure x
from :: forall x. StartFailure -> Rep StartFailure x
$cto :: forall x. Rep StartFailure x -> StartFailure
to :: forall x. Rep StartFailure x -> StartFailure
Generic, Int -> StartFailure -> ShowS
[StartFailure] -> ShowS
StartFailure -> String
(Int -> StartFailure -> ShowS)
-> (StartFailure -> String)
-> ([StartFailure] -> ShowS)
-> Show StartFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartFailure -> ShowS
showsPrec :: Int -> StartFailure -> ShowS
$cshow :: StartFailure -> String
show :: StartFailure -> String
$cshowList :: [StartFailure] -> ShowS
showList :: [StartFailure] -> ShowS
Show, StartFailure -> StartFailure -> Bool
(StartFailure -> StartFailure -> Bool)
-> (StartFailure -> StartFailure -> Bool) -> Eq StartFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartFailure -> StartFailure -> Bool
== :: StartFailure -> StartFailure -> Bool
$c/= :: StartFailure -> StartFailure -> Bool
/= :: StartFailure -> StartFailure -> Bool
Eq)
instance Binary StartFailure where
instance NFData StartFailure where

-- | The result of a call to 'removeChild'.
data DeleteChildResult =
    ChildDeleted              -- ^ the child specification was successfully removed
  | ChildNotFound             -- ^ the child specification was not found
  | ChildNotStopped !ChildRef -- ^ the child was not removed, as it was not stopped.
  deriving (Typeable, (forall x. DeleteChildResult -> Rep DeleteChildResult x)
-> (forall x. Rep DeleteChildResult x -> DeleteChildResult)
-> Generic DeleteChildResult
forall x. Rep DeleteChildResult x -> DeleteChildResult
forall x. DeleteChildResult -> Rep DeleteChildResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeleteChildResult -> Rep DeleteChildResult x
from :: forall x. DeleteChildResult -> Rep DeleteChildResult x
$cto :: forall x. Rep DeleteChildResult x -> DeleteChildResult
to :: forall x. Rep DeleteChildResult x -> DeleteChildResult
Generic, Int -> DeleteChildResult -> ShowS
[DeleteChildResult] -> ShowS
DeleteChildResult -> String
(Int -> DeleteChildResult -> ShowS)
-> (DeleteChildResult -> String)
-> ([DeleteChildResult] -> ShowS)
-> Show DeleteChildResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteChildResult -> ShowS
showsPrec :: Int -> DeleteChildResult -> ShowS
$cshow :: DeleteChildResult -> String
show :: DeleteChildResult -> String
$cshowList :: [DeleteChildResult] -> ShowS
showList :: [DeleteChildResult] -> ShowS
Show, DeleteChildResult -> DeleteChildResult -> Bool
(DeleteChildResult -> DeleteChildResult -> Bool)
-> (DeleteChildResult -> DeleteChildResult -> Bool)
-> Eq DeleteChildResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteChildResult -> DeleteChildResult -> Bool
== :: DeleteChildResult -> DeleteChildResult -> Bool
$c/= :: DeleteChildResult -> DeleteChildResult -> Bool
/= :: DeleteChildResult -> DeleteChildResult -> Bool
Eq)
instance Binary DeleteChildResult where
instance NFData DeleteChildResult where

-- | A child represented as a @(ChildRef, ChildSpec)@ pair.
type Child = (ChildRef, ChildSpec)

-- exported result types of internal APIs

-- | The result of an @addChild@ request.
data AddChildResult =
    ChildAdded         !ChildRef  -- ^ The child was added correctly
  | ChildFailedToStart !StartFailure -- ^ The child failed to start
  deriving (Typeable, (forall x. AddChildResult -> Rep AddChildResult x)
-> (forall x. Rep AddChildResult x -> AddChildResult)
-> Generic AddChildResult
forall x. Rep AddChildResult x -> AddChildResult
forall x. AddChildResult -> Rep AddChildResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddChildResult -> Rep AddChildResult x
from :: forall x. AddChildResult -> Rep AddChildResult x
$cto :: forall x. Rep AddChildResult x -> AddChildResult
to :: forall x. Rep AddChildResult x -> AddChildResult
Generic, Int -> AddChildResult -> ShowS
[AddChildResult] -> ShowS
AddChildResult -> String
(Int -> AddChildResult -> ShowS)
-> (AddChildResult -> String)
-> ([AddChildResult] -> ShowS)
-> Show AddChildResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddChildResult -> ShowS
showsPrec :: Int -> AddChildResult -> ShowS
$cshow :: AddChildResult -> String
show :: AddChildResult -> String
$cshowList :: [AddChildResult] -> ShowS
showList :: [AddChildResult] -> ShowS
Show, AddChildResult -> AddChildResult -> Bool
(AddChildResult -> AddChildResult -> Bool)
-> (AddChildResult -> AddChildResult -> Bool) -> Eq AddChildResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddChildResult -> AddChildResult -> Bool
== :: AddChildResult -> AddChildResult -> Bool
$c/= :: AddChildResult -> AddChildResult -> Bool
/= :: AddChildResult -> AddChildResult -> Bool
Eq)
instance Binary AddChildResult where
instance NFData AddChildResult where

-- | The result of a @startChild@ request.
data StartChildResult =
    ChildStartOk        !ChildRef     -- ^ The child started successfully
  | ChildStartFailed    !StartFailure -- ^ The child failed to start
  | ChildStartUnknownId               -- ^ The child key was not recognised by the supervisor
  deriving (Typeable, (forall x. StartChildResult -> Rep StartChildResult x)
-> (forall x. Rep StartChildResult x -> StartChildResult)
-> Generic StartChildResult
forall x. Rep StartChildResult x -> StartChildResult
forall x. StartChildResult -> Rep StartChildResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StartChildResult -> Rep StartChildResult x
from :: forall x. StartChildResult -> Rep StartChildResult x
$cto :: forall x. Rep StartChildResult x -> StartChildResult
to :: forall x. Rep StartChildResult x -> StartChildResult
Generic, Int -> StartChildResult -> ShowS
[StartChildResult] -> ShowS
StartChildResult -> String
(Int -> StartChildResult -> ShowS)
-> (StartChildResult -> String)
-> ([StartChildResult] -> ShowS)
-> Show StartChildResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartChildResult -> ShowS
showsPrec :: Int -> StartChildResult -> ShowS
$cshow :: StartChildResult -> String
show :: StartChildResult -> String
$cshowList :: [StartChildResult] -> ShowS
showList :: [StartChildResult] -> ShowS
Show, StartChildResult -> StartChildResult -> Bool
(StartChildResult -> StartChildResult -> Bool)
-> (StartChildResult -> StartChildResult -> Bool)
-> Eq StartChildResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartChildResult -> StartChildResult -> Bool
== :: StartChildResult -> StartChildResult -> Bool
$c/= :: StartChildResult -> StartChildResult -> Bool
/= :: StartChildResult -> StartChildResult -> Bool
Eq)
instance Binary StartChildResult where
instance NFData StartChildResult where

-- | The result of a @restartChild@ request.
data RestartChildResult =
    ChildRestartOk     !ChildRef     -- ^ The child restarted successfully
  | ChildRestartFailed !StartFailure -- ^ The child failed to restart
  | ChildRestartUnknownId            -- ^ The child key was not recognised by the supervisor
  deriving (Typeable, (forall x. RestartChildResult -> Rep RestartChildResult x)
-> (forall x. Rep RestartChildResult x -> RestartChildResult)
-> Generic RestartChildResult
forall x. Rep RestartChildResult x -> RestartChildResult
forall x. RestartChildResult -> Rep RestartChildResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RestartChildResult -> Rep RestartChildResult x
from :: forall x. RestartChildResult -> Rep RestartChildResult x
$cto :: forall x. Rep RestartChildResult x -> RestartChildResult
to :: forall x. Rep RestartChildResult x -> RestartChildResult
Generic, Int -> RestartChildResult -> ShowS
[RestartChildResult] -> ShowS
RestartChildResult -> String
(Int -> RestartChildResult -> ShowS)
-> (RestartChildResult -> String)
-> ([RestartChildResult] -> ShowS)
-> Show RestartChildResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestartChildResult -> ShowS
showsPrec :: Int -> RestartChildResult -> ShowS
$cshow :: RestartChildResult -> String
show :: RestartChildResult -> String
$cshowList :: [RestartChildResult] -> ShowS
showList :: [RestartChildResult] -> ShowS
Show, RestartChildResult -> RestartChildResult -> Bool
(RestartChildResult -> RestartChildResult -> Bool)
-> (RestartChildResult -> RestartChildResult -> Bool)
-> Eq RestartChildResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestartChildResult -> RestartChildResult -> Bool
== :: RestartChildResult -> RestartChildResult -> Bool
$c/= :: RestartChildResult -> RestartChildResult -> Bool
/= :: RestartChildResult -> RestartChildResult -> Bool
Eq)

instance Binary RestartChildResult where
instance NFData RestartChildResult where

-- | The result of a @stopChild@ request.
data StopChildResult =
    StopChildOk -- ^ The child was stopped successfully
  | StopChildUnknownId -- ^ The child key was not recognised by the supervisor
  deriving (Typeable, (forall x. StopChildResult -> Rep StopChildResult x)
-> (forall x. Rep StopChildResult x -> StopChildResult)
-> Generic StopChildResult
forall x. Rep StopChildResult x -> StopChildResult
forall x. StopChildResult -> Rep StopChildResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StopChildResult -> Rep StopChildResult x
from :: forall x. StopChildResult -> Rep StopChildResult x
$cto :: forall x. Rep StopChildResult x -> StopChildResult
to :: forall x. Rep StopChildResult x -> StopChildResult
Generic, Int -> StopChildResult -> ShowS
[StopChildResult] -> ShowS
StopChildResult -> String
(Int -> StopChildResult -> ShowS)
-> (StopChildResult -> String)
-> ([StopChildResult] -> ShowS)
-> Show StopChildResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StopChildResult -> ShowS
showsPrec :: Int -> StopChildResult -> ShowS
$cshow :: StopChildResult -> String
show :: StopChildResult -> String
$cshowList :: [StopChildResult] -> ShowS
showList :: [StopChildResult] -> ShowS
Show, StopChildResult -> StopChildResult -> Bool
(StopChildResult -> StopChildResult -> Bool)
-> (StopChildResult -> StopChildResult -> Bool)
-> Eq StopChildResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StopChildResult -> StopChildResult -> Bool
== :: StopChildResult -> StopChildResult -> Bool
$c/= :: StopChildResult -> StopChildResult -> Bool
/= :: StopChildResult -> StopChildResult -> Bool
Eq)
instance Binary StopChildResult where
instance NFData StopChildResult where