{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
module Control.Distributed.Process.Internal.Types
(
NodeId(..)
, LocalProcessId(..)
, ProcessId(..)
, Identifier(..)
, nodeOf
, firstNonReservedProcessId
, nullProcessId
, LocalNode(..)
, LocalNodeState(..)
, ValidLocalNodeState(..)
, NodeClosedException(..)
, withValidLocalState
, modifyValidLocalState
, modifyValidLocalState_
, Tracer(..)
, MxEventBus(..)
, LocalProcess(..)
, LocalProcessState(..)
, Process(..)
, runLocalProcess
, ImplicitReconnect(..)
, LocalSendPortId
, SendPortId(..)
, TypedChannel(..)
, SendPort(..)
, ReceivePort(..)
, Message(..)
, isEncoded
, createMessage
, createUnencodedMessage
, unsafeCreateUnencodedMessage
, messageToPayload
, payloadToMessage
, MonitorRef(..)
, ProcessMonitorNotification(..)
, NodeMonitorNotification(..)
, PortMonitorNotification(..)
, ProcessExitException(..)
, ProcessLinkException(..)
, NodeLinkException(..)
, PortLinkException(..)
, ProcessRegistrationException(..)
, DiedReason(..)
, DidUnmonitor(..)
, DidUnlinkProcess(..)
, DidUnlinkNode(..)
, DidUnlinkPort(..)
, SpawnRef(..)
, DidSpawn(..)
, WhereIsReply(..)
, RegisterReply(..)
, ProcessInfo(..)
, ProcessInfoNone(..)
, NodeStats(..)
, NCMsg(..)
, ProcessSignal(..)
, localProcesses
, localPidCounter
, localPidUnique
, localConnections
, localProcessWithId
, localConnectionBetween
, monitorCounter
, spawnCounter
, channelCounter
, typedChannels
, typedChannelWithId
, forever'
) where
import System.Mem.Weak (Weak)
import Data.Map (Map)
import Data.Int (Int32)
import Data.Data (Data)
import Data.Typeable (Typeable, typeOf)
import Data.Binary (Binary(put, get), putWord8, getWord8, encode)
import qualified Data.ByteString as BSS (ByteString, concat, copy)
import qualified Data.ByteString.Lazy as BSL
( ByteString
, toChunks
, splitAt
, fromChunks
, length
)
import qualified Data.ByteString.Lazy.Internal as BSL (ByteString(..))
import Data.Accessor (Accessor, accessor)
import Control.Category ((>>>))
import Control.DeepSeq (NFData(..))
import Control.Exception (Exception, throwIO)
import Control.Concurrent (ThreadId)
import Control.Concurrent.Chan (Chan)
import Control.Concurrent.STM (STM)
import Control.Concurrent.STM.TChan (TChan)
import Control.Monad.Catch (MonadThrow(..), MonadCatch(..), MonadMask(..))
import qualified Network.Transport as NT (EndPoint, EndPointAddress, Connection)
import Control.Applicative
#if !MIN_VERSION_base(4,13,0) && MIN_VERSION_base(4,9,0)
import Control.Monad.Fail (MonadFail)
#endif
import Control.Monad.Fix (MonadFix)
import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Distributed.Process.Serializable
( Fingerprint
, Serializable
, fingerprint
, encodeFingerprint
, sizeOfFingerprint
, decodeFingerprint
, showFingerprint
)
import Control.Distributed.Process.Internal.CQueue (CQueue)
import Control.Distributed.Process.Internal.StrictMVar
( StrictMVar
, withMVar
, modifyMVar
, modifyMVar_
)
import Control.Distributed.Process.Internal.WeakTQueue (TQueue)
import Control.Distributed.Static (RemoteTable, Closure)
import qualified Control.Distributed.Process.Internal.StrictContainerAccessors as DAC (mapMaybe)
import Data.Hashable
import GHC.Generics
import Prelude
newtype NodeId = NodeId { NodeId -> EndPointAddress
nodeAddress :: NT.EndPointAddress }
deriving (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
/= :: NodeId -> NodeId -> Bool
Eq, Eq NodeId
Eq NodeId =>
(NodeId -> NodeId -> Ordering)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> Ord NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NodeId -> NodeId -> Ordering
compare :: NodeId -> NodeId -> Ordering
$c< :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
>= :: NodeId -> NodeId -> Bool
$cmax :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
min :: NodeId -> NodeId -> NodeId
Ord, Typeable, Typeable NodeId
Typeable NodeId =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId)
-> (NodeId -> Constr)
-> (NodeId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId))
-> ((forall b. Data b => b -> b) -> NodeId -> NodeId)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NodeId -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NodeId -> r)
-> (forall u. (forall d. Data d => d -> u) -> NodeId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NodeId -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId)
-> Data NodeId
NodeId -> Constr
NodeId -> DataType
(forall b. Data b => b -> b) -> NodeId -> NodeId
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NodeId -> u
forall u. (forall d. Data d => d -> u) -> NodeId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NodeId -> c NodeId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NodeId
$ctoConstr :: NodeId -> Constr
toConstr :: NodeId -> Constr
$cdataTypeOf :: NodeId -> DataType
dataTypeOf :: NodeId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NodeId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NodeId)
$cgmapT :: (forall b. Data b => b -> b) -> NodeId -> NodeId
gmapT :: (forall b. Data b => b -> b) -> NodeId -> NodeId
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NodeId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NodeId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NodeId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NodeId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NodeId -> m NodeId
Data, (forall x. NodeId -> Rep NodeId x)
-> (forall x. Rep NodeId x -> NodeId) -> Generic NodeId
forall x. Rep NodeId x -> NodeId
forall x. NodeId -> Rep NodeId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NodeId -> Rep NodeId x
from :: forall x. NodeId -> Rep NodeId x
$cto :: forall x. Rep NodeId x -> NodeId
to :: forall x. Rep NodeId x -> NodeId
Generic)
instance Binary NodeId where
instance NFData NodeId where rnf :: NodeId -> ()
rnf (NodeId EndPointAddress
a) = EndPointAddress -> ()
forall a. NFData a => a -> ()
rnf EndPointAddress
a () -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance Hashable NodeId where
instance Show NodeId where
show :: NodeId -> String
show (NodeId EndPointAddress
addr) = String
"nid://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EndPointAddress -> String
forall a. Show a => a -> String
show EndPointAddress
addr
data LocalProcessId = LocalProcessId
{ LocalProcessId -> LocalSendPortId
lpidUnique :: {-# UNPACK #-} !Int32
, LocalProcessId -> LocalSendPortId
lpidCounter :: {-# UNPACK #-} !Int32
}
deriving (LocalProcessId -> LocalProcessId -> Bool
(LocalProcessId -> LocalProcessId -> Bool)
-> (LocalProcessId -> LocalProcessId -> Bool) -> Eq LocalProcessId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocalProcessId -> LocalProcessId -> Bool
== :: LocalProcessId -> LocalProcessId -> Bool
$c/= :: LocalProcessId -> LocalProcessId -> Bool
/= :: LocalProcessId -> LocalProcessId -> Bool
Eq, Eq LocalProcessId
Eq LocalProcessId =>
(LocalProcessId -> LocalProcessId -> Ordering)
-> (LocalProcessId -> LocalProcessId -> Bool)
-> (LocalProcessId -> LocalProcessId -> Bool)
-> (LocalProcessId -> LocalProcessId -> Bool)
-> (LocalProcessId -> LocalProcessId -> Bool)
-> (LocalProcessId -> LocalProcessId -> LocalProcessId)
-> (LocalProcessId -> LocalProcessId -> LocalProcessId)
-> Ord LocalProcessId
LocalProcessId -> LocalProcessId -> Bool
LocalProcessId -> LocalProcessId -> Ordering
LocalProcessId -> LocalProcessId -> LocalProcessId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LocalProcessId -> LocalProcessId -> Ordering
compare :: LocalProcessId -> LocalProcessId -> Ordering
$c< :: LocalProcessId -> LocalProcessId -> Bool
< :: LocalProcessId -> LocalProcessId -> Bool
$c<= :: LocalProcessId -> LocalProcessId -> Bool
<= :: LocalProcessId -> LocalProcessId -> Bool
$c> :: LocalProcessId -> LocalProcessId -> Bool
> :: LocalProcessId -> LocalProcessId -> Bool
$c>= :: LocalProcessId -> LocalProcessId -> Bool
>= :: LocalProcessId -> LocalProcessId -> Bool
$cmax :: LocalProcessId -> LocalProcessId -> LocalProcessId
max :: LocalProcessId -> LocalProcessId -> LocalProcessId
$cmin :: LocalProcessId -> LocalProcessId -> LocalProcessId
min :: LocalProcessId -> LocalProcessId -> LocalProcessId
Ord, Typeable, Typeable LocalProcessId
Typeable LocalProcessId =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocalProcessId -> c LocalProcessId)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocalProcessId)
-> (LocalProcessId -> Constr)
-> (LocalProcessId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocalProcessId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LocalProcessId))
-> ((forall b. Data b => b -> b)
-> LocalProcessId -> LocalProcessId)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r)
-> (forall u.
(forall d. Data d => d -> u) -> LocalProcessId -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> LocalProcessId -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId)
-> Data LocalProcessId
LocalProcessId -> Constr
LocalProcessId -> DataType
(forall b. Data b => b -> b) -> LocalProcessId -> LocalProcessId
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LocalProcessId -> u
forall u. (forall d. Data d => d -> u) -> LocalProcessId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocalProcessId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocalProcessId -> c LocalProcessId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocalProcessId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LocalProcessId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocalProcessId -> c LocalProcessId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LocalProcessId -> c LocalProcessId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocalProcessId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LocalProcessId
$ctoConstr :: LocalProcessId -> Constr
toConstr :: LocalProcessId -> Constr
$cdataTypeOf :: LocalProcessId -> DataType
dataTypeOf :: LocalProcessId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocalProcessId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LocalProcessId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LocalProcessId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LocalProcessId)
$cgmapT :: (forall b. Data b => b -> b) -> LocalProcessId -> LocalProcessId
gmapT :: (forall b. Data b => b -> b) -> LocalProcessId -> LocalProcessId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LocalProcessId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LocalProcessId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> LocalProcessId -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LocalProcessId -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LocalProcessId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LocalProcessId -> m LocalProcessId
Data, (forall x. LocalProcessId -> Rep LocalProcessId x)
-> (forall x. Rep LocalProcessId x -> LocalProcessId)
-> Generic LocalProcessId
forall x. Rep LocalProcessId x -> LocalProcessId
forall x. LocalProcessId -> Rep LocalProcessId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LocalProcessId -> Rep LocalProcessId x
from :: forall x. LocalProcessId -> Rep LocalProcessId x
$cto :: forall x. Rep LocalProcessId x -> LocalProcessId
to :: forall x. Rep LocalProcessId x -> LocalProcessId
Generic, Int -> LocalProcessId -> ShowS
[LocalProcessId] -> ShowS
LocalProcessId -> String
(Int -> LocalProcessId -> ShowS)
-> (LocalProcessId -> String)
-> ([LocalProcessId] -> ShowS)
-> Show LocalProcessId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalProcessId -> ShowS
showsPrec :: Int -> LocalProcessId -> ShowS
$cshow :: LocalProcessId -> String
show :: LocalProcessId -> String
$cshowList :: [LocalProcessId] -> ShowS
showList :: [LocalProcessId] -> ShowS
Show)
instance Hashable LocalProcessId where
data ProcessId = ProcessId
{
ProcessId -> NodeId
processNodeId :: !NodeId
, ProcessId -> LocalProcessId
processLocalId :: {-# UNPACK #-} !LocalProcessId
}
deriving (ProcessId -> ProcessId -> Bool
(ProcessId -> ProcessId -> Bool)
-> (ProcessId -> ProcessId -> Bool) -> Eq ProcessId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessId -> ProcessId -> Bool
== :: ProcessId -> ProcessId -> Bool
$c/= :: ProcessId -> ProcessId -> Bool
/= :: ProcessId -> ProcessId -> Bool
Eq, Eq ProcessId
Eq ProcessId =>
(ProcessId -> ProcessId -> Ordering)
-> (ProcessId -> ProcessId -> Bool)
-> (ProcessId -> ProcessId -> Bool)
-> (ProcessId -> ProcessId -> Bool)
-> (ProcessId -> ProcessId -> Bool)
-> (ProcessId -> ProcessId -> ProcessId)
-> (ProcessId -> ProcessId -> ProcessId)
-> Ord ProcessId
ProcessId -> ProcessId -> Bool
ProcessId -> ProcessId -> Ordering
ProcessId -> ProcessId -> ProcessId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProcessId -> ProcessId -> Ordering
compare :: ProcessId -> ProcessId -> Ordering
$c< :: ProcessId -> ProcessId -> Bool
< :: ProcessId -> ProcessId -> Bool
$c<= :: ProcessId -> ProcessId -> Bool
<= :: ProcessId -> ProcessId -> Bool
$c> :: ProcessId -> ProcessId -> Bool
> :: ProcessId -> ProcessId -> Bool
$c>= :: ProcessId -> ProcessId -> Bool
>= :: ProcessId -> ProcessId -> Bool
$cmax :: ProcessId -> ProcessId -> ProcessId
max :: ProcessId -> ProcessId -> ProcessId
$cmin :: ProcessId -> ProcessId -> ProcessId
min :: ProcessId -> ProcessId -> ProcessId
Ord, Typeable, Typeable ProcessId
Typeable ProcessId =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProcessId -> c ProcessId)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProcessId)
-> (ProcessId -> Constr)
-> (ProcessId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProcessId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProcessId))
-> ((forall b. Data b => b -> b) -> ProcessId -> ProcessId)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r)
-> (forall u. (forall d. Data d => d -> u) -> ProcessId -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ProcessId -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId)
-> Data ProcessId
ProcessId -> Constr
ProcessId -> DataType
(forall b. Data b => b -> b) -> ProcessId -> ProcessId
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ProcessId -> u
forall u. (forall d. Data d => d -> u) -> ProcessId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProcessId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProcessId -> c ProcessId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProcessId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProcessId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProcessId -> c ProcessId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ProcessId -> c ProcessId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProcessId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ProcessId
$ctoConstr :: ProcessId -> Constr
toConstr :: ProcessId -> Constr
$cdataTypeOf :: ProcessId -> DataType
dataTypeOf :: ProcessId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProcessId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ProcessId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProcessId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ProcessId)
$cgmapT :: (forall b. Data b => b -> b) -> ProcessId -> ProcessId
gmapT :: (forall b. Data b => b -> b) -> ProcessId -> ProcessId
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ProcessId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ProcessId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ProcessId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProcessId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ProcessId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ProcessId -> m ProcessId
Data, (forall x. ProcessId -> Rep ProcessId x)
-> (forall x. Rep ProcessId x -> ProcessId) -> Generic ProcessId
forall x. Rep ProcessId x -> ProcessId
forall x. ProcessId -> Rep ProcessId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProcessId -> Rep ProcessId x
from :: forall x. ProcessId -> Rep ProcessId x
$cto :: forall x. Rep ProcessId x -> ProcessId
to :: forall x. Rep ProcessId x -> ProcessId
Generic)
instance Binary ProcessId where
instance NFData ProcessId where rnf :: ProcessId -> ()
rnf (ProcessId NodeId
n LocalProcessId
_) = NodeId -> ()
forall a. NFData a => a -> ()
rnf NodeId
n () -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance Hashable ProcessId where
instance Show ProcessId where
show :: ProcessId -> String
show (ProcessId (NodeId EndPointAddress
addr) (LocalProcessId LocalSendPortId
_ LocalSendPortId
lid))
= String
"pid://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EndPointAddress -> String
forall a. Show a => a -> String
show EndPointAddress
addr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LocalSendPortId -> String
forall a. Show a => a -> String
show LocalSendPortId
lid
data Identifier =
NodeIdentifier !NodeId
| ProcessIdentifier !ProcessId
| SendPortIdentifier !SendPortId
deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
/= :: Identifier -> Identifier -> Bool
Eq, Eq Identifier
Eq Identifier =>
(Identifier -> Identifier -> Ordering)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Identifier)
-> (Identifier -> Identifier -> Identifier)
-> Ord Identifier
Identifier -> Identifier -> Bool
Identifier -> Identifier -> Ordering
Identifier -> Identifier -> Identifier
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Identifier -> Identifier -> Ordering
compare :: Identifier -> Identifier -> Ordering
$c< :: Identifier -> Identifier -> Bool
< :: Identifier -> Identifier -> Bool
$c<= :: Identifier -> Identifier -> Bool
<= :: Identifier -> Identifier -> Bool
$c> :: Identifier -> Identifier -> Bool
> :: Identifier -> Identifier -> Bool
$c>= :: Identifier -> Identifier -> Bool
>= :: Identifier -> Identifier -> Bool
$cmax :: Identifier -> Identifier -> Identifier
max :: Identifier -> Identifier -> Identifier
$cmin :: Identifier -> Identifier -> Identifier
min :: Identifier -> Identifier -> Identifier
Ord, (forall x. Identifier -> Rep Identifier x)
-> (forall x. Rep Identifier x -> Identifier) -> Generic Identifier
forall x. Rep Identifier x -> Identifier
forall x. Identifier -> Rep Identifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Identifier -> Rep Identifier x
from :: forall x. Identifier -> Rep Identifier x
$cto :: forall x. Rep Identifier x -> Identifier
to :: forall x. Rep Identifier x -> Identifier
Generic)
instance Hashable Identifier where
instance NFData Identifier where
rnf :: Identifier -> ()
rnf (NodeIdentifier NodeId
n) = NodeId -> ()
forall a. NFData a => a -> ()
rnf NodeId
n () -> () -> ()
forall a b. a -> b -> b
`seq` ()
rnf (ProcessIdentifier ProcessId
n) = ProcessId -> ()
forall a. NFData a => a -> ()
rnf ProcessId
n () -> () -> ()
forall a b. a -> b -> b
`seq` ()
rnf n :: Identifier
n@SendPortIdentifier{} = Identifier
n Identifier -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance Show Identifier where
show :: Identifier -> String
show (NodeIdentifier NodeId
nid) = NodeId -> String
forall a. Show a => a -> String
show NodeId
nid
show (ProcessIdentifier ProcessId
pid) = ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid
show (SendPortIdentifier SendPortId
cid) = SendPortId -> String
forall a. Show a => a -> String
show SendPortId
cid
nodeOf :: Identifier -> NodeId
nodeOf :: Identifier -> NodeId
nodeOf (NodeIdentifier NodeId
nid) = NodeId
nid
nodeOf (ProcessIdentifier ProcessId
pid) = ProcessId -> NodeId
processNodeId ProcessId
pid
nodeOf (SendPortIdentifier SendPortId
cid) = ProcessId -> NodeId
processNodeId (SendPortId -> ProcessId
sendPortProcessId SendPortId
cid)
firstNonReservedProcessId :: Int32
firstNonReservedProcessId :: LocalSendPortId
firstNonReservedProcessId = LocalSendPortId
1
nullProcessId :: NodeId -> ProcessId
nullProcessId :: NodeId -> ProcessId
nullProcessId NodeId
nid =
ProcessId { processNodeId :: NodeId
processNodeId = NodeId
nid
, processLocalId :: LocalProcessId
processLocalId = LocalProcessId { lpidUnique :: LocalSendPortId
lpidUnique = LocalSendPortId
0
, lpidCounter :: LocalSendPortId
lpidCounter = LocalSendPortId
0
}
}
data Tracer = Tracer
{
Tracer -> ProcessId
tracerPid :: !ProcessId
, Tracer -> Weak (CQueue Message)
weakQ :: !(Weak (CQueue Message))
}
data MxEventBus =
MxEventBusInitialising
| MxEventBus
{
MxEventBus -> ProcessId
agent :: !ProcessId
, MxEventBus -> Tracer
tracer :: !Tracer
, MxEventBus -> Weak (CQueue Message)
evbuss :: !(Weak (CQueue Message))
, MxEventBus
-> ((TChan Message, TChan Message) -> Process ()) -> IO ProcessId
mxNew :: !(((TChan Message, TChan Message) -> Process ()) -> IO ProcessId)
}
data LocalNode = LocalNode
{
LocalNode -> NodeId
localNodeId :: !NodeId
, LocalNode -> EndPoint
localEndPoint :: !NT.EndPoint
, LocalNode -> StrictMVar LocalNodeState
localState :: !(StrictMVar LocalNodeState)
, LocalNode -> Chan NCMsg
localCtrlChan :: !(Chan NCMsg)
, LocalNode -> MxEventBus
localEventBus :: !MxEventBus
, LocalNode -> RemoteTable
remoteTable :: !RemoteTable
}
data ImplicitReconnect = WithImplicitReconnect | NoImplicitReconnect
deriving (ImplicitReconnect -> ImplicitReconnect -> Bool
(ImplicitReconnect -> ImplicitReconnect -> Bool)
-> (ImplicitReconnect -> ImplicitReconnect -> Bool)
-> Eq ImplicitReconnect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImplicitReconnect -> ImplicitReconnect -> Bool
== :: ImplicitReconnect -> ImplicitReconnect -> Bool
$c/= :: ImplicitReconnect -> ImplicitReconnect -> Bool
/= :: ImplicitReconnect -> ImplicitReconnect -> Bool
Eq, Int -> ImplicitReconnect -> ShowS
[ImplicitReconnect] -> ShowS
ImplicitReconnect -> String
(Int -> ImplicitReconnect -> ShowS)
-> (ImplicitReconnect -> String)
-> ([ImplicitReconnect] -> ShowS)
-> Show ImplicitReconnect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImplicitReconnect -> ShowS
showsPrec :: Int -> ImplicitReconnect -> ShowS
$cshow :: ImplicitReconnect -> String
show :: ImplicitReconnect -> String
$cshowList :: [ImplicitReconnect] -> ShowS
showList :: [ImplicitReconnect] -> ShowS
Show)
data LocalNodeState =
LocalNodeValid {-# UNPACK #-} !ValidLocalNodeState
| LocalNodeClosed
data ValidLocalNodeState = ValidLocalNodeState
{
ValidLocalNodeState -> Map LocalProcessId LocalProcess
_localProcesses :: !(Map LocalProcessId LocalProcess)
, ValidLocalNodeState -> LocalSendPortId
_localPidCounter :: !Int32
, ValidLocalNodeState -> LocalSendPortId
_localPidUnique :: !Int32
, ValidLocalNodeState
-> Map (Identifier, Identifier) (Connection, ImplicitReconnect)
_localConnections :: !(Map (Identifier, Identifier)
(NT.Connection, ImplicitReconnect))
}
data NodeClosedException = NodeClosedException NodeId
deriving (Int -> NodeClosedException -> ShowS
[NodeClosedException] -> ShowS
NodeClosedException -> String
(Int -> NodeClosedException -> ShowS)
-> (NodeClosedException -> String)
-> ([NodeClosedException] -> ShowS)
-> Show NodeClosedException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeClosedException -> ShowS
showsPrec :: Int -> NodeClosedException -> ShowS
$cshow :: NodeClosedException -> String
show :: NodeClosedException -> String
$cshowList :: [NodeClosedException] -> ShowS
showList :: [NodeClosedException] -> ShowS
Show, Typeable)
instance Exception NodeClosedException
withValidLocalState :: LocalNode
-> (ValidLocalNodeState -> IO r)
-> IO r
withValidLocalState :: forall r. LocalNode -> (ValidLocalNodeState -> IO r) -> IO r
withValidLocalState LocalNode
node ValidLocalNodeState -> IO r
f = StrictMVar LocalNodeState -> (LocalNodeState -> IO r) -> IO r
forall a b. StrictMVar a -> (a -> IO b) -> IO b
withMVar (LocalNode -> StrictMVar LocalNodeState
localState LocalNode
node) ((LocalNodeState -> IO r) -> IO r)
-> (LocalNodeState -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \LocalNodeState
st -> case LocalNodeState
st of
LocalNodeValid ValidLocalNodeState
vst -> ValidLocalNodeState -> IO r
f ValidLocalNodeState
vst
LocalNodeState
LocalNodeClosed -> NodeClosedException -> IO r
forall e a. Exception e => e -> IO a
throwIO (NodeClosedException -> IO r) -> NodeClosedException -> IO r
forall a b. (a -> b) -> a -> b
$ NodeId -> NodeClosedException
NodeClosedException (LocalNode -> NodeId
localNodeId LocalNode
node)
modifyValidLocalState :: LocalNode
-> (ValidLocalNodeState -> IO (ValidLocalNodeState, a))
-> IO (Maybe a)
modifyValidLocalState :: forall a.
LocalNode
-> (ValidLocalNodeState -> IO (ValidLocalNodeState, a))
-> IO (Maybe a)
modifyValidLocalState LocalNode
node ValidLocalNodeState -> IO (ValidLocalNodeState, a)
f = StrictMVar LocalNodeState
-> (LocalNodeState -> IO (LocalNodeState, Maybe a)) -> IO (Maybe a)
forall a b. StrictMVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (LocalNode -> StrictMVar LocalNodeState
localState LocalNode
node) ((LocalNodeState -> IO (LocalNodeState, Maybe a)) -> IO (Maybe a))
-> (LocalNodeState -> IO (LocalNodeState, Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \LocalNodeState
st -> case LocalNodeState
st of
LocalNodeValid ValidLocalNodeState
vst -> do (ValidLocalNodeState
vst', a
a) <- ValidLocalNodeState -> IO (ValidLocalNodeState, a)
f ValidLocalNodeState
vst
(LocalNodeState, Maybe a) -> IO (LocalNodeState, Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidLocalNodeState -> LocalNodeState
LocalNodeValid ValidLocalNodeState
vst', a -> Maybe a
forall a. a -> Maybe a
Just a
a)
LocalNodeState
LocalNodeClosed -> (LocalNodeState, Maybe a) -> IO (LocalNodeState, Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalNodeState
LocalNodeClosed, Maybe a
forall a. Maybe a
Nothing)
modifyValidLocalState_ :: LocalNode
-> (ValidLocalNodeState -> IO ValidLocalNodeState)
-> IO ()
modifyValidLocalState_ :: LocalNode
-> (ValidLocalNodeState -> IO ValidLocalNodeState) -> IO ()
modifyValidLocalState_ LocalNode
node ValidLocalNodeState -> IO ValidLocalNodeState
f = StrictMVar LocalNodeState
-> (LocalNodeState -> IO LocalNodeState) -> IO ()
forall a. StrictMVar a -> (a -> IO a) -> IO ()
modifyMVar_ (LocalNode -> StrictMVar LocalNodeState
localState LocalNode
node) ((LocalNodeState -> IO LocalNodeState) -> IO ())
-> (LocalNodeState -> IO LocalNodeState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LocalNodeState
st -> case LocalNodeState
st of
LocalNodeValid ValidLocalNodeState
vst -> ValidLocalNodeState -> LocalNodeState
LocalNodeValid (ValidLocalNodeState -> LocalNodeState)
-> IO ValidLocalNodeState -> IO LocalNodeState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidLocalNodeState -> IO ValidLocalNodeState
f ValidLocalNodeState
vst
LocalNodeState
LocalNodeClosed -> LocalNodeState -> IO LocalNodeState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LocalNodeState
LocalNodeClosed
data LocalProcess = LocalProcess
{ LocalProcess -> CQueue Message
processQueue :: !(CQueue Message)
, LocalProcess -> Weak (CQueue Message)
processWeakQ :: !(Weak (CQueue Message))
, LocalProcess -> ProcessId
processId :: !ProcessId
, LocalProcess -> StrictMVar LocalProcessState
processState :: !(StrictMVar LocalProcessState)
, LocalProcess -> ThreadId
processThread :: !ThreadId
, LocalProcess -> LocalNode
processNode :: !LocalNode
}
runLocalProcess :: LocalProcess -> Process a -> IO a
runLocalProcess :: forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc Process a
proc = ReaderT LocalProcess IO a -> LocalProcess -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Process a -> ReaderT LocalProcess IO a
forall a. Process a -> ReaderT LocalProcess IO a
unProcess Process a
proc) LocalProcess
lproc
data LocalProcessState = LocalProcessState
{ LocalProcessState -> LocalSendPortId
_monitorCounter :: !Int32
, LocalProcessState -> LocalSendPortId
_spawnCounter :: !Int32
, LocalProcessState -> LocalSendPortId
_channelCounter :: !Int32
, LocalProcessState -> Map LocalSendPortId TypedChannel
_typedChannels :: !(Map LocalSendPortId TypedChannel)
}
newtype Process a = Process {
forall a. Process a -> ReaderT LocalProcess IO a
unProcess :: ReaderT LocalProcess IO a
}
deriving ( Functor Process
Functor Process =>
(forall a. a -> Process a)
-> (forall a b. Process (a -> b) -> Process a -> Process b)
-> (forall a b c.
(a -> b -> c) -> Process a -> Process b -> Process c)
-> (forall a b. Process a -> Process b -> Process b)
-> (forall a b. Process a -> Process b -> Process a)
-> Applicative Process
forall a. a -> Process a
forall a b. Process a -> Process b -> Process a
forall a b. Process a -> Process b -> Process b
forall a b. Process (a -> b) -> Process a -> Process b
forall a b c. (a -> b -> c) -> Process a -> Process b -> Process c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Process a
pure :: forall a. a -> Process a
$c<*> :: forall a b. Process (a -> b) -> Process a -> Process b
<*> :: forall a b. Process (a -> b) -> Process a -> Process b
$cliftA2 :: forall a b c. (a -> b -> c) -> Process a -> Process b -> Process c
liftA2 :: forall a b c. (a -> b -> c) -> Process a -> Process b -> Process c
$c*> :: forall a b. Process a -> Process b -> Process b
*> :: forall a b. Process a -> Process b -> Process b
$c<* :: forall a b. Process a -> Process b -> Process a
<* :: forall a b. Process a -> Process b -> Process a
Applicative
, (forall a b. (a -> b) -> Process a -> Process b)
-> (forall a b. a -> Process b -> Process a) -> Functor Process
forall a b. a -> Process b -> Process a
forall a b. (a -> b) -> Process a -> Process b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Process a -> Process b
fmap :: forall a b. (a -> b) -> Process a -> Process b
$c<$ :: forall a b. a -> Process b -> Process a
<$ :: forall a b. a -> Process b -> Process a
Functor
, Applicative Process
Applicative Process =>
(forall a b. Process a -> (a -> Process b) -> Process b)
-> (forall a b. Process a -> Process b -> Process b)
-> (forall a. a -> Process a)
-> Monad Process
forall a. a -> Process a
forall a b. Process a -> Process b -> Process b
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Process a -> (a -> Process b) -> Process b
>>= :: forall a b. Process a -> (a -> Process b) -> Process b
$c>> :: forall a b. Process a -> Process b -> Process b
>> :: forall a b. Process a -> Process b -> Process b
$creturn :: forall a. a -> Process a
return :: forall a. a -> Process a
Monad
#if MIN_VERSION_base(4,9,0)
, Monad Process
Monad Process =>
(forall a. String -> Process a) -> MonadFail Process
forall a. String -> Process a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> Process a
fail :: forall a. String -> Process a
MonadFail
#endif
, Monad Process
Monad Process =>
(forall a. (a -> Process a) -> Process a) -> MonadFix Process
forall a. (a -> Process a) -> Process a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall a. (a -> Process a) -> Process a
mfix :: forall a. (a -> Process a) -> Process a
MonadFix
, Monad Process
Monad Process => (forall a. IO a -> Process a) -> MonadIO Process
forall a. IO a -> Process a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Process a
liftIO :: forall a. IO a -> Process a
MonadIO
, MonadReader LocalProcess
, Typeable
)
instance MonadThrow Process where
throwM :: forall e a. (HasCallStack, Exception e) => e -> Process a
throwM = IO a -> Process a
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Process a) -> (e -> IO a) -> e -> Process a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
throwIO
instance MonadCatch Process where
catch :: forall e a.
(HasCallStack, Exception e) =>
Process a -> (e -> Process a) -> Process a
catch Process a
p e -> Process a
h = do
LocalProcess
lproc <- Process LocalProcess
forall r (m :: * -> *). MonadReader r m => m r
ask
IO a -> Process a
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Process a) -> IO a -> Process a
forall a b. (a -> b) -> a -> b
$ IO a -> (e -> IO a) -> IO a
forall e a.
(HasCallStack, Exception e) =>
IO a -> (e -> IO a) -> IO a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (LocalProcess -> Process a -> IO a
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc Process a
p) (LocalProcess -> Process a -> IO a
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc (Process a -> IO a) -> (e -> Process a) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Process a
h)
instance MonadMask Process where
#if MIN_VERSION_exceptions(0,10,0)
generalBracket :: forall a b c.
HasCallStack =>
Process a
-> (a -> ExitCase b -> Process c)
-> (a -> Process b)
-> Process (b, c)
generalBracket Process a
acquire a -> ExitCase b -> Process c
release a -> Process b
inner = do
LocalProcess
lproc <- Process LocalProcess
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (b, c) -> Process (b, c)
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, c) -> Process (b, c)) -> IO (b, c) -> Process (b, c)
forall a b. (a -> b) -> a -> b
$
IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c)
forall a b c.
HasCallStack =>
IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket (LocalProcess -> Process a -> IO a
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc Process a
acquire)
(\a
a ExitCase b
e -> LocalProcess -> Process c -> IO c
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc (Process c -> IO c) -> Process c -> IO c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Process c
release a
a ExitCase b
e)
(LocalProcess -> Process b -> IO b
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc (Process b -> IO b) -> (a -> Process b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Process b
inner)
#endif
mask :: forall b.
HasCallStack =>
((forall a. Process a -> Process a) -> Process b) -> Process b
mask (forall a. Process a -> Process a) -> Process b
p = do
LocalProcess
lproc <- Process LocalProcess
forall r (m :: * -> *). MonadReader r m => m r
ask
IO b -> Process b
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> Process b) -> IO b -> Process b
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
LocalProcess -> Process b -> IO b
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc ((forall a. Process a -> Process a) -> Process b
p ((forall a. IO a -> IO a) -> forall a. Process a -> Process a
liftRestore IO a -> IO a
forall a. IO a -> IO a
restore))
where
liftRestore :: (forall a. IO a -> IO a)
-> (forall a. Process a -> Process a)
liftRestore :: (forall a. IO a -> IO a) -> forall a. Process a -> Process a
liftRestore forall a. IO a -> IO a
restoreIO = \Process a
p2 -> do
LocalProcess
ourLocalProc <- Process LocalProcess
forall r (m :: * -> *). MonadReader r m => m r
ask
IO a -> Process a
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Process a) -> IO a -> Process a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall a. IO a -> IO a
restoreIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ LocalProcess -> Process a -> IO a
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
ourLocalProc Process a
p2
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Process a -> Process a) -> Process b) -> Process b
uninterruptibleMask (forall a. Process a -> Process a) -> Process b
p = do
LocalProcess
lproc <- Process LocalProcess
forall r (m :: * -> *). MonadReader r m => m r
ask
IO b -> Process b
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> Process b) -> IO b -> Process b
forall a b. (a -> b) -> a -> b
$ ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
LocalProcess -> Process b -> IO b
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
lproc ((forall a. Process a -> Process a) -> Process b
p ((forall a. IO a -> IO a) -> forall a. Process a -> Process a
liftRestore IO a -> IO a
forall a. IO a -> IO a
restore))
where
liftRestore :: (forall a. IO a -> IO a)
-> (forall a. Process a -> Process a)
liftRestore :: (forall a. IO a -> IO a) -> forall a. Process a -> Process a
liftRestore forall a. IO a -> IO a
restoreIO = \Process a
p2 -> do
LocalProcess
ourLocalProc <- Process LocalProcess
forall r (m :: * -> *). MonadReader r m => m r
ask
IO a -> Process a
forall a. IO a -> Process a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Process a) -> IO a -> Process a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall a. IO a -> IO a
restoreIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ LocalProcess -> Process a -> IO a
forall a. LocalProcess -> Process a -> IO a
runLocalProcess LocalProcess
ourLocalProc Process a
p2
type LocalSendPortId = Int32
data SendPortId = SendPortId {
SendPortId -> ProcessId
sendPortProcessId :: {-# UNPACK #-} !ProcessId
, SendPortId -> LocalSendPortId
sendPortLocalId :: {-# UNPACK #-} !LocalSendPortId
}
deriving (SendPortId -> SendPortId -> Bool
(SendPortId -> SendPortId -> Bool)
-> (SendPortId -> SendPortId -> Bool) -> Eq SendPortId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SendPortId -> SendPortId -> Bool
== :: SendPortId -> SendPortId -> Bool
$c/= :: SendPortId -> SendPortId -> Bool
/= :: SendPortId -> SendPortId -> Bool
Eq, Eq SendPortId
Eq SendPortId =>
(SendPortId -> SendPortId -> Ordering)
-> (SendPortId -> SendPortId -> Bool)
-> (SendPortId -> SendPortId -> Bool)
-> (SendPortId -> SendPortId -> Bool)
-> (SendPortId -> SendPortId -> Bool)
-> (SendPortId -> SendPortId -> SendPortId)
-> (SendPortId -> SendPortId -> SendPortId)
-> Ord SendPortId
SendPortId -> SendPortId -> Bool
SendPortId -> SendPortId -> Ordering
SendPortId -> SendPortId -> SendPortId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SendPortId -> SendPortId -> Ordering
compare :: SendPortId -> SendPortId -> Ordering
$c< :: SendPortId -> SendPortId -> Bool
< :: SendPortId -> SendPortId -> Bool
$c<= :: SendPortId -> SendPortId -> Bool
<= :: SendPortId -> SendPortId -> Bool
$c> :: SendPortId -> SendPortId -> Bool
> :: SendPortId -> SendPortId -> Bool
$c>= :: SendPortId -> SendPortId -> Bool
>= :: SendPortId -> SendPortId -> Bool
$cmax :: SendPortId -> SendPortId -> SendPortId
max :: SendPortId -> SendPortId -> SendPortId
$cmin :: SendPortId -> SendPortId -> SendPortId
min :: SendPortId -> SendPortId -> SendPortId
Ord, Typeable, (forall x. SendPortId -> Rep SendPortId x)
-> (forall x. Rep SendPortId x -> SendPortId) -> Generic SendPortId
forall x. Rep SendPortId x -> SendPortId
forall x. SendPortId -> Rep SendPortId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendPortId -> Rep SendPortId x
from :: forall x. SendPortId -> Rep SendPortId x
$cto :: forall x. Rep SendPortId x -> SendPortId
to :: forall x. Rep SendPortId x -> SendPortId
Generic)
instance Hashable SendPortId where
instance Show SendPortId where
show :: SendPortId -> String
show (SendPortId (ProcessId (NodeId EndPointAddress
addr) (LocalProcessId LocalSendPortId
_ LocalSendPortId
plid)) LocalSendPortId
clid)
= String
"cid://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ EndPointAddress -> String
forall a. Show a => a -> String
show EndPointAddress
addr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LocalSendPortId -> String
forall a. Show a => a -> String
show LocalSendPortId
plid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LocalSendPortId -> String
forall a. Show a => a -> String
show LocalSendPortId
clid
instance NFData SendPortId where
rnf :: SendPortId -> ()
rnf (SendPortId ProcessId
p LocalSendPortId
_) = ProcessId -> ()
forall a. NFData a => a -> ()
rnf ProcessId
p () -> () -> ()
forall a b. a -> b -> b
`seq` ()
data TypedChannel = forall a. Serializable a => TypedChannel (Weak (TQueue a))
newtype SendPort a = SendPort {
forall a. SendPort a -> SendPortId
sendPortId :: SendPortId
}
deriving (Typeable, (forall x. SendPort a -> Rep (SendPort a) x)
-> (forall x. Rep (SendPort a) x -> SendPort a)
-> Generic (SendPort a)
forall x. Rep (SendPort a) x -> SendPort a
forall x. SendPort a -> Rep (SendPort a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SendPort a) x -> SendPort a
forall a x. SendPort a -> Rep (SendPort a) x
$cfrom :: forall a x. SendPort a -> Rep (SendPort a) x
from :: forall x. SendPort a -> Rep (SendPort a) x
$cto :: forall a x. Rep (SendPort a) x -> SendPort a
to :: forall x. Rep (SendPort a) x -> SendPort a
Generic, Int -> SendPort a -> ShowS
[SendPort a] -> ShowS
SendPort a -> String
(Int -> SendPort a -> ShowS)
-> (SendPort a -> String)
-> ([SendPort a] -> ShowS)
-> Show (SendPort a)
forall a. Int -> SendPort a -> ShowS
forall a. [SendPort a] -> ShowS
forall a. SendPort a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> SendPort a -> ShowS
showsPrec :: Int -> SendPort a -> ShowS
$cshow :: forall a. SendPort a -> String
show :: SendPort a -> String
$cshowList :: forall a. [SendPort a] -> ShowS
showList :: [SendPort a] -> ShowS
Show, SendPort a -> SendPort a -> Bool
(SendPort a -> SendPort a -> Bool)
-> (SendPort a -> SendPort a -> Bool) -> Eq (SendPort a)
forall a. SendPort a -> SendPort a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. SendPort a -> SendPort a -> Bool
== :: SendPort a -> SendPort a -> Bool
$c/= :: forall a. SendPort a -> SendPort a -> Bool
/= :: SendPort a -> SendPort a -> Bool
Eq, Eq (SendPort a)
Eq (SendPort a) =>
(SendPort a -> SendPort a -> Ordering)
-> (SendPort a -> SendPort a -> Bool)
-> (SendPort a -> SendPort a -> Bool)
-> (SendPort a -> SendPort a -> Bool)
-> (SendPort a -> SendPort a -> Bool)
-> (SendPort a -> SendPort a -> SendPort a)
-> (SendPort a -> SendPort a -> SendPort a)
-> Ord (SendPort a)
SendPort a -> SendPort a -> Bool
SendPort a -> SendPort a -> Ordering
SendPort a -> SendPort a -> SendPort a
forall a. Eq (SendPort a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. SendPort a -> SendPort a -> Bool
forall a. SendPort a -> SendPort a -> Ordering
forall a. SendPort a -> SendPort a -> SendPort a
$ccompare :: forall a. SendPort a -> SendPort a -> Ordering
compare :: SendPort a -> SendPort a -> Ordering
$c< :: forall a. SendPort a -> SendPort a -> Bool
< :: SendPort a -> SendPort a -> Bool
$c<= :: forall a. SendPort a -> SendPort a -> Bool
<= :: SendPort a -> SendPort a -> Bool
$c> :: forall a. SendPort a -> SendPort a -> Bool
> :: SendPort a -> SendPort a -> Bool
$c>= :: forall a. SendPort a -> SendPort a -> Bool
>= :: SendPort a -> SendPort a -> Bool
$cmax :: forall a. SendPort a -> SendPort a -> SendPort a
max :: SendPort a -> SendPort a -> SendPort a
$cmin :: forall a. SendPort a -> SendPort a -> SendPort a
min :: SendPort a -> SendPort a -> SendPort a
Ord)
instance (Serializable a) => Binary (SendPort a) where
instance (Hashable a) => Hashable (SendPort a) where
instance (NFData a) => NFData (SendPort a) where rnf :: SendPort a -> ()
rnf (SendPort SendPortId
x) = SendPortId
x SendPortId -> () -> ()
forall a b. a -> b -> b
`seq` ()
newtype ReceivePort a = ReceivePort { forall a. ReceivePort a -> STM a
receiveSTM :: STM a }
deriving (Typeable, (forall a b. (a -> b) -> ReceivePort a -> ReceivePort b)
-> (forall a b. a -> ReceivePort b -> ReceivePort a)
-> Functor ReceivePort
forall a b. a -> ReceivePort b -> ReceivePort a
forall a b. (a -> b) -> ReceivePort a -> ReceivePort b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ReceivePort a -> ReceivePort b
fmap :: forall a b. (a -> b) -> ReceivePort a -> ReceivePort b
$c<$ :: forall a b. a -> ReceivePort b -> ReceivePort a
<$ :: forall a b. a -> ReceivePort b -> ReceivePort a
Functor, Functor ReceivePort
Functor ReceivePort =>
(forall a. a -> ReceivePort a)
-> (forall a b.
ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b)
-> (forall a b c.
(a -> b -> c) -> ReceivePort a -> ReceivePort b -> ReceivePort c)
-> (forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b)
-> (forall a b. ReceivePort a -> ReceivePort b -> ReceivePort a)
-> Applicative ReceivePort
forall a. a -> ReceivePort a
forall a b. ReceivePort a -> ReceivePort b -> ReceivePort a
forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b
forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
forall a b c.
(a -> b -> c) -> ReceivePort a -> ReceivePort b -> ReceivePort c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ReceivePort a
pure :: forall a. a -> ReceivePort a
$c<*> :: forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
<*> :: forall a b. ReceivePort (a -> b) -> ReceivePort a -> ReceivePort b
$cliftA2 :: forall a b c.
(a -> b -> c) -> ReceivePort a -> ReceivePort b -> ReceivePort c
liftA2 :: forall a b c.
(a -> b -> c) -> ReceivePort a -> ReceivePort b -> ReceivePort c
$c*> :: forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b
*> :: forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b
$c<* :: forall a b. ReceivePort a -> ReceivePort b -> ReceivePort a
<* :: forall a b. ReceivePort a -> ReceivePort b -> ReceivePort a
Applicative, Applicative ReceivePort
Applicative ReceivePort =>
(forall a. ReceivePort a)
-> (forall a. ReceivePort a -> ReceivePort a -> ReceivePort a)
-> (forall a. ReceivePort a -> ReceivePort [a])
-> (forall a. ReceivePort a -> ReceivePort [a])
-> Alternative ReceivePort
forall a. ReceivePort a
forall a. ReceivePort a -> ReceivePort [a]
forall a. ReceivePort a -> ReceivePort a -> ReceivePort a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall a. ReceivePort a
empty :: forall a. ReceivePort a
$c<|> :: forall a. ReceivePort a -> ReceivePort a -> ReceivePort a
<|> :: forall a. ReceivePort a -> ReceivePort a -> ReceivePort a
$csome :: forall a. ReceivePort a -> ReceivePort [a]
some :: forall a. ReceivePort a -> ReceivePort [a]
$cmany :: forall a. ReceivePort a -> ReceivePort [a]
many :: forall a. ReceivePort a -> ReceivePort [a]
Alternative, Applicative ReceivePort
Applicative ReceivePort =>
(forall a b.
ReceivePort a -> (a -> ReceivePort b) -> ReceivePort b)
-> (forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b)
-> (forall a. a -> ReceivePort a)
-> Monad ReceivePort
forall a. a -> ReceivePort a
forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b
forall a b. ReceivePort a -> (a -> ReceivePort b) -> ReceivePort b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. ReceivePort a -> (a -> ReceivePort b) -> ReceivePort b
>>= :: forall a b. ReceivePort a -> (a -> ReceivePort b) -> ReceivePort b
$c>> :: forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b
>> :: forall a b. ReceivePort a -> ReceivePort b -> ReceivePort b
$creturn :: forall a. a -> ReceivePort a
return :: forall a. a -> ReceivePort a
Monad)
data Message =
EncodedMessage
{ Message -> Fingerprint
messageFingerprint :: !Fingerprint
, Message -> ByteString
messageEncoding :: !BSL.ByteString
} |
forall a . Serializable a =>
UnencodedMessage
{
messageFingerprint :: !Fingerprint
, ()
messagePayload :: !a
}
deriving (Typeable)
instance NFData Message where
#if MIN_VERSION_bytestring(0,10,0)
rnf :: Message -> ()
rnf (EncodedMessage Fingerprint
_ ByteString
e) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
e () -> () -> ()
forall a b. a -> b -> b
`seq` ()
#else
rnf (EncodedMessage _ e) = BSL.length e `seq` ()
#endif
rnf (UnencodedMessage Fingerprint
_ a
a) = Int64
e Int64 -> () -> ()
forall a b. a -> b -> b
`seq` ()
where e :: Int64
e = ByteString -> Int64
BSL.length (a -> ByteString
forall a. Binary a => a -> ByteString
encode a
a)
instance Show Message where
show :: Message -> String
show (EncodedMessage Fingerprint
fp ByteString
enc) = ByteString -> String
forall a. Show a => a -> String
show ByteString
enc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Fingerprint -> ShowS
showFingerprint Fingerprint
fp []
show (UnencodedMessage Fingerprint
_ a
uenc) = String
"[unencoded message] :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
uenc)
isEncoded :: Message -> Bool
isEncoded :: Message -> Bool
isEncoded (EncodedMessage Fingerprint
_ ByteString
_) = Bool
True
isEncoded Message
_ = Bool
False
createMessage :: Serializable a => a -> Message
createMessage :: forall a. Serializable a => a -> Message
createMessage a
a = Fingerprint -> ByteString -> Message
EncodedMessage (a -> Fingerprint
forall a. Typeable a => a -> Fingerprint
fingerprint a
a) (a -> ByteString
forall a. Binary a => a -> ByteString
encode a
a)
createUnencodedMessage :: Serializable a => a -> Message
createUnencodedMessage :: forall a. Serializable a => a -> Message
createUnencodedMessage a
a =
let encoded :: ByteString
encoded = a -> ByteString
forall a. Binary a => a -> ByteString
encode a
a in ByteString -> Int64
BSL.length ByteString
encoded Int64 -> Message -> Message
forall a b. a -> b -> b
`seq` Fingerprint -> a -> Message
forall a. Serializable a => Fingerprint -> a -> Message
UnencodedMessage (a -> Fingerprint
forall a. Typeable a => a -> Fingerprint
fingerprint a
a) a
a
unsafeCreateUnencodedMessage :: Serializable a => a -> Message
unsafeCreateUnencodedMessage :: forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage a
a = Fingerprint -> a -> Message
forall a. Serializable a => Fingerprint -> a -> Message
UnencodedMessage (a -> Fingerprint
forall a. Typeable a => a -> Fingerprint
fingerprint a
a) a
a
messageToPayload :: Message -> [BSS.ByteString]
messageToPayload :: Message -> [ByteString]
messageToPayload (EncodedMessage Fingerprint
fp ByteString
enc) = Fingerprint -> ByteString
encodeFingerprint Fingerprint
fp ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
BSL.toChunks ByteString
enc
messageToPayload (UnencodedMessage Fingerprint
fp a
m) = Message -> [ByteString]
messageToPayload ((Fingerprint -> ByteString -> Message
EncodedMessage Fingerprint
fp (a -> ByteString
forall a. Binary a => a -> ByteString
encode a
m)))
payloadToMessage :: [BSS.ByteString] -> Message
payloadToMessage :: [ByteString] -> Message
payloadToMessage [ByteString]
payload = Fingerprint -> ByteString -> Message
EncodedMessage Fingerprint
fp (ByteString -> ByteString
copy ByteString
msg)
where
encFp :: BSL.ByteString
msg :: BSL.ByteString
(ByteString
encFp, ByteString
msg) = Int64 -> ByteString -> (ByteString, ByteString)
BSL.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sizeOfFingerprint)
(ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BSL.fromChunks [ByteString]
payload
fp :: Fingerprint
fp :: Fingerprint
fp = ByteString -> Fingerprint
decodeFingerprint (ByteString -> Fingerprint)
-> (ByteString -> ByteString) -> ByteString -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BSS.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks (ByteString -> Fingerprint) -> ByteString -> Fingerprint
forall a b. (a -> b) -> a -> b
$ ByteString
encFp
copy :: BSL.ByteString -> BSL.ByteString
copy :: ByteString -> ByteString
copy (BSL.Chunk ByteString
bs ByteString
BSL.Empty) = ByteString -> ByteString -> ByteString
BSL.Chunk (ByteString -> ByteString
BSS.copy ByteString
bs) ByteString
BSL.Empty
copy ByteString
bsl = [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BSS.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BSL.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bsl
data MonitorRef = MonitorRef
{
MonitorRef -> Identifier
monitorRefIdent :: !Identifier
, MonitorRef -> LocalSendPortId
monitorRefCounter :: !Int32
}
deriving (MonitorRef -> MonitorRef -> Bool
(MonitorRef -> MonitorRef -> Bool)
-> (MonitorRef -> MonitorRef -> Bool) -> Eq MonitorRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonitorRef -> MonitorRef -> Bool
== :: MonitorRef -> MonitorRef -> Bool
$c/= :: MonitorRef -> MonitorRef -> Bool
/= :: MonitorRef -> MonitorRef -> Bool
Eq, Eq MonitorRef
Eq MonitorRef =>
(MonitorRef -> MonitorRef -> Ordering)
-> (MonitorRef -> MonitorRef -> Bool)
-> (MonitorRef -> MonitorRef -> Bool)
-> (MonitorRef -> MonitorRef -> Bool)
-> (MonitorRef -> MonitorRef -> Bool)
-> (MonitorRef -> MonitorRef -> MonitorRef)
-> (MonitorRef -> MonitorRef -> MonitorRef)
-> Ord MonitorRef
MonitorRef -> MonitorRef -> Bool
MonitorRef -> MonitorRef -> Ordering
MonitorRef -> MonitorRef -> MonitorRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MonitorRef -> MonitorRef -> Ordering
compare :: MonitorRef -> MonitorRef -> Ordering
$c< :: MonitorRef -> MonitorRef -> Bool
< :: MonitorRef -> MonitorRef -> Bool
$c<= :: MonitorRef -> MonitorRef -> Bool
<= :: MonitorRef -> MonitorRef -> Bool
$c> :: MonitorRef -> MonitorRef -> Bool
> :: MonitorRef -> MonitorRef -> Bool
$c>= :: MonitorRef -> MonitorRef -> Bool
>= :: MonitorRef -> MonitorRef -> Bool
$cmax :: MonitorRef -> MonitorRef -> MonitorRef
max :: MonitorRef -> MonitorRef -> MonitorRef
$cmin :: MonitorRef -> MonitorRef -> MonitorRef
min :: MonitorRef -> MonitorRef -> MonitorRef
Ord, Int -> MonitorRef -> ShowS
[MonitorRef] -> ShowS
MonitorRef -> String
(Int -> MonitorRef -> ShowS)
-> (MonitorRef -> String)
-> ([MonitorRef] -> ShowS)
-> Show MonitorRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonitorRef -> ShowS
showsPrec :: Int -> MonitorRef -> ShowS
$cshow :: MonitorRef -> String
show :: MonitorRef -> String
$cshowList :: [MonitorRef] -> ShowS
showList :: [MonitorRef] -> ShowS
Show, Typeable, (forall x. MonitorRef -> Rep MonitorRef x)
-> (forall x. Rep MonitorRef x -> MonitorRef) -> Generic MonitorRef
forall x. Rep MonitorRef x -> MonitorRef
forall x. MonitorRef -> Rep MonitorRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MonitorRef -> Rep MonitorRef x
from :: forall x. MonitorRef -> Rep MonitorRef x
$cto :: forall x. Rep MonitorRef x -> MonitorRef
to :: forall x. Rep MonitorRef x -> MonitorRef
Generic)
instance Hashable MonitorRef
instance NFData MonitorRef where
rnf :: MonitorRef -> ()
rnf (MonitorRef Identifier
i LocalSendPortId
_) = Identifier -> ()
forall a. NFData a => a -> ()
rnf Identifier
i () -> () -> ()
forall a b. a -> b -> b
`seq` ()
data ProcessMonitorNotification =
ProcessMonitorNotification !MonitorRef !ProcessId !DiedReason
deriving (Typeable, Int -> ProcessMonitorNotification -> ShowS
[ProcessMonitorNotification] -> ShowS
ProcessMonitorNotification -> String
(Int -> ProcessMonitorNotification -> ShowS)
-> (ProcessMonitorNotification -> String)
-> ([ProcessMonitorNotification] -> ShowS)
-> Show ProcessMonitorNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessMonitorNotification -> ShowS
showsPrec :: Int -> ProcessMonitorNotification -> ShowS
$cshow :: ProcessMonitorNotification -> String
show :: ProcessMonitorNotification -> String
$cshowList :: [ProcessMonitorNotification] -> ShowS
showList :: [ProcessMonitorNotification] -> ShowS
Show)
data NodeMonitorNotification =
NodeMonitorNotification !MonitorRef !NodeId !DiedReason
deriving (Typeable, Int -> NodeMonitorNotification -> ShowS
[NodeMonitorNotification] -> ShowS
NodeMonitorNotification -> String
(Int -> NodeMonitorNotification -> ShowS)
-> (NodeMonitorNotification -> String)
-> ([NodeMonitorNotification] -> ShowS)
-> Show NodeMonitorNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeMonitorNotification -> ShowS
showsPrec :: Int -> NodeMonitorNotification -> ShowS
$cshow :: NodeMonitorNotification -> String
show :: NodeMonitorNotification -> String
$cshowList :: [NodeMonitorNotification] -> ShowS
showList :: [NodeMonitorNotification] -> ShowS
Show)
data PortMonitorNotification =
PortMonitorNotification !MonitorRef !SendPortId !DiedReason
deriving (Typeable, Int -> PortMonitorNotification -> ShowS
[PortMonitorNotification] -> ShowS
PortMonitorNotification -> String
(Int -> PortMonitorNotification -> ShowS)
-> (PortMonitorNotification -> String)
-> ([PortMonitorNotification] -> ShowS)
-> Show PortMonitorNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PortMonitorNotification -> ShowS
showsPrec :: Int -> PortMonitorNotification -> ShowS
$cshow :: PortMonitorNotification -> String
show :: PortMonitorNotification -> String
$cshowList :: [PortMonitorNotification] -> ShowS
showList :: [PortMonitorNotification] -> ShowS
Show)
data ProcessLinkException =
ProcessLinkException !ProcessId !DiedReason
deriving (Typeable, Int -> ProcessLinkException -> ShowS
[ProcessLinkException] -> ShowS
ProcessLinkException -> String
(Int -> ProcessLinkException -> ShowS)
-> (ProcessLinkException -> String)
-> ([ProcessLinkException] -> ShowS)
-> Show ProcessLinkException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessLinkException -> ShowS
showsPrec :: Int -> ProcessLinkException -> ShowS
$cshow :: ProcessLinkException -> String
show :: ProcessLinkException -> String
$cshowList :: [ProcessLinkException] -> ShowS
showList :: [ProcessLinkException] -> ShowS
Show)
data NodeLinkException =
NodeLinkException !NodeId !DiedReason
deriving (Typeable, Int -> NodeLinkException -> ShowS
[NodeLinkException] -> ShowS
NodeLinkException -> String
(Int -> NodeLinkException -> ShowS)
-> (NodeLinkException -> String)
-> ([NodeLinkException] -> ShowS)
-> Show NodeLinkException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeLinkException -> ShowS
showsPrec :: Int -> NodeLinkException -> ShowS
$cshow :: NodeLinkException -> String
show :: NodeLinkException -> String
$cshowList :: [NodeLinkException] -> ShowS
showList :: [NodeLinkException] -> ShowS
Show)
data PortLinkException =
PortLinkException !SendPortId !DiedReason
deriving (Typeable, Int -> PortLinkException -> ShowS
[PortLinkException] -> ShowS
PortLinkException -> String
(Int -> PortLinkException -> ShowS)
-> (PortLinkException -> String)
-> ([PortLinkException] -> ShowS)
-> Show PortLinkException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PortLinkException -> ShowS
showsPrec :: Int -> PortLinkException -> ShowS
$cshow :: PortLinkException -> String
show :: PortLinkException -> String
$cshowList :: [PortLinkException] -> ShowS
showList :: [PortLinkException] -> ShowS
Show)
data ProcessRegistrationException =
ProcessRegistrationException !String !(Maybe ProcessId)
deriving (Typeable, Int -> ProcessRegistrationException -> ShowS
[ProcessRegistrationException] -> ShowS
ProcessRegistrationException -> String
(Int -> ProcessRegistrationException -> ShowS)
-> (ProcessRegistrationException -> String)
-> ([ProcessRegistrationException] -> ShowS)
-> Show ProcessRegistrationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessRegistrationException -> ShowS
showsPrec :: Int -> ProcessRegistrationException -> ShowS
$cshow :: ProcessRegistrationException -> String
show :: ProcessRegistrationException -> String
$cshowList :: [ProcessRegistrationException] -> ShowS
showList :: [ProcessRegistrationException] -> ShowS
Show)
data ProcessExitException =
ProcessExitException !ProcessId !Message
deriving Typeable
instance Exception ProcessExitException
instance Show ProcessExitException where
show :: ProcessExitException -> String
show (ProcessExitException ProcessId
pid Message
_) = String
"exit-from=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ProcessId -> String
forall a. Show a => a -> String
show ProcessId
pid)
instance Exception ProcessLinkException
instance Exception NodeLinkException
instance Exception PortLinkException
instance Exception ProcessRegistrationException
data DiedReason =
DiedNormal
| DiedException !String
| DiedDisconnect
| DiedNodeDown
| DiedUnknownId
deriving (Int -> DiedReason -> ShowS
[DiedReason] -> ShowS
DiedReason -> String
(Int -> DiedReason -> ShowS)
-> (DiedReason -> String)
-> ([DiedReason] -> ShowS)
-> Show DiedReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiedReason -> ShowS
showsPrec :: Int -> DiedReason -> ShowS
$cshow :: DiedReason -> String
show :: DiedReason -> String
$cshowList :: [DiedReason] -> ShowS
showList :: [DiedReason] -> ShowS
Show, DiedReason -> DiedReason -> Bool
(DiedReason -> DiedReason -> Bool)
-> (DiedReason -> DiedReason -> Bool) -> Eq DiedReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiedReason -> DiedReason -> Bool
== :: DiedReason -> DiedReason -> Bool
$c/= :: DiedReason -> DiedReason -> Bool
/= :: DiedReason -> DiedReason -> Bool
Eq)
instance NFData DiedReason where
rnf :: DiedReason -> ()
rnf (DiedException String
s) = String -> ()
forall a. NFData a => a -> ()
rnf String
s () -> () -> ()
forall a b. a -> b -> b
`seq` ()
rnf DiedReason
x = DiedReason
x DiedReason -> () -> ()
forall a b. a -> b -> b
`seq` ()
newtype DidUnmonitor = DidUnmonitor MonitorRef
deriving (Typeable, Get DidUnmonitor
[DidUnmonitor] -> Put
DidUnmonitor -> Put
(DidUnmonitor -> Put)
-> Get DidUnmonitor
-> ([DidUnmonitor] -> Put)
-> Binary DidUnmonitor
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DidUnmonitor -> Put
put :: DidUnmonitor -> Put
$cget :: Get DidUnmonitor
get :: Get DidUnmonitor
$cputList :: [DidUnmonitor] -> Put
putList :: [DidUnmonitor] -> Put
Binary)
newtype DidUnlinkProcess = DidUnlinkProcess ProcessId
deriving (Typeable, Get DidUnlinkProcess
[DidUnlinkProcess] -> Put
DidUnlinkProcess -> Put
(DidUnlinkProcess -> Put)
-> Get DidUnlinkProcess
-> ([DidUnlinkProcess] -> Put)
-> Binary DidUnlinkProcess
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DidUnlinkProcess -> Put
put :: DidUnlinkProcess -> Put
$cget :: Get DidUnlinkProcess
get :: Get DidUnlinkProcess
$cputList :: [DidUnlinkProcess] -> Put
putList :: [DidUnlinkProcess] -> Put
Binary)
newtype DidUnlinkNode = DidUnlinkNode NodeId
deriving (Typeable, Get DidUnlinkNode
[DidUnlinkNode] -> Put
DidUnlinkNode -> Put
(DidUnlinkNode -> Put)
-> Get DidUnlinkNode
-> ([DidUnlinkNode] -> Put)
-> Binary DidUnlinkNode
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DidUnlinkNode -> Put
put :: DidUnlinkNode -> Put
$cget :: Get DidUnlinkNode
get :: Get DidUnlinkNode
$cputList :: [DidUnlinkNode] -> Put
putList :: [DidUnlinkNode] -> Put
Binary)
newtype DidUnlinkPort = DidUnlinkPort SendPortId
deriving (Typeable, Get DidUnlinkPort
[DidUnlinkPort] -> Put
DidUnlinkPort -> Put
(DidUnlinkPort -> Put)
-> Get DidUnlinkPort
-> ([DidUnlinkPort] -> Put)
-> Binary DidUnlinkPort
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: DidUnlinkPort -> Put
put :: DidUnlinkPort -> Put
$cget :: Get DidUnlinkPort
get :: Get DidUnlinkPort
$cputList :: [DidUnlinkPort] -> Put
putList :: [DidUnlinkPort] -> Put
Binary)
newtype SpawnRef = SpawnRef Int32
deriving (Int -> SpawnRef -> ShowS
[SpawnRef] -> ShowS
SpawnRef -> String
(Int -> SpawnRef -> ShowS)
-> (SpawnRef -> String) -> ([SpawnRef] -> ShowS) -> Show SpawnRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpawnRef -> ShowS
showsPrec :: Int -> SpawnRef -> ShowS
$cshow :: SpawnRef -> String
show :: SpawnRef -> String
$cshowList :: [SpawnRef] -> ShowS
showList :: [SpawnRef] -> ShowS
Show, Get SpawnRef
[SpawnRef] -> Put
SpawnRef -> Put
(SpawnRef -> Put)
-> Get SpawnRef -> ([SpawnRef] -> Put) -> Binary SpawnRef
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: SpawnRef -> Put
put :: SpawnRef -> Put
$cget :: Get SpawnRef
get :: Get SpawnRef
$cputList :: [SpawnRef] -> Put
putList :: [SpawnRef] -> Put
Binary, Typeable, SpawnRef -> SpawnRef -> Bool
(SpawnRef -> SpawnRef -> Bool)
-> (SpawnRef -> SpawnRef -> Bool) -> Eq SpawnRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpawnRef -> SpawnRef -> Bool
== :: SpawnRef -> SpawnRef -> Bool
$c/= :: SpawnRef -> SpawnRef -> Bool
/= :: SpawnRef -> SpawnRef -> Bool
Eq, Eq SpawnRef
Eq SpawnRef =>
(SpawnRef -> SpawnRef -> Ordering)
-> (SpawnRef -> SpawnRef -> Bool)
-> (SpawnRef -> SpawnRef -> Bool)
-> (SpawnRef -> SpawnRef -> Bool)
-> (SpawnRef -> SpawnRef -> Bool)
-> (SpawnRef -> SpawnRef -> SpawnRef)
-> (SpawnRef -> SpawnRef -> SpawnRef)
-> Ord SpawnRef
SpawnRef -> SpawnRef -> Bool
SpawnRef -> SpawnRef -> Ordering
SpawnRef -> SpawnRef -> SpawnRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpawnRef -> SpawnRef -> Ordering
compare :: SpawnRef -> SpawnRef -> Ordering
$c< :: SpawnRef -> SpawnRef -> Bool
< :: SpawnRef -> SpawnRef -> Bool
$c<= :: SpawnRef -> SpawnRef -> Bool
<= :: SpawnRef -> SpawnRef -> Bool
$c> :: SpawnRef -> SpawnRef -> Bool
> :: SpawnRef -> SpawnRef -> Bool
$c>= :: SpawnRef -> SpawnRef -> Bool
>= :: SpawnRef -> SpawnRef -> Bool
$cmax :: SpawnRef -> SpawnRef -> SpawnRef
max :: SpawnRef -> SpawnRef -> SpawnRef
$cmin :: SpawnRef -> SpawnRef -> SpawnRef
min :: SpawnRef -> SpawnRef -> SpawnRef
Ord)
data DidSpawn = DidSpawn SpawnRef ProcessId
deriving (Int -> DidSpawn -> ShowS
[DidSpawn] -> ShowS
DidSpawn -> String
(Int -> DidSpawn -> ShowS)
-> (DidSpawn -> String) -> ([DidSpawn] -> ShowS) -> Show DidSpawn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DidSpawn -> ShowS
showsPrec :: Int -> DidSpawn -> ShowS
$cshow :: DidSpawn -> String
show :: DidSpawn -> String
$cshowList :: [DidSpawn] -> ShowS
showList :: [DidSpawn] -> ShowS
Show, Typeable)
data WhereIsReply = WhereIsReply String (Maybe ProcessId)
deriving (Int -> WhereIsReply -> ShowS
[WhereIsReply] -> ShowS
WhereIsReply -> String
(Int -> WhereIsReply -> ShowS)
-> (WhereIsReply -> String)
-> ([WhereIsReply] -> ShowS)
-> Show WhereIsReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhereIsReply -> ShowS
showsPrec :: Int -> WhereIsReply -> ShowS
$cshow :: WhereIsReply -> String
show :: WhereIsReply -> String
$cshowList :: [WhereIsReply] -> ShowS
showList :: [WhereIsReply] -> ShowS
Show, Typeable)
data RegisterReply = RegisterReply String Bool (Maybe ProcessId)
deriving (Int -> RegisterReply -> ShowS
[RegisterReply] -> ShowS
RegisterReply -> String
(Int -> RegisterReply -> ShowS)
-> (RegisterReply -> String)
-> ([RegisterReply] -> ShowS)
-> Show RegisterReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegisterReply -> ShowS
showsPrec :: Int -> RegisterReply -> ShowS
$cshow :: RegisterReply -> String
show :: RegisterReply -> String
$cshowList :: [RegisterReply] -> ShowS
showList :: [RegisterReply] -> ShowS
Show, Typeable)
data NodeStats = NodeStats {
NodeStats -> NodeId
nodeStatsNode :: NodeId
, NodeStats -> Int
nodeStatsRegisteredNames :: Int
, NodeStats -> Int
nodeStatsMonitors :: Int
, NodeStats -> Int
nodeStatsLinks :: Int
, NodeStats -> Int
nodeStatsProcesses :: Int
}
deriving (Int -> NodeStats -> ShowS
[NodeStats] -> ShowS
NodeStats -> String
(Int -> NodeStats -> ShowS)
-> (NodeStats -> String)
-> ([NodeStats] -> ShowS)
-> Show NodeStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeStats -> ShowS
showsPrec :: Int -> NodeStats -> ShowS
$cshow :: NodeStats -> String
show :: NodeStats -> String
$cshowList :: [NodeStats] -> ShowS
showList :: [NodeStats] -> ShowS
Show, NodeStats -> NodeStats -> Bool
(NodeStats -> NodeStats -> Bool)
-> (NodeStats -> NodeStats -> Bool) -> Eq NodeStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeStats -> NodeStats -> Bool
== :: NodeStats -> NodeStats -> Bool
$c/= :: NodeStats -> NodeStats -> Bool
/= :: NodeStats -> NodeStats -> Bool
Eq, Typeable)
data ProcessInfo = ProcessInfo {
ProcessInfo -> NodeId
infoNode :: NodeId
, ProcessInfo -> [String]
infoRegisteredNames :: [String]
, ProcessInfo -> Int
infoMessageQueueLength :: Int
, ProcessInfo -> [(ProcessId, MonitorRef)]
infoMonitors :: [(ProcessId, MonitorRef)]
, ProcessInfo -> [ProcessId]
infoLinks :: [ProcessId]
} deriving (Int -> ProcessInfo -> ShowS
[ProcessInfo] -> ShowS
ProcessInfo -> String
(Int -> ProcessInfo -> ShowS)
-> (ProcessInfo -> String)
-> ([ProcessInfo] -> ShowS)
-> Show ProcessInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessInfo -> ShowS
showsPrec :: Int -> ProcessInfo -> ShowS
$cshow :: ProcessInfo -> String
show :: ProcessInfo -> String
$cshowList :: [ProcessInfo] -> ShowS
showList :: [ProcessInfo] -> ShowS
Show, ProcessInfo -> ProcessInfo -> Bool
(ProcessInfo -> ProcessInfo -> Bool)
-> (ProcessInfo -> ProcessInfo -> Bool) -> Eq ProcessInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessInfo -> ProcessInfo -> Bool
== :: ProcessInfo -> ProcessInfo -> Bool
$c/= :: ProcessInfo -> ProcessInfo -> Bool
/= :: ProcessInfo -> ProcessInfo -> Bool
Eq, Typeable)
data ProcessInfoNone = ProcessInfoNone DiedReason
deriving (Int -> ProcessInfoNone -> ShowS
[ProcessInfoNone] -> ShowS
ProcessInfoNone -> String
(Int -> ProcessInfoNone -> ShowS)
-> (ProcessInfoNone -> String)
-> ([ProcessInfoNone] -> ShowS)
-> Show ProcessInfoNone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessInfoNone -> ShowS
showsPrec :: Int -> ProcessInfoNone -> ShowS
$cshow :: ProcessInfoNone -> String
show :: ProcessInfoNone -> String
$cshowList :: [ProcessInfoNone] -> ShowS
showList :: [ProcessInfoNone] -> ShowS
Show, Typeable)
data NCMsg = NCMsg
{ NCMsg -> Identifier
ctrlMsgSender :: !Identifier
, NCMsg -> ProcessSignal
ctrlMsgSignal :: !ProcessSignal
}
deriving Int -> NCMsg -> ShowS
[NCMsg] -> ShowS
NCMsg -> String
(Int -> NCMsg -> ShowS)
-> (NCMsg -> String) -> ([NCMsg] -> ShowS) -> Show NCMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NCMsg -> ShowS
showsPrec :: Int -> NCMsg -> ShowS
$cshow :: NCMsg -> String
show :: NCMsg -> String
$cshowList :: [NCMsg] -> ShowS
showList :: [NCMsg] -> ShowS
Show
data ProcessSignal =
Link !Identifier
| Unlink !Identifier
| Monitor !MonitorRef
| Unmonitor !MonitorRef
| Died Identifier !DiedReason
| Spawn !(Closure (Process ())) !SpawnRef
| WhereIs !String
| Register !String !NodeId !(Maybe ProcessId) !Bool
| NamedSend !String !Message
| UnreliableSend !LocalProcessId !Message
| LocalSend !ProcessId !Message
| LocalPortSend !SendPortId !Message
| Kill !ProcessId !String
| Exit !ProcessId !Message
| GetInfo !ProcessId
| SigShutdown
| GetNodeStats !NodeId
deriving Int -> ProcessSignal -> ShowS
[ProcessSignal] -> ShowS
ProcessSignal -> String
(Int -> ProcessSignal -> ShowS)
-> (ProcessSignal -> String)
-> ([ProcessSignal] -> ShowS)
-> Show ProcessSignal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessSignal -> ShowS
showsPrec :: Int -> ProcessSignal -> ShowS
$cshow :: ProcessSignal -> String
show :: ProcessSignal -> String
$cshowList :: [ProcessSignal] -> ShowS
showList :: [ProcessSignal] -> ShowS
Show
instance Binary Message where
put :: Message -> Put
put Message
msg = [ByteString] -> Put
forall t. Binary t => t -> Put
put ([ByteString] -> Put) -> [ByteString] -> Put
forall a b. (a -> b) -> a -> b
$ Message -> [ByteString]
messageToPayload Message
msg
get :: Get Message
get = [ByteString] -> Message
payloadToMessage ([ByteString] -> Message) -> Get [ByteString] -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get
instance Binary LocalProcessId where
put :: LocalProcessId -> Put
put LocalProcessId
lpid = LocalSendPortId -> Put
forall t. Binary t => t -> Put
put (LocalProcessId -> LocalSendPortId
lpidUnique LocalProcessId
lpid) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LocalSendPortId -> Put
forall t. Binary t => t -> Put
put (LocalProcessId -> LocalSendPortId
lpidCounter LocalProcessId
lpid)
get :: Get LocalProcessId
get = LocalSendPortId -> LocalSendPortId -> LocalProcessId
LocalProcessId (LocalSendPortId -> LocalSendPortId -> LocalProcessId)
-> Get LocalSendPortId -> Get (LocalSendPortId -> LocalProcessId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LocalSendPortId
forall t. Binary t => Get t
get Get (LocalSendPortId -> LocalProcessId)
-> Get LocalSendPortId -> Get LocalProcessId
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get LocalSendPortId
forall t. Binary t => Get t
get
instance Binary ProcessMonitorNotification where
put :: ProcessMonitorNotification -> Put
put (ProcessMonitorNotification MonitorRef
ref ProcessId
pid DiedReason
reason) = MonitorRef -> Put
forall t. Binary t => t -> Put
put MonitorRef
ref Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiedReason -> Put
forall t. Binary t => t -> Put
put DiedReason
reason
get :: Get ProcessMonitorNotification
get = MonitorRef -> ProcessId -> DiedReason -> ProcessMonitorNotification
ProcessMonitorNotification (MonitorRef
-> ProcessId -> DiedReason -> ProcessMonitorNotification)
-> Get MonitorRef
-> Get (ProcessId -> DiedReason -> ProcessMonitorNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MonitorRef
forall t. Binary t => Get t
get Get (ProcessId -> DiedReason -> ProcessMonitorNotification)
-> Get ProcessId -> Get (DiedReason -> ProcessMonitorNotification)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ProcessId
forall t. Binary t => Get t
get Get (DiedReason -> ProcessMonitorNotification)
-> Get DiedReason -> Get ProcessMonitorNotification
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DiedReason
forall t. Binary t => Get t
get
instance Binary NodeMonitorNotification where
put :: NodeMonitorNotification -> Put
put (NodeMonitorNotification MonitorRef
ref NodeId
pid DiedReason
reason) = MonitorRef -> Put
forall t. Binary t => t -> Put
put MonitorRef
ref Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NodeId -> Put
forall t. Binary t => t -> Put
put NodeId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiedReason -> Put
forall t. Binary t => t -> Put
put DiedReason
reason
get :: Get NodeMonitorNotification
get = MonitorRef -> NodeId -> DiedReason -> NodeMonitorNotification
NodeMonitorNotification (MonitorRef -> NodeId -> DiedReason -> NodeMonitorNotification)
-> Get MonitorRef
-> Get (NodeId -> DiedReason -> NodeMonitorNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MonitorRef
forall t. Binary t => Get t
get Get (NodeId -> DiedReason -> NodeMonitorNotification)
-> Get NodeId -> Get (DiedReason -> NodeMonitorNotification)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NodeId
forall t. Binary t => Get t
get Get (DiedReason -> NodeMonitorNotification)
-> Get DiedReason -> Get NodeMonitorNotification
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DiedReason
forall t. Binary t => Get t
get
instance Binary PortMonitorNotification where
put :: PortMonitorNotification -> Put
put (PortMonitorNotification MonitorRef
ref SendPortId
pid DiedReason
reason) = MonitorRef -> Put
forall t. Binary t => t -> Put
put MonitorRef
ref Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SendPortId -> Put
forall t. Binary t => t -> Put
put SendPortId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiedReason -> Put
forall t. Binary t => t -> Put
put DiedReason
reason
get :: Get PortMonitorNotification
get = MonitorRef -> SendPortId -> DiedReason -> PortMonitorNotification
PortMonitorNotification (MonitorRef -> SendPortId -> DiedReason -> PortMonitorNotification)
-> Get MonitorRef
-> Get (SendPortId -> DiedReason -> PortMonitorNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MonitorRef
forall t. Binary t => Get t
get Get (SendPortId -> DiedReason -> PortMonitorNotification)
-> Get SendPortId -> Get (DiedReason -> PortMonitorNotification)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SendPortId
forall t. Binary t => Get t
get Get (DiedReason -> PortMonitorNotification)
-> Get DiedReason -> Get PortMonitorNotification
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DiedReason
forall t. Binary t => Get t
get
instance Binary NCMsg where
put :: NCMsg -> Put
put NCMsg
msg = Identifier -> Put
forall t. Binary t => t -> Put
put (NCMsg -> Identifier
ctrlMsgSender NCMsg
msg) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessSignal -> Put
forall t. Binary t => t -> Put
put (NCMsg -> ProcessSignal
ctrlMsgSignal NCMsg
msg)
get :: Get NCMsg
get = Identifier -> ProcessSignal -> NCMsg
NCMsg (Identifier -> ProcessSignal -> NCMsg)
-> Get Identifier -> Get (ProcessSignal -> NCMsg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get Get (ProcessSignal -> NCMsg) -> Get ProcessSignal -> Get NCMsg
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ProcessSignal
forall t. Binary t => Get t
get
instance Binary MonitorRef where
put :: MonitorRef -> Put
put MonitorRef
ref = Identifier -> Put
forall t. Binary t => t -> Put
put (MonitorRef -> Identifier
monitorRefIdent MonitorRef
ref) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LocalSendPortId -> Put
forall t. Binary t => t -> Put
put (MonitorRef -> LocalSendPortId
monitorRefCounter MonitorRef
ref)
get :: Get MonitorRef
get = Identifier -> LocalSendPortId -> MonitorRef
MonitorRef (Identifier -> LocalSendPortId -> MonitorRef)
-> Get Identifier -> Get (LocalSendPortId -> MonitorRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get Get (LocalSendPortId -> MonitorRef)
-> Get LocalSendPortId -> Get MonitorRef
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get LocalSendPortId
forall t. Binary t => Get t
get
instance Binary ProcessSignal where
put :: ProcessSignal -> Put
put (Link Identifier
pid) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Identifier -> Put
forall t. Binary t => t -> Put
put Identifier
pid
put (Unlink Identifier
pid) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Identifier -> Put
forall t. Binary t => t -> Put
put Identifier
pid
put (Monitor MonitorRef
ref) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MonitorRef -> Put
forall t. Binary t => t -> Put
put MonitorRef
ref
put (Unmonitor MonitorRef
ref) = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MonitorRef -> Put
forall t. Binary t => t -> Put
put MonitorRef
ref
put (Died Identifier
who DiedReason
reason) = Word8 -> Put
putWord8 Word8
4 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Identifier -> Put
forall t. Binary t => t -> Put
put Identifier
who Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiedReason -> Put
forall t. Binary t => t -> Put
put DiedReason
reason
put (Spawn Closure (Process ())
proc SpawnRef
ref) = Word8 -> Put
putWord8 Word8
5 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Closure (Process ()) -> Put
forall t. Binary t => t -> Put
put Closure (Process ())
proc Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SpawnRef -> Put
forall t. Binary t => t -> Put
put SpawnRef
ref
put (WhereIs String
label) = Word8 -> Put
putWord8 Word8
6 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
label
put (Register String
label NodeId
nid Maybe ProcessId
pid Bool
force) = Word8 -> Put
putWord8 Word8
7 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
label Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NodeId -> Put
forall t. Binary t => t -> Put
put NodeId
nid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ProcessId -> Put
forall t. Binary t => t -> Put
put Maybe ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
force
put (NamedSend String
label Message
msg) = Word8 -> Put
putWord8 Word8
8 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
label Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put (Message -> [ByteString]
messageToPayload Message
msg)
put (Kill ProcessId
pid String
reason) = Word8 -> Put
putWord8 Word8
9 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
reason
put (Exit ProcessId
pid Message
reason) = Word8 -> Put
putWord8 Word8
10 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put (Message -> [ByteString]
messageToPayload Message
reason)
put (LocalSend ProcessId
to' Message
msg) = Word8 -> Put
putWord8 Word8
11 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
to' Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put (Message -> [ByteString]
messageToPayload Message
msg)
put (LocalPortSend SendPortId
sid Message
msg) = Word8 -> Put
putWord8 Word8
12 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SendPortId -> Put
forall t. Binary t => t -> Put
put SendPortId
sid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put (Message -> [ByteString]
messageToPayload Message
msg)
put (UnreliableSend LocalProcessId
lpid Message
msg) = Word8 -> Put
putWord8 Word8
13 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LocalProcessId -> Put
forall t. Binary t => t -> Put
put LocalProcessId
lpid Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> Put
forall t. Binary t => t -> Put
put (Message -> [ByteString]
messageToPayload Message
msg)
put (GetInfo ProcessId
about) = Word8 -> Put
putWord8 Word8
30 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
about
put (ProcessSignal
SigShutdown) = Word8 -> Put
putWord8 Word8
31
put (GetNodeStats NodeId
nid) = Word8 -> Put
putWord8 Word8
32 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NodeId -> Put
forall t. Binary t => t -> Put
put NodeId
nid
get :: Get ProcessSignal
get = do
Word8
header <- Get Word8
getWord8
case Word8
header of
Word8
0 -> Identifier -> ProcessSignal
Link (Identifier -> ProcessSignal)
-> Get Identifier -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get
Word8
1 -> Identifier -> ProcessSignal
Unlink (Identifier -> ProcessSignal)
-> Get Identifier -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get
Word8
2 -> MonitorRef -> ProcessSignal
Monitor (MonitorRef -> ProcessSignal)
-> Get MonitorRef -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MonitorRef
forall t. Binary t => Get t
get
Word8
3 -> MonitorRef -> ProcessSignal
Unmonitor (MonitorRef -> ProcessSignal)
-> Get MonitorRef -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MonitorRef
forall t. Binary t => Get t
get
Word8
4 -> Identifier -> DiedReason -> ProcessSignal
Died (Identifier -> DiedReason -> ProcessSignal)
-> Get Identifier -> Get (DiedReason -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Identifier
forall t. Binary t => Get t
get Get (DiedReason -> ProcessSignal)
-> Get DiedReason -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get DiedReason
forall t. Binary t => Get t
get
Word8
5 -> Closure (Process ()) -> SpawnRef -> ProcessSignal
Spawn (Closure (Process ()) -> SpawnRef -> ProcessSignal)
-> Get (Closure (Process ())) -> Get (SpawnRef -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Closure (Process ()))
forall t. Binary t => Get t
get Get (SpawnRef -> ProcessSignal)
-> Get SpawnRef -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SpawnRef
forall t. Binary t => Get t
get
Word8
6 -> String -> ProcessSignal
WhereIs (String -> ProcessSignal) -> Get String -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
Word8
7 -> String -> NodeId -> Maybe ProcessId -> Bool -> ProcessSignal
Register (String -> NodeId -> Maybe ProcessId -> Bool -> ProcessSignal)
-> Get String
-> Get (NodeId -> Maybe ProcessId -> Bool -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get (NodeId -> Maybe ProcessId -> Bool -> ProcessSignal)
-> Get NodeId -> Get (Maybe ProcessId -> Bool -> ProcessSignal)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get NodeId
forall t. Binary t => Get t
get Get (Maybe ProcessId -> Bool -> ProcessSignal)
-> Get (Maybe ProcessId) -> Get (Bool -> ProcessSignal)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Maybe ProcessId)
forall t. Binary t => Get t
get Get (Bool -> ProcessSignal) -> Get Bool -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get
Word8
8 -> String -> Message -> ProcessSignal
NamedSend (String -> Message -> ProcessSignal)
-> Get String -> Get (Message -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get (Message -> ProcessSignal) -> Get Message -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ByteString] -> Message
payloadToMessage ([ByteString] -> Message) -> Get [ByteString] -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get)
Word8
9 -> ProcessId -> String -> ProcessSignal
Kill (ProcessId -> String -> ProcessSignal)
-> Get ProcessId -> Get (String -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (String -> ProcessSignal) -> Get String -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get
Word8
10 -> ProcessId -> Message -> ProcessSignal
Exit (ProcessId -> Message -> ProcessSignal)
-> Get ProcessId -> Get (Message -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (Message -> ProcessSignal) -> Get Message -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ByteString] -> Message
payloadToMessage ([ByteString] -> Message) -> Get [ByteString] -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get)
Word8
11 -> ProcessId -> Message -> ProcessSignal
LocalSend (ProcessId -> Message -> ProcessSignal)
-> Get ProcessId -> Get (Message -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (Message -> ProcessSignal) -> Get Message -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ByteString] -> Message
payloadToMessage ([ByteString] -> Message) -> Get [ByteString] -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get)
Word8
12 -> SendPortId -> Message -> ProcessSignal
LocalPortSend (SendPortId -> Message -> ProcessSignal)
-> Get SendPortId -> Get (Message -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SendPortId
forall t. Binary t => Get t
get Get (Message -> ProcessSignal) -> Get Message -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ByteString] -> Message
payloadToMessage ([ByteString] -> Message) -> Get [ByteString] -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get)
Word8
13 -> LocalProcessId -> Message -> ProcessSignal
UnreliableSend (LocalProcessId -> Message -> ProcessSignal)
-> Get LocalProcessId -> Get (Message -> ProcessSignal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LocalProcessId
forall t. Binary t => Get t
get Get (Message -> ProcessSignal) -> Get Message -> Get ProcessSignal
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ByteString] -> Message
payloadToMessage ([ByteString] -> Message) -> Get [ByteString] -> Get Message
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get)
Word8
30 -> ProcessId -> ProcessSignal
GetInfo (ProcessId -> ProcessSignal) -> Get ProcessId -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get
Word8
31 -> ProcessSignal -> Get ProcessSignal
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessSignal
SigShutdown
Word8
32 -> NodeId -> ProcessSignal
GetNodeStats (NodeId -> ProcessSignal) -> Get NodeId -> Get ProcessSignal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NodeId
forall t. Binary t => Get t
get
Word8
_ -> String -> Get ProcessSignal
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ProcessSignal.get: invalid"
instance Binary DiedReason where
put :: DiedReason -> Put
put DiedReason
DiedNormal = Word8 -> Put
putWord8 Word8
0
put (DiedException String
e) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
e
put DiedReason
DiedDisconnect = Word8 -> Put
putWord8 Word8
2
put DiedReason
DiedNodeDown = Word8 -> Put
putWord8 Word8
3
put DiedReason
DiedUnknownId = Word8 -> Put
putWord8 Word8
4
get :: Get DiedReason
get = do
Word8
header <- Get Word8
getWord8
case Word8
header of
Word8
0 -> DiedReason -> Get DiedReason
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return DiedReason
DiedNormal
Word8
1 -> String -> DiedReason
DiedException (String -> DiedReason) -> Get String -> Get DiedReason
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get
Word8
2 -> DiedReason -> Get DiedReason
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return DiedReason
DiedDisconnect
Word8
3 -> DiedReason -> Get DiedReason
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return DiedReason
DiedNodeDown
Word8
4 -> DiedReason -> Get DiedReason
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return DiedReason
DiedUnknownId
Word8
_ -> String -> Get DiedReason
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DiedReason.get: invalid"
instance Binary DidSpawn where
put :: DidSpawn -> Put
put (DidSpawn SpawnRef
ref ProcessId
pid) = SpawnRef -> Put
forall t. Binary t => t -> Put
put SpawnRef
ref Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid
get :: Get DidSpawn
get = SpawnRef -> ProcessId -> DidSpawn
DidSpawn (SpawnRef -> ProcessId -> DidSpawn)
-> Get SpawnRef -> Get (ProcessId -> DidSpawn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SpawnRef
forall t. Binary t => Get t
get Get (ProcessId -> DidSpawn) -> Get ProcessId -> Get DidSpawn
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ProcessId
forall t. Binary t => Get t
get
instance Binary SendPortId where
put :: SendPortId -> Put
put SendPortId
cid = ProcessId -> Put
forall t. Binary t => t -> Put
put (SendPortId -> ProcessId
sendPortProcessId SendPortId
cid) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LocalSendPortId -> Put
forall t. Binary t => t -> Put
put (SendPortId -> LocalSendPortId
sendPortLocalId SendPortId
cid)
get :: Get SendPortId
get = ProcessId -> LocalSendPortId -> SendPortId
SendPortId (ProcessId -> LocalSendPortId -> SendPortId)
-> Get ProcessId -> Get (LocalSendPortId -> SendPortId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get Get (LocalSendPortId -> SendPortId)
-> Get LocalSendPortId -> Get SendPortId
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get LocalSendPortId
forall t. Binary t => Get t
get
instance Binary Identifier where
put :: Identifier -> Put
put (ProcessIdentifier ProcessId
pid) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Put
forall t. Binary t => t -> Put
put ProcessId
pid
put (NodeIdentifier NodeId
nid) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NodeId -> Put
forall t. Binary t => t -> Put
put NodeId
nid
put (SendPortIdentifier SendPortId
cid) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SendPortId -> Put
forall t. Binary t => t -> Put
put SendPortId
cid
get :: Get Identifier
get = do
Word8
header <- Get Word8
getWord8
case Word8
header of
Word8
0 -> ProcessId -> Identifier
ProcessIdentifier (ProcessId -> Identifier) -> Get ProcessId -> Get Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProcessId
forall t. Binary t => Get t
get
Word8
1 -> NodeId -> Identifier
NodeIdentifier (NodeId -> Identifier) -> Get NodeId -> Get Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NodeId
forall t. Binary t => Get t
get
Word8
2 -> SendPortId -> Identifier
SendPortIdentifier (SendPortId -> Identifier) -> Get SendPortId -> Get Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SendPortId
forall t. Binary t => Get t
get
Word8
_ -> String -> Get Identifier
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Identifier.get: invalid"
instance Binary WhereIsReply where
put :: WhereIsReply -> Put
put (WhereIsReply String
label Maybe ProcessId
mPid) = String -> Put
forall t. Binary t => t -> Put
put String
label Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ProcessId -> Put
forall t. Binary t => t -> Put
put Maybe ProcessId
mPid
get :: Get WhereIsReply
get = String -> Maybe ProcessId -> WhereIsReply
WhereIsReply (String -> Maybe ProcessId -> WhereIsReply)
-> Get String -> Get (Maybe ProcessId -> WhereIsReply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get (Maybe ProcessId -> WhereIsReply)
-> Get (Maybe ProcessId) -> Get WhereIsReply
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Maybe ProcessId)
forall t. Binary t => Get t
get
instance Binary RegisterReply where
put :: RegisterReply -> Put
put (RegisterReply String
label Bool
ok Maybe ProcessId
owner) = String -> Put
forall t. Binary t => t -> Put
put String
label Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Put
forall t. Binary t => t -> Put
put Bool
ok Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ProcessId -> Put
forall t. Binary t => t -> Put
put Maybe ProcessId
owner
get :: Get RegisterReply
get = String -> Bool -> Maybe ProcessId -> RegisterReply
RegisterReply (String -> Bool -> Maybe ProcessId -> RegisterReply)
-> Get String -> Get (Bool -> Maybe ProcessId -> RegisterReply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get (Bool -> Maybe ProcessId -> RegisterReply)
-> Get Bool -> Get (Maybe ProcessId -> RegisterReply)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get (Maybe ProcessId -> RegisterReply)
-> Get (Maybe ProcessId) -> Get RegisterReply
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Maybe ProcessId)
forall t. Binary t => Get t
get
instance Binary ProcessInfo where
get :: Get ProcessInfo
get = NodeId
-> [String]
-> Int
-> [(ProcessId, MonitorRef)]
-> [ProcessId]
-> ProcessInfo
ProcessInfo (NodeId
-> [String]
-> Int
-> [(ProcessId, MonitorRef)]
-> [ProcessId]
-> ProcessInfo)
-> Get NodeId
-> Get
([String]
-> Int -> [(ProcessId, MonitorRef)] -> [ProcessId] -> ProcessInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NodeId
forall t. Binary t => Get t
get Get
([String]
-> Int -> [(ProcessId, MonitorRef)] -> [ProcessId] -> ProcessInfo)
-> Get [String]
-> Get
(Int -> [(ProcessId, MonitorRef)] -> [ProcessId] -> ProcessInfo)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [String]
forall t. Binary t => Get t
get Get
(Int -> [(ProcessId, MonitorRef)] -> [ProcessId] -> ProcessInfo)
-> Get Int
-> Get ([(ProcessId, MonitorRef)] -> [ProcessId] -> ProcessInfo)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get ([(ProcessId, MonitorRef)] -> [ProcessId] -> ProcessInfo)
-> Get [(ProcessId, MonitorRef)]
-> Get ([ProcessId] -> ProcessInfo)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [(ProcessId, MonitorRef)]
forall t. Binary t => Get t
get Get ([ProcessId] -> ProcessInfo)
-> Get [ProcessId] -> Get ProcessInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [ProcessId]
forall t. Binary t => Get t
get
put :: ProcessInfo -> Put
put ProcessInfo
pInfo = NodeId -> Put
forall t. Binary t => t -> Put
put (ProcessInfo -> NodeId
infoNode ProcessInfo
pInfo)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> Put
forall t. Binary t => t -> Put
put (ProcessInfo -> [String]
infoRegisteredNames ProcessInfo
pInfo)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put (ProcessInfo -> Int
infoMessageQueueLength ProcessInfo
pInfo)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(ProcessId, MonitorRef)] -> Put
forall t. Binary t => t -> Put
put (ProcessInfo -> [(ProcessId, MonitorRef)]
infoMonitors ProcessInfo
pInfo)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ProcessId] -> Put
forall t. Binary t => t -> Put
put (ProcessInfo -> [ProcessId]
infoLinks ProcessInfo
pInfo)
instance Binary NodeStats where
get :: Get NodeStats
get = NodeId -> Int -> Int -> Int -> Int -> NodeStats
NodeStats (NodeId -> Int -> Int -> Int -> Int -> NodeStats)
-> Get NodeId -> Get (Int -> Int -> Int -> Int -> NodeStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NodeId
forall t. Binary t => Get t
get Get (Int -> Int -> Int -> Int -> NodeStats)
-> Get Int -> Get (Int -> Int -> Int -> NodeStats)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> Int -> Int -> NodeStats)
-> Get Int -> Get (Int -> Int -> NodeStats)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> Int -> NodeStats) -> Get Int -> Get (Int -> NodeStats)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get Get (Int -> NodeStats) -> Get Int -> Get NodeStats
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
forall t. Binary t => Get t
get
put :: NodeStats -> Put
put NodeStats
nStats = NodeId -> Put
forall t. Binary t => t -> Put
put (NodeStats -> NodeId
nodeStatsNode NodeStats
nStats)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put (NodeStats -> Int
nodeStatsRegisteredNames NodeStats
nStats)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put (NodeStats -> Int
nodeStatsMonitors NodeStats
nStats)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put (NodeStats -> Int
nodeStatsLinks NodeStats
nStats)
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put (NodeStats -> Int
nodeStatsProcesses NodeStats
nStats)
instance Binary ProcessInfoNone where
get :: Get ProcessInfoNone
get = DiedReason -> ProcessInfoNone
ProcessInfoNone (DiedReason -> ProcessInfoNone)
-> Get DiedReason -> Get ProcessInfoNone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get DiedReason
forall t. Binary t => Get t
get
put :: ProcessInfoNone -> Put
put (ProcessInfoNone DiedReason
r) = DiedReason -> Put
forall t. Binary t => t -> Put
put DiedReason
r
localProcesses :: Accessor ValidLocalNodeState (Map LocalProcessId LocalProcess)
localProcesses :: Accessor ValidLocalNodeState (Map LocalProcessId LocalProcess)
localProcesses = (ValidLocalNodeState -> Map LocalProcessId LocalProcess)
-> (Map LocalProcessId LocalProcess
-> ValidLocalNodeState -> ValidLocalNodeState)
-> Accessor ValidLocalNodeState (Map LocalProcessId LocalProcess)
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor ValidLocalNodeState -> Map LocalProcessId LocalProcess
_localProcesses (\Map LocalProcessId LocalProcess
procs ValidLocalNodeState
st -> ValidLocalNodeState
st { _localProcesses = procs })
localPidCounter :: Accessor ValidLocalNodeState Int32
localPidCounter :: Accessor ValidLocalNodeState LocalSendPortId
localPidCounter = (ValidLocalNodeState -> LocalSendPortId)
-> (LocalSendPortId -> ValidLocalNodeState -> ValidLocalNodeState)
-> Accessor ValidLocalNodeState LocalSendPortId
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor ValidLocalNodeState -> LocalSendPortId
_localPidCounter (\LocalSendPortId
ctr ValidLocalNodeState
st -> ValidLocalNodeState
st { _localPidCounter = ctr })
localPidUnique :: Accessor ValidLocalNodeState Int32
localPidUnique :: Accessor ValidLocalNodeState LocalSendPortId
localPidUnique = (ValidLocalNodeState -> LocalSendPortId)
-> (LocalSendPortId -> ValidLocalNodeState -> ValidLocalNodeState)
-> Accessor ValidLocalNodeState LocalSendPortId
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor ValidLocalNodeState -> LocalSendPortId
_localPidUnique (\LocalSendPortId
unq ValidLocalNodeState
st -> ValidLocalNodeState
st { _localPidUnique = unq })
localConnections :: Accessor ValidLocalNodeState (Map (Identifier, Identifier) (NT.Connection, ImplicitReconnect))
localConnections :: Accessor
ValidLocalNodeState
(Map (Identifier, Identifier) (Connection, ImplicitReconnect))
localConnections = (ValidLocalNodeState
-> Map (Identifier, Identifier) (Connection, ImplicitReconnect))
-> (Map (Identifier, Identifier) (Connection, ImplicitReconnect)
-> ValidLocalNodeState -> ValidLocalNodeState)
-> Accessor
ValidLocalNodeState
(Map (Identifier, Identifier) (Connection, ImplicitReconnect))
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor ValidLocalNodeState
-> Map (Identifier, Identifier) (Connection, ImplicitReconnect)
_localConnections (\Map (Identifier, Identifier) (Connection, ImplicitReconnect)
conns ValidLocalNodeState
st -> ValidLocalNodeState
st { _localConnections = conns })
localProcessWithId :: LocalProcessId -> Accessor ValidLocalNodeState (Maybe LocalProcess)
localProcessWithId :: LocalProcessId -> Accessor ValidLocalNodeState (Maybe LocalProcess)
localProcessWithId LocalProcessId
lpid = Accessor ValidLocalNodeState (Map LocalProcessId LocalProcess)
localProcesses Accessor ValidLocalNodeState (Map LocalProcessId LocalProcess)
-> T (Map LocalProcessId LocalProcess) (Maybe LocalProcess)
-> Accessor ValidLocalNodeState (Maybe LocalProcess)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LocalProcessId
-> T (Map LocalProcessId LocalProcess) (Maybe LocalProcess)
forall key elem.
Ord key =>
key -> Accessor (Map key elem) (Maybe elem)
DAC.mapMaybe LocalProcessId
lpid
localConnectionBetween :: Identifier -> Identifier -> Accessor ValidLocalNodeState (Maybe (NT.Connection, ImplicitReconnect))
localConnectionBetween :: Identifier
-> Identifier
-> Accessor
ValidLocalNodeState (Maybe (Connection, ImplicitReconnect))
localConnectionBetween Identifier
from' Identifier
to' = Accessor
ValidLocalNodeState
(Map (Identifier, Identifier) (Connection, ImplicitReconnect))
localConnections Accessor
ValidLocalNodeState
(Map (Identifier, Identifier) (Connection, ImplicitReconnect))
-> T (Map (Identifier, Identifier) (Connection, ImplicitReconnect))
(Maybe (Connection, ImplicitReconnect))
-> Accessor
ValidLocalNodeState (Maybe (Connection, ImplicitReconnect))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Identifier, Identifier)
-> T (Map (Identifier, Identifier) (Connection, ImplicitReconnect))
(Maybe (Connection, ImplicitReconnect))
forall key elem.
Ord key =>
key -> Accessor (Map key elem) (Maybe elem)
DAC.mapMaybe (Identifier
from', Identifier
to')
monitorCounter :: Accessor LocalProcessState Int32
monitorCounter :: Accessor LocalProcessState LocalSendPortId
monitorCounter = (LocalProcessState -> LocalSendPortId)
-> (LocalSendPortId -> LocalProcessState -> LocalProcessState)
-> Accessor LocalProcessState LocalSendPortId
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor LocalProcessState -> LocalSendPortId
_monitorCounter (\LocalSendPortId
cnt LocalProcessState
st -> LocalProcessState
st { _monitorCounter = cnt })
spawnCounter :: Accessor LocalProcessState Int32
spawnCounter :: Accessor LocalProcessState LocalSendPortId
spawnCounter = (LocalProcessState -> LocalSendPortId)
-> (LocalSendPortId -> LocalProcessState -> LocalProcessState)
-> Accessor LocalProcessState LocalSendPortId
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor LocalProcessState -> LocalSendPortId
_spawnCounter (\LocalSendPortId
cnt LocalProcessState
st -> LocalProcessState
st { _spawnCounter = cnt })
channelCounter :: Accessor LocalProcessState LocalSendPortId
channelCounter :: Accessor LocalProcessState LocalSendPortId
channelCounter = (LocalProcessState -> LocalSendPortId)
-> (LocalSendPortId -> LocalProcessState -> LocalProcessState)
-> Accessor LocalProcessState LocalSendPortId
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor LocalProcessState -> LocalSendPortId
_channelCounter (\LocalSendPortId
cnt LocalProcessState
st -> LocalProcessState
st { _channelCounter = cnt })
typedChannels :: Accessor LocalProcessState (Map LocalSendPortId TypedChannel)
typedChannels :: Accessor LocalProcessState (Map LocalSendPortId TypedChannel)
typedChannels = (LocalProcessState -> Map LocalSendPortId TypedChannel)
-> (Map LocalSendPortId TypedChannel
-> LocalProcessState -> LocalProcessState)
-> Accessor LocalProcessState (Map LocalSendPortId TypedChannel)
forall r a. (r -> a) -> (a -> r -> r) -> Accessor r a
accessor LocalProcessState -> Map LocalSendPortId TypedChannel
_typedChannels (\Map LocalSendPortId TypedChannel
cs LocalProcessState
st -> LocalProcessState
st { _typedChannels = cs })
typedChannelWithId :: LocalSendPortId -> Accessor LocalProcessState (Maybe TypedChannel)
typedChannelWithId :: LocalSendPortId -> Accessor LocalProcessState (Maybe TypedChannel)
typedChannelWithId LocalSendPortId
cid = Accessor LocalProcessState (Map LocalSendPortId TypedChannel)
typedChannels Accessor LocalProcessState (Map LocalSendPortId TypedChannel)
-> T (Map LocalSendPortId TypedChannel) (Maybe TypedChannel)
-> Accessor LocalProcessState (Maybe TypedChannel)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LocalSendPortId
-> T (Map LocalSendPortId TypedChannel) (Maybe TypedChannel)
forall key elem.
Ord key =>
key -> Accessor (Map key elem) (Maybe elem)
DAC.mapMaybe LocalSendPortId
cid
{-# INLINE forever' #-}
forever' :: Monad m => m a -> m b
forever' :: forall (m :: * -> *) a b. Monad m => m a -> m b
forever' m a
a = let a' :: m b
a' = m a
a m a -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
a' in m b
a'