{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Control.Distributed.Process.Extras.Internal.Unsafe
(
PCopy()
, pCopy
, matchP
, matchChanP
, pUnwrap
, InputStream(Null)
, newInputStream
, matchInputStream
, readInputStream
, InvalidBinaryShim(..)
) where
import Control.Concurrent.STM (STM, atomically)
import Control.Distributed.Process
( matchAny
, matchChan
, matchSTM
, match
, handleMessage
, receiveChan
, liftIO
, die
, Match
, ReceivePort
, Message
, Process
)
import Control.Distributed.Process.Serializable (Serializable)
import Data.Binary
import Control.DeepSeq (NFData)
import Data.Typeable (Typeable)
import GHC.Generics
data InvalidBinaryShim = InvalidBinaryShim
deriving (Typeable, Int -> InvalidBinaryShim -> ShowS
[InvalidBinaryShim] -> ShowS
InvalidBinaryShim -> String
(Int -> InvalidBinaryShim -> ShowS)
-> (InvalidBinaryShim -> String)
-> ([InvalidBinaryShim] -> ShowS)
-> Show InvalidBinaryShim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidBinaryShim -> ShowS
showsPrec :: Int -> InvalidBinaryShim -> ShowS
$cshow :: InvalidBinaryShim -> String
show :: InvalidBinaryShim -> String
$cshowList :: [InvalidBinaryShim] -> ShowS
showList :: [InvalidBinaryShim] -> ShowS
Show, InvalidBinaryShim -> InvalidBinaryShim -> Bool
(InvalidBinaryShim -> InvalidBinaryShim -> Bool)
-> (InvalidBinaryShim -> InvalidBinaryShim -> Bool)
-> Eq InvalidBinaryShim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidBinaryShim -> InvalidBinaryShim -> Bool
== :: InvalidBinaryShim -> InvalidBinaryShim -> Bool
$c/= :: InvalidBinaryShim -> InvalidBinaryShim -> Bool
/= :: InvalidBinaryShim -> InvalidBinaryShim -> Bool
Eq)
data PCopy a = PCopy !a
deriving (Typeable, (forall x. PCopy a -> Rep (PCopy a) x)
-> (forall x. Rep (PCopy a) x -> PCopy a) -> Generic (PCopy a)
forall x. Rep (PCopy a) x -> PCopy a
forall x. PCopy a -> Rep (PCopy a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PCopy a) x -> PCopy a
forall a x. PCopy a -> Rep (PCopy a) x
$cfrom :: forall a x. PCopy a -> Rep (PCopy a) x
from :: forall x. PCopy a -> Rep (PCopy a) x
$cto :: forall a x. Rep (PCopy a) x -> PCopy a
to :: forall x. Rep (PCopy a) x -> PCopy a
Generic)
instance (NFData a) => NFData (PCopy a) where
instance (Typeable a) => Binary (PCopy a) where
put :: PCopy a -> Put
put PCopy a
_ = String -> Put
forall a. HasCallStack => String -> a
error String
"InvalidBinaryShim"
get :: Get (PCopy a)
get = String -> Get (PCopy a)
forall a. HasCallStack => String -> a
error String
"InvalidBinaryShim"
pCopy :: (Typeable a) => a -> PCopy a
pCopy :: forall a. Typeable a => a -> PCopy a
pCopy = a -> PCopy a
forall a. a -> PCopy a
PCopy
matchP :: (Typeable m) => Match (Maybe m)
matchP :: forall m. Typeable m => Match (Maybe m)
matchP = (Message -> Process (Maybe m)) -> Match (Maybe m)
forall b. (Message -> Process b) -> Match b
matchAny Message -> Process (Maybe m)
forall m. Typeable m => Message -> Process (Maybe m)
pUnwrap
pUnwrap :: (Typeable m) => Message -> Process (Maybe m)
pUnwrap :: forall m. Typeable m => Message -> Process (Maybe m)
pUnwrap Message
m = Message -> (PCopy m -> Process m) -> Process (Maybe m)
forall (m :: * -> *) a b.
(Monad m, Serializable a) =>
Message -> (a -> m b) -> m (Maybe b)
handleMessage Message
m (\(PCopy m
m' :: PCopy m) -> m -> Process m
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return m
m')
matchChanP :: (Typeable m) => ReceivePort (PCopy m) -> Match m
matchChanP :: forall m. Typeable m => ReceivePort (PCopy m) -> Match m
matchChanP ReceivePort (PCopy m)
rp = ReceivePort (PCopy m) -> (PCopy m -> Process m) -> Match m
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort (PCopy m)
rp (\(PCopy m
m' :: PCopy m) -> m -> Process m
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return m
m')
data InputStream a = ReadChan (ReceivePort a) | ReadSTM (STM a) | Null
deriving (Typeable)
data NullInputStream = NullInputStream
deriving (Typeable, (forall x. NullInputStream -> Rep NullInputStream x)
-> (forall x. Rep NullInputStream x -> NullInputStream)
-> Generic NullInputStream
forall x. Rep NullInputStream x -> NullInputStream
forall x. NullInputStream -> Rep NullInputStream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NullInputStream -> Rep NullInputStream x
from :: forall x. NullInputStream -> Rep NullInputStream x
$cto :: forall x. Rep NullInputStream x -> NullInputStream
to :: forall x. Rep NullInputStream x -> NullInputStream
Generic, Int -> NullInputStream -> ShowS
[NullInputStream] -> ShowS
NullInputStream -> String
(Int -> NullInputStream -> ShowS)
-> (NullInputStream -> String)
-> ([NullInputStream] -> ShowS)
-> Show NullInputStream
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NullInputStream -> ShowS
showsPrec :: Int -> NullInputStream -> ShowS
$cshow :: NullInputStream -> String
show :: NullInputStream -> String
$cshowList :: [NullInputStream] -> ShowS
showList :: [NullInputStream] -> ShowS
Show, NullInputStream -> NullInputStream -> Bool
(NullInputStream -> NullInputStream -> Bool)
-> (NullInputStream -> NullInputStream -> Bool)
-> Eq NullInputStream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NullInputStream -> NullInputStream -> Bool
== :: NullInputStream -> NullInputStream -> Bool
$c/= :: NullInputStream -> NullInputStream -> Bool
/= :: NullInputStream -> NullInputStream -> Bool
Eq)
instance Binary NullInputStream where
instance NFData NullInputStream where
newInputStream :: forall a. (Typeable a)
=> Either (ReceivePort a) (STM a)
-> InputStream a
newInputStream :: forall a.
Typeable a =>
Either (ReceivePort a) (STM a) -> InputStream a
newInputStream (Left ReceivePort a
rp) = ReceivePort a -> InputStream a
forall a. ReceivePort a -> InputStream a
ReadChan ReceivePort a
rp
newInputStream (Right STM a
stm) = STM a -> InputStream a
forall a. STM a -> InputStream a
ReadSTM STM a
stm
readInputStream :: (Serializable a) => InputStream a -> Process a
readInputStream :: forall a. Serializable a => InputStream a -> Process a
readInputStream (ReadChan ReceivePort a
rp) = ReceivePort a -> Process a
forall a. Serializable a => ReceivePort a -> Process a
receiveChan ReceivePort a
rp
readInputStream (ReadSTM STM a
stm) = 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
$ STM a -> IO a
forall a. STM a -> IO a
atomically STM a
stm
readInputStream InputStream a
Null = NullInputStream -> Process a
forall a b. Serializable a => a -> Process b
die (NullInputStream -> Process a) -> NullInputStream -> Process a
forall a b. (a -> b) -> a -> b
$ NullInputStream
NullInputStream
matchInputStream :: InputStream a -> Match a
matchInputStream :: forall a. InputStream a -> Match a
matchInputStream (ReadChan ReceivePort a
rp) = ReceivePort a -> (a -> Process a) -> Match a
forall a b. ReceivePort a -> (a -> Process b) -> Match b
matchChan ReceivePort a
rp a -> Process a
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
matchInputStream (ReadSTM STM a
stm) = STM a -> (a -> Process a) -> Match a
forall a b. STM a -> (a -> Process b) -> Match b
matchSTM STM a
stm a -> Process a
forall a. a -> Process a
forall (m :: * -> *) a. Monad m => a -> m a
return
matchInputStream InputStream a
Null = (NullInputStream -> Process a) -> Match a
forall a b. Serializable a => (a -> Process b) -> Match b
match (\NullInputStream
NullInputStream -> do
String -> Process a
forall a. HasCallStack => String -> a
error String
"NullInputStream")