an example using Lifted Process primitives with a custom monad stack

LiftedExample.hs

{-# 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 ()