{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
module Control.Distributed.Process.Management.Internal.Types
( MxAgentId(..)
, MxAgentState(..)
, MxAgent(..)
, MxAction(..)
, ChannelSelector(..)
, Fork
, MxSink
, MxEvent(..)
, Addressable(..)
) where
import Control.Concurrent.STM
( TChan
)
import Control.Distributed.Process.Internal.Types
( Process
, ProcessId
, SendPortId
, Message
, DiedReason
, NodeId
)
import Control.Monad.IO.Class (MonadIO)
import qualified Control.Monad.State as ST
( MonadState
, StateT
)
import Control.Monad.Fix (MonadFix)
import Data.Binary
import Data.Typeable (Typeable)
import GHC.Generics
import Network.Transport
( ConnectionId
, EndPointAddress
)
data MxEvent =
MxSpawned ProcessId
| MxRegistered ProcessId String
| MxUnRegistered ProcessId String
| MxProcessDied ProcessId DiedReason
| MxNodeDied NodeId DiedReason
| MxSent ProcessId ProcessId Message
| MxSentToName String ProcessId Message
| MxSentToPort ProcessId SendPortId Message
| MxReceived ProcessId Message
| MxReceivedPort SendPortId Message
| MxConnected ConnectionId EndPointAddress
| MxDisconnected ConnectionId EndPointAddress
| MxUser Message
| MxLog String
| MxTraceTakeover ProcessId
| MxTraceDisable
deriving (Typeable, (forall x. MxEvent -> Rep MxEvent x)
-> (forall x. Rep MxEvent x -> MxEvent) -> Generic MxEvent
forall x. Rep MxEvent x -> MxEvent
forall x. MxEvent -> Rep MxEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MxEvent -> Rep MxEvent x
from :: forall x. MxEvent -> Rep MxEvent x
$cto :: forall x. Rep MxEvent x -> MxEvent
to :: forall x. Rep MxEvent x -> MxEvent
Generic, Int -> MxEvent -> ShowS
[MxEvent] -> ShowS
MxEvent -> String
(Int -> MxEvent -> ShowS)
-> (MxEvent -> String) -> ([MxEvent] -> ShowS) -> Show MxEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MxEvent -> ShowS
showsPrec :: Int -> MxEvent -> ShowS
$cshow :: MxEvent -> String
show :: MxEvent -> String
$cshowList :: [MxEvent] -> ShowS
showList :: [MxEvent] -> ShowS
Show)
instance Binary MxEvent where
class Addressable a where
resolveToPid :: a -> Maybe ProcessId
instance Addressable MxEvent where
resolveToPid :: MxEvent -> Maybe ProcessId
resolveToPid (MxSpawned ProcessId
p) = ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
p
resolveToPid (MxProcessDied ProcessId
p DiedReason
_) = ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
p
resolveToPid (MxSent ProcessId
_ ProcessId
p Message
_) = ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
p
resolveToPid (MxReceived ProcessId
p Message
_) = ProcessId -> Maybe ProcessId
forall a. a -> Maybe a
Just ProcessId
p
resolveToPid MxEvent
_ = Maybe ProcessId
forall a. Maybe a
Nothing
type Fork = (Process () -> IO ProcessId)
newtype MxAgentId = MxAgentId { MxAgentId -> String
agentId :: String }
deriving (Typeable, Get MxAgentId
[MxAgentId] -> Put
MxAgentId -> Put
(MxAgentId -> Put)
-> Get MxAgentId -> ([MxAgentId] -> Put) -> Binary MxAgentId
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: MxAgentId -> Put
put :: MxAgentId -> Put
$cget :: Get MxAgentId
get :: Get MxAgentId
$cputList :: [MxAgentId] -> Put
putList :: [MxAgentId] -> Put
Binary, MxAgentId -> MxAgentId -> Bool
(MxAgentId -> MxAgentId -> Bool)
-> (MxAgentId -> MxAgentId -> Bool) -> Eq MxAgentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MxAgentId -> MxAgentId -> Bool
== :: MxAgentId -> MxAgentId -> Bool
$c/= :: MxAgentId -> MxAgentId -> Bool
/= :: MxAgentId -> MxAgentId -> Bool
Eq, Eq MxAgentId
Eq MxAgentId =>
(MxAgentId -> MxAgentId -> Ordering)
-> (MxAgentId -> MxAgentId -> Bool)
-> (MxAgentId -> MxAgentId -> Bool)
-> (MxAgentId -> MxAgentId -> Bool)
-> (MxAgentId -> MxAgentId -> Bool)
-> (MxAgentId -> MxAgentId -> MxAgentId)
-> (MxAgentId -> MxAgentId -> MxAgentId)
-> Ord MxAgentId
MxAgentId -> MxAgentId -> Bool
MxAgentId -> MxAgentId -> Ordering
MxAgentId -> MxAgentId -> MxAgentId
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 :: MxAgentId -> MxAgentId -> Ordering
compare :: MxAgentId -> MxAgentId -> Ordering
$c< :: MxAgentId -> MxAgentId -> Bool
< :: MxAgentId -> MxAgentId -> Bool
$c<= :: MxAgentId -> MxAgentId -> Bool
<= :: MxAgentId -> MxAgentId -> Bool
$c> :: MxAgentId -> MxAgentId -> Bool
> :: MxAgentId -> MxAgentId -> Bool
$c>= :: MxAgentId -> MxAgentId -> Bool
>= :: MxAgentId -> MxAgentId -> Bool
$cmax :: MxAgentId -> MxAgentId -> MxAgentId
max :: MxAgentId -> MxAgentId -> MxAgentId
$cmin :: MxAgentId -> MxAgentId -> MxAgentId
min :: MxAgentId -> MxAgentId -> MxAgentId
Ord)
data MxAgentState s = MxAgentState
{
forall s. MxAgentState s -> MxAgentId
mxAgentId :: !MxAgentId
, forall s. MxAgentState s -> TChan Message
mxBus :: !(TChan Message)
, forall s. MxAgentState s -> s
mxLocalState :: !s
}
newtype MxAgent s a =
MxAgent
{
forall s a. MxAgent s a -> StateT (MxAgentState s) Process a
unAgent :: ST.StateT (MxAgentState s) Process a
} deriving ( (forall a b. (a -> b) -> MxAgent s a -> MxAgent s b)
-> (forall a b. a -> MxAgent s b -> MxAgent s a)
-> Functor (MxAgent s)
forall a b. a -> MxAgent s b -> MxAgent s a
forall a b. (a -> b) -> MxAgent s a -> MxAgent s b
forall s a b. a -> MxAgent s b -> MxAgent s a
forall s a b. (a -> b) -> MxAgent s a -> MxAgent s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> MxAgent s a -> MxAgent s b
fmap :: forall a b. (a -> b) -> MxAgent s a -> MxAgent s b
$c<$ :: forall s a b. a -> MxAgent s b -> MxAgent s a
<$ :: forall a b. a -> MxAgent s b -> MxAgent s a
Functor
, Applicative (MxAgent s)
Applicative (MxAgent s) =>
(forall a b. MxAgent s a -> (a -> MxAgent s b) -> MxAgent s b)
-> (forall a b. MxAgent s a -> MxAgent s b -> MxAgent s b)
-> (forall a. a -> MxAgent s a)
-> Monad (MxAgent s)
forall s. Applicative (MxAgent s)
forall a. a -> MxAgent s a
forall s a. a -> MxAgent s a
forall a b. MxAgent s a -> MxAgent s b -> MxAgent s b
forall a b. MxAgent s a -> (a -> MxAgent s b) -> MxAgent s b
forall s a b. MxAgent s a -> MxAgent s b -> MxAgent s b
forall s a b. MxAgent s a -> (a -> MxAgent s b) -> MxAgent s 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 s a b. MxAgent s a -> (a -> MxAgent s b) -> MxAgent s b
>>= :: forall a b. MxAgent s a -> (a -> MxAgent s b) -> MxAgent s b
$c>> :: forall s a b. MxAgent s a -> MxAgent s b -> MxAgent s b
>> :: forall a b. MxAgent s a -> MxAgent s b -> MxAgent s b
$creturn :: forall s a. a -> MxAgent s a
return :: forall a. a -> MxAgent s a
Monad
, Monad (MxAgent s)
Monad (MxAgent s) =>
(forall a. IO a -> MxAgent s a) -> MonadIO (MxAgent s)
forall s. Monad (MxAgent s)
forall a. IO a -> MxAgent s a
forall s a. IO a -> MxAgent s a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall s a. IO a -> MxAgent s a
liftIO :: forall a. IO a -> MxAgent s a
MonadIO
, Monad (MxAgent s)
Monad (MxAgent s) =>
(forall a. (a -> MxAgent s a) -> MxAgent s a)
-> MonadFix (MxAgent s)
forall s. Monad (MxAgent s)
forall a. (a -> MxAgent s a) -> MxAgent s a
forall s a. (a -> MxAgent s a) -> MxAgent s a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall s a. (a -> MxAgent s a) -> MxAgent s a
mfix :: forall a. (a -> MxAgent s a) -> MxAgent s a
MonadFix
, ST.MonadState (MxAgentState s)
, Typeable
, Functor (MxAgent s)
Functor (MxAgent s) =>
(forall a. a -> MxAgent s a)
-> (forall a b. MxAgent s (a -> b) -> MxAgent s a -> MxAgent s b)
-> (forall a b c.
(a -> b -> c) -> MxAgent s a -> MxAgent s b -> MxAgent s c)
-> (forall a b. MxAgent s a -> MxAgent s b -> MxAgent s b)
-> (forall a b. MxAgent s a -> MxAgent s b -> MxAgent s a)
-> Applicative (MxAgent s)
forall s. Functor (MxAgent s)
forall a. a -> MxAgent s a
forall s a. a -> MxAgent s a
forall a b. MxAgent s a -> MxAgent s b -> MxAgent s a
forall a b. MxAgent s a -> MxAgent s b -> MxAgent s b
forall a b. MxAgent s (a -> b) -> MxAgent s a -> MxAgent s b
forall s a b. MxAgent s a -> MxAgent s b -> MxAgent s a
forall s a b. MxAgent s a -> MxAgent s b -> MxAgent s b
forall s a b. MxAgent s (a -> b) -> MxAgent s a -> MxAgent s b
forall a b c.
(a -> b -> c) -> MxAgent s a -> MxAgent s b -> MxAgent s c
forall s a b c.
(a -> b -> c) -> MxAgent s a -> MxAgent s b -> MxAgent s 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 s a. a -> MxAgent s a
pure :: forall a. a -> MxAgent s a
$c<*> :: forall s a b. MxAgent s (a -> b) -> MxAgent s a -> MxAgent s b
<*> :: forall a b. MxAgent s (a -> b) -> MxAgent s a -> MxAgent s b
$cliftA2 :: forall s a b c.
(a -> b -> c) -> MxAgent s a -> MxAgent s b -> MxAgent s c
liftA2 :: forall a b c.
(a -> b -> c) -> MxAgent s a -> MxAgent s b -> MxAgent s c
$c*> :: forall s a b. MxAgent s a -> MxAgent s b -> MxAgent s b
*> :: forall a b. MxAgent s a -> MxAgent s b -> MxAgent s b
$c<* :: forall s a b. MxAgent s a -> MxAgent s b -> MxAgent s a
<* :: forall a b. MxAgent s a -> MxAgent s b -> MxAgent s a
Applicative
)
data ChannelSelector = InputChan | Mailbox
data MxAction =
MxAgentDeactivate !String
| MxAgentPrioritise !ChannelSelector
| MxAgentReady
| MxAgentSkip
type MxSink s = Message -> MxAgent s (Maybe MxAction)