diff --git a/distributed-process-lifted.cabal b/distributed-process-lifted.cabal --- a/distributed-process-lifted.cabal +++ b/distributed-process-lifted.cabal @@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: distributed-process-lifted -version: 0.2.0.0 +version: 0.2.0.1 synopsis: monad-control style typeclass and transformer instances for Process monad. description: This package provides typeclasses and functions for lifting functions and control operations (such as spawnLocal) from the @Process@ monad @@ -39,11 +39,11 @@ -- other-modules: -- other-extensions: build-depends: base < 5 - , distributed-process >= 0.5.1 && < 0.6 + , distributed-process >= 0.5.1 && < 0.7 , distributed-process-monad-control >= 0.5 && < 0.6 , network-transport >= 0.2 && < 0.5 , lifted-base >= 0.2 && < 0.3 - , transformers >= 0.4 && < 0.5 + , transformers >= 0.4 && < 0.6 , transformers-base >= 0.4.1 && <= 0.5.0 , monad-control >= 0.3 && < 1.1 , mtl >= 2.0 && < 2.3 diff --git a/src/Control/Distributed/Process/Lifted.hs b/src/Control/Distributed/Process/Lifted.hs --- a/src/Control/Distributed/Process/Lifted.hs +++ b/src/Control/Distributed/Process/Lifted.hs @@ -1,5 +1,5 @@ -{-# Language RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Control.Distributed.Process.Lifted @@ -9,80 +9,77 @@ ) where -import Control.Distributed.Process.Lifted.Class +import Control.Distributed.Process.Lifted.Class -import Control.Distributed.Process - ( - Closure - , DidSpawn(..) - , DiedReason(..) - , Match - , Message - , MonitorRef - , NodeId(..) - , ProcessTerminationException(..) - , ProcessRegistrationException(..) - , ProcessLinkException(..) - , NodeLinkException(..) - , PortLinkException(..) - , ProcessMonitorNotification(..) - , NodeMonitorNotification(..) - , PortMonitorNotification(..) - , DiedReason(..) - , NodeStats(..) - , Process - , ProcessId - , ProcessInfo(..) - , ReceivePort - , RegisterReply(..) - , RemoteTable - , SendPort - , SendPortId - , SpawnRef - , Static - , WhereIsReply(..) - , liftIO - , unsafeWrapMessage - , wrapMessage - , closure - , infoLinks - , infoMessageQueueLength - , infoMonitors - , infoNode - , infoRegisteredNames - , isEncoded - , nodeAddress - , nodeStatsLinks - , nodeStatsMonitors - , nodeStatsNode - , nodeStatsProcesses - , nodeStatsRegisteredNames - , processNodeId - , sendPortId - , sendPortProcessId - , match - , matchAnyIf - , matchIf - , matchAny - , matchChan - , matchMessage - , matchMessageIf - , matchSTM - ) -import qualified Control.Distributed.Process as Base -import Control.Distributed.Process.MonadBaseControl () +import Control.Distributed.Process (Closure, + DidSpawn (..), + DiedReason (..), + DiedReason (..), + Match, Message, + MonitorRef, + NodeId (..), + NodeLinkException (..), + NodeMonitorNotification (..), + NodeStats (..), + PortLinkException (..), + PortMonitorNotification (..), + Process, + ProcessId, + ProcessInfo (..), + ProcessLinkException (..), + ProcessMonitorNotification (..), + ProcessRegistrationException (..), + ProcessTerminationException (..), + ReceivePort, + RegisterReply (..), + RemoteTable, + SendPort, + SendPortId, + SpawnRef, Static, + WhereIsReply (..), + closure, + infoLinks, + infoMessageQueueLength, + infoMonitors, + infoNode, + infoRegisteredNames, + isEncoded, + liftIO, match, + matchAny, + matchAnyIf, + matchChan, + matchIf, + matchMessage, + matchMessageIf, + matchSTM, + nodeAddress, + nodeStatsLinks, + nodeStatsMonitors, + nodeStatsNode, + nodeStatsProcesses, + nodeStatsRegisteredNames, + processNodeId, + sendPortId, + sendPortProcessId, + unsafeWrapMessage, + wrapMessage) +import qualified Control.Distributed.Process as Base +import Control.Distributed.Process.MonadBaseControl () -import Control.Distributed.Process.Serializable (Serializable) -import Control.Distributed.Process.Closure (SerializableDict) -import Control.Distributed.Process.Internal.Types - (ProcessExitException(..)) +import Control.Distributed.Process.Closure (SerializableDict) +import Control.Distributed.Process.Internal.Types (ProcessExitException (..)) +import Control.Distributed.Process.Serializable (Serializable) -import Control.Exception.Lifted - (bracket, bracket_, catch, catches, Exception, finally, mask, - mask_, onException, try, Handler(..)) -import qualified Control.Exception.Lifted as EX -import Data.Typeable (Typeable) +import Control.Exception.Lifted (Exception, + Handler (..), + bracket, + bracket_, catch, + catches, finally, + mask, mask_, + onException, try) +import qualified Control.Exception.Lifted as EX +import Data.Typeable (Typeable) -- compose arity 2 functions (.:) :: (c->d) -> (a->b->c) -> a->b->d diff --git a/src/Control/Distributed/Process/Lifted/Class.hs b/src/Control/Distributed/Process/Lifted/Class.hs --- a/src/Control/Distributed/Process/Lifted/Class.hs +++ b/src/Control/Distributed/Process/Lifted/Class.hs @@ -16,7 +16,9 @@ import Control.Monad.Trans.Control import Control.Monad.Base (MonadBase(..)) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid ) +#endif import Control.Monad.Trans.Identity (IdentityT) import Control.Monad.Trans.List (ListT) diff --git a/src/Control/Distributed/Process/Lifted/Extras.hs b/src/Control/Distributed/Process/Lifted/Extras.hs --- a/src/Control/Distributed/Process/Lifted/Extras.hs +++ b/src/Control/Distributed/Process/Lifted/Extras.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Utility functions for working with Processes outside of the @@ -17,18 +17,19 @@ ) where -import Control.Monad (void, join, forever) -import Control.Monad.Base (MonadBase(..)) -import Control.Exception (throw, SomeException) -import Data.Typeable (Typeable) +import Control.Exception (SomeException, throw) +import Control.Monad (forever, join, void) +import Control.Monad.Base (MonadBase (..)) +import Data.Typeable (Typeable) -import Control.Concurrent.Chan.Lifted - (Chan, newChan, writeChan, readChan) -import Control.Concurrent.MVar.Lifted - (newEmptyMVar, putMVar, takeMVar) +import Control.Concurrent.Chan.Lifted (Chan, newChan, + readChan, writeChan) +import Control.Concurrent.MVar.Lifted (newEmptyMVar, putMVar, + takeMVar) -import Control.Distributed.Process.Lifted hiding (newChan) -import Control.Distributed.Process.Node.Lifted (LocalNode, forkProcess) +import Control.Distributed.Process.Lifted hiding (newChan) +import Control.Distributed.Process.Node.Lifted (LocalNode, + forkProcess) -- | A variant of 'Control.Distributed.Process.Node.runProcess' which returns a value. This works just @@ -38,14 +39,17 @@ fromProcess :: forall a m. (MonadBase IO m) => LocalNode -> Process a -> m a fromProcess node ma = - do resultMV <- newEmptyMVar - void . forkProcess node $ - do eresult <- try (do !a <- ma; return a) :: Process (Either SomeException a) - case eresult of - Right result -> putMVar resultMV result - Left exception -> putMVar resultMV (throw exception) - !result <- takeMVar resultMV - return result + do resultMV <- newEmptyMVar + void . forkProcess node $ + do eresult <- try (do !a <- ma + return a) :: Process (Either SomeException a) + case eresult of + Right result -> + putMVar resultMV result + Left exception -> + putMVar resultMV (throw exception) + !result <- takeMVar resultMV + return result -- | Represents a handle to a process runner that communicates -- through a 'Control.Concurrent.Chan.Chan'. @@ -65,10 +69,10 @@ -- | Spawn a new process and return a 'ProcessProxy' handle for it. spawnProxy :: Process ProcessProxy spawnProxy = - do action <- newChan - pid <- spawnLocal . forever $ - join (readChan action) - return (ProcessProxy pid action) + do action <- newChan + pid <- spawnLocal . forever $ + join (readChan action) + return (ProcessProxy pid action) -- | Same as spawnProxy but can be used from any IO -- @@ -89,6 +93,6 @@ fromProxy :: forall a m. (MonadBase IO m) => ProcessProxy -> Process a -> m a fromProxy (ProcessProxy _ prox) ma = - do result <- newEmptyMVar - writeChan prox (ma >>= putMVar result) - takeMVar result + do result <- newEmptyMVar + writeChan prox (ma >>= putMVar result) + takeMVar result