Created
December 5, 2013 01:55
-
-
Save jeremyjh/7798955 to your computer and use it in GitHub Desktop.
an example using Lifted Process primitives with a custom monad stack
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE GeneralizedNewtypeDeriving #-} | |
module Control.Distributed.Process.Lifted | |
( module Control.Distributed.Process | |
, module Control.Distributed.Process.Lifted | |
) | |
where | |
import Control.Monad.Trans.Control | |
import Control.Monad.Reader | |
import Control.Monad.Base | |
import Control.Monad.Trans.Resource | |
import Control.Distributed.Process.Node | |
import qualified Control.Distributed.Process as Base | |
import Control.Distributed.Process | |
hiding (getSelfPid, send, expect, expectTimeout, spawnLocal) | |
import Control.Distributed.Process.Serializable | |
import Network.Transport.TCP | |
-- enables use of lifted versions of Process functions | |
class MonadProcess m where | |
-- |lift a base 'Process' computation into the current monad | |
liftProcess :: Process a -> m a | |
-- |map over an underlying Process to e.g. spawnLocal | |
mapProcess :: (Process a -> Process b) -> m a -> m b | |
instance MonadProcess Process where | |
liftProcess = id | |
mapProcess f = f | |
-- a few primitives I have been using this way so far | |
spawnLocal :: (MonadProcess m) => m () -> m ProcessId | |
spawnLocal = mapProcess Base.spawnLocal | |
getSelfPid :: (MonadProcess m) => m ProcessId | |
getSelfPid = liftProcess Base.getSelfPid | |
send :: (MonadProcess m, Serializable a) => ProcessId -> a -> m () | |
send pid = liftProcess . Base.send pid | |
expect :: (MonadProcess m) => forall a. Serializable a => m a | |
expect = liftProcess Base.expect | |
expectTimeout :: (MonadProcess m) => forall a. Serializable a => Int -> m (Maybe a) | |
expectTimeout = liftProcess . Base.expectTimeout | |
-- example trans instance | |
instance (Monad m, MonadProcess m) => MonadProcess (ReaderT r m) where | |
liftProcess = lift . liftProcess | |
mapProcess f = mapReaderT (mapProcess f) | |
-- example custom app monad | |
newtype MyApp a = MyApp {unMyApp :: ReaderT String Process a} | |
deriving ( Functor, Monad, MonadIO | |
, MonadReader String | |
, MonadProcess | |
) | |
runMyApp :: MyApp () -> Process () | |
runMyApp ma = runReaderT (unMyApp ma) "an important message" | |
-- example usage - note we don't have to explicitly lift every Process | |
-- or unwrap our monad, and reader environment is carried into child process | |
main :: IO () | |
main = do | |
(Right tcp) <- createTransport "localhost" "3555" defaultTCPParameters | |
node <- newLocalNode tcp initRemoteTable | |
runProcess node $ do | |
parent <- getSelfPid | |
runMyApp $ do | |
child <- spawnLocal $ do | |
v <- ask | |
msg <- expect :: MyApp String | |
send parent $ "Got message: " ++ msg ++ "\n reader val: " ++ v | |
send child "hello dear" | |
resp <- expect :: MyApp String | |
liftIO $ putStrLn resp | |
return () | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment