distributed-process 0.5.4 → 0.5.5

raw patch · 10 files changed

+99/−38 lines, 10 filesdep ~deepseqdep ~ghc-primdep ~mtlnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq, ghc-prim, mtl, rank1dynamic, template-haskell, time

API changes (from Hackage documentation)

Files

• ChangeLog +6/−0
• LICENSE +1/−0
• distributed-process.cabal +20/−11
• src/Control/Distributed/Process/Internal/Closure/BuiltIn.hs +6/−5
• src/Control/Distributed/Process/Internal/Closure/TH.hs +16/−8
• src/Control/Distributed/Process/Internal/Primitives.hs +4/−0
• src/Control/Distributed/Process/Internal/Spawn.hs +11/−7
• src/Control/Distributed/Process/Internal/Types.hs +27/−7
• src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs +4/−0
• src/Control/Distributed/Process/Serializable.hs +4/−0

@@ -1,3 +1,9 @@+2015-06-15 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.5++* Fix dependencies.+* Add compatibility with GHC-7.10.+* Fix various race conditions (DP-99, DP-103).+ 2014-12-09  Tim Watson  <watson.timothy@gmail.com>  0.5.2  * Fix docstring for `register`

@@ -1,4 +1,5 @@ Copyright Well-Typed LLP, 2011-2012+Copyright Tweag I/O Limited, 2015  All rights reserved. 

@@ -1,12 +1,12 @@ Name:          distributed-process-Version:       0.5.4+Version:       0.5.5 Cabal-Version: >=1.8 Build-Type:    Simple License:       BSD3 License-File:  LICENSE-Copyright:     Well-Typed LLP+Copyright:     Well-Typed LLP, Tweag I/O Limited Author:        Duncan Coutts, Nicolas Wu, Edsko de Vries-Maintainer:    watson.timothy@gmail.com, edsko@well-typed.com, duncan@well-typed.com+Maintainer:    Facundo Domínguez <facundo.dominguez@tweag.io> Stability:     experimental Homepage:      http://haskell-distributed.github.com/ Bug-Reports:   https://github.com/haskell-distributed/distributed-process/issues@@ -21,7 +21,7 @@                 You will probably also want to install a Cloud Haskell backend such                as distributed-process-simplelocalnet.-Tested-With:   GHC==7.2.2 GHC==7.4.1 GHC==7.4.2 GHC==7.6.2+Tested-With:   GHC==7.4.2 GHC==7.6.3 GHC==7.8.4 GHC==7.10.1 Category:      Control extra-source-files: ChangeLog @@ -38,6 +38,13 @@   description: Compiling with profiling enabled   default: False ++flag old-locale+ description: If false then depend on time >= 1.5.+              .+              If true then depend on time < 1.5 together with old-locale.+ default: False+ Library   Build-Depends:     base >= 4.4 && < 5,                      binary >= 0.6.3 && < 0.8,@@ -45,15 +52,13 @@                      network-transport >= 0.4.1.0 && < 0.5,                      stm >= 2.4 && < 2.5,                      transformers >= 0.2 && < 0.5,-                     mtl >= 2.0 && < 2.3,+                     mtl >= 2.0 && < 2.4,                      data-accessor >= 0.2 && < 0.3,                      bytestring >= 0.9 && < 0.11,-                     old-locale >= 1.0 && < 1.1,-                     time >= 1.2 && < 1.5,                      random >= 1.0 && < 1.2,-                     ghc-prim >= 0.2 && < 0.4,+                     ghc-prim >= 0.2 && < 0.5,                      distributed-static >= 0.2 && < 0.4,-                     rank1dynamic >= 0.1 && < 0.3,+                     rank1dynamic >= 0.1 && < 0.4,                      syb >= 0.3 && < 0.5   Exposed-modules:   Control.Distributed.Process,                      Control.Distributed.Process.Closure,@@ -89,12 +94,16 @@                       deepseq == 1.3.0.0   else      Build-Depends:   containers >= 0.4 && < 0.6,-                      deepseq >= 1.3.0.1 && < 1.4+                      deepseq >= 1.3.0.1 && < 1.6+  if flag(old-locale)+     Build-Depends:   time < 1.5, old-locale >= 1.0 && <1.1+  else+     Build-Depends:   time >= 1.5   if flag(th)      if impl(ghc <= 7.4.2)        Build-Depends: template-haskell >= 2.7 && < 2.8      else-       Build-Depends: template-haskell >= 2.6 && < 2.10+       Build-Depends: template-haskell >= 2.6 && < 2.11      Exposed-modules: Control.Distributed.Process.Internal.Closure.TH      CPP-Options:     -DTemplateHaskellSupport 

@@ -28,7 +28,7 @@   , cpExpect   , cpNewChan     -- * Support for some CH operations-  , cpDelay+  , cpDelayed   , cpEnableTraceRemote   ) where @@ -295,19 +295,20 @@ -- | @delay them p@ is a process that waits for a signal (a message of type @()@) -- from 'them' (origin is not verified) before proceeding as @p@. In order to -- avoid waiting forever, @delay them p@ monitors 'them'. If it receives a--- monitor message instead it simply terminates.+-- monitor message instead, it proceeds as @p@ too. delay :: ProcessId -> Process () -> Process () delay them p = do   ref <- monitor them   let sameRef (ProcessMonitorNotification ref' _ _) = ref == ref'   receiveWait [-      match           $ \() -> unmonitor ref >> p+      match           $ \() -> unmonitor ref     , matchIf sameRef $ \_  -> return ()     ]+  p  -- | 'CP' version of 'delay'-cpDelay :: ProcessId -> Closure (Process ()) -> Closure (Process ())-cpDelay = closureApply . cpDelay'+cpDelayed :: ProcessId -> Closure (Process ()) -> Closure (Process ())+cpDelayed = closureApply . cpDelay'   where     cpDelay' :: ProcessId -> Closure (Process () -> Process ())     cpDelay' pid = closure decoder (encode pid)

@@ -1,5 +1,5 @@ -- | Template Haskell support-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, CPP #-} module Control.Distributed.Process.Internal.Closure.TH   ( -- * User-level API     remotable@@ -29,7 +29,11 @@   , Type(AppT, ForallT, VarT, ArrowT)   , Info(VarI)   , TyVarBndr(PlainTV, KindedTV)-  , Pred(ClassP)+#if ! MIN_VERSION_template_haskell(2,10,0)+  , Pred+#endif+  , varT+  , classP     -- Lifted constructors     -- .. Literals   , stringL@@ -67,6 +71,10 @@   ) import Control.Distributed.Process.Internal.Closure.BuiltIn (staticDecode) +#if MIN_VERSION_template_haskell(2,10,0)+type Pred = Type+#endif+ -------------------------------------------------------------------------------- -- User-level API                                                             -- --------------------------------------------------------------------------------@@ -244,16 +252,16 @@ generateStatic n xs typ = do     staticTyp <- [t| Static |]     sequence-      [ sigD (staticName n) $+      [ sigD (staticName n) $ do+          txs <- sequence $ map typeable xs           return (ForallT xs-                  (map typeable xs)-                  (staticTyp `AppT` typ)-          )+                  txs+                  (staticTyp `AppT` typ))       , sfnD (staticName n) [| staticLabel $(showFQN n) |]       ]   where-    typeable :: TyVarBndr -> Pred-    typeable tv = ClassP (mkName "Typeable") [VarT (tyVarBndrName tv)]+    typeable :: TyVarBndr -> Q Pred+    typeable tv = classP (mkName "Typeable") [varT (tyVarBndrName tv)]  -- | Generate a serialization dictionary with name 'n' for type 'typ' generateDict :: Name -> Type -> Q [Dec]

@@ -123,7 +123,11 @@ import Data.Binary (decode) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (formatTime)+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (defaultTimeLocale)+#else import System.Locale (defaultTimeLocale)+#endif import System.Timeout (timeout) import Control.Monad (when) import Control.Monad.Reader (ask)

@@ -37,7 +37,9 @@   , cpLink   , cpSend   , cpNewChan-  , cpDelay+  , cpDelayed+  , returnCP+  , sdictUnit   ) import Control.Distributed.Process.Internal.Primitives   ( -- Basic messaging@@ -65,7 +67,7 @@ spawn nid proc = do   us   <- getSelfPid   mRef <- monitorNode nid-  sRef <- spawnAsync nid (cpDelay us proc)+  sRef <- spawnAsync nid (cpDelayed us proc)   receiveWait [       matchIf (\(DidSpawn ref _) -> ref == sRef) $ \(DidSpawn _ pid) -> do         unmonitor mRef@@ -109,12 +111,14 @@         -> Process a call dict nid proc = do   us <- getSelfPid-  (pid, mRef) <- spawnMonitor nid (proc `bindCP` cpSend dict us)-  -- We are guaranteed to receive the reply before the monitor notification-  -- (if a reply is sent at all)-  -- NOTE: This might not be true if we switch to unreliable delivery.+  (pid, mRef) <- spawnMonitor nid (proc `bindCP`+                                   cpSend dict us `seqCP`+                                   -- Delay so the process does not terminate+                                   -- before the response arrives.+                                   cpDelayed us (returnCP sdictUnit ())+                                  )   mResult <- receiveWait-    [ match (return . Right)+    [ match $ \a -> send pid () >> return (Right a)     , matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mRef)               (\(ProcessMonitorNotification _ _ reason) -> return (Left reason))     ]

@@ -3,6 +3,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving  #-} {-# LANGUAGE GADTs  #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE CPP #-}  -- | Types used throughout the Cloud Haskell framework --@@ -136,7 +137,7 @@ newtype NodeId = NodeId { nodeAddress :: NT.EndPointAddress }   deriving (Eq, Ord, Typeable, Data, Generic) instance Binary NodeId where-instance NFData NodeId+instance NFData NodeId where rnf (NodeId a) = rnf a `seq` () instance Hashable NodeId where instance Show NodeId where   show (NodeId addr) = "nid://" ++ show addr@@ -161,7 +162,7 @@   deriving (Eq, Ord, Typeable, Data, Generic)  instance Binary ProcessId where-instance NFData ProcessId where+instance NFData ProcessId where rnf (ProcessId n _) = rnf n `seq` () instance Hashable ProcessId where  instance Show ProcessId where@@ -176,6 +177,10 @@   deriving (Eq, Ord, Generic)  instance Hashable Identifier where+instance NFData Identifier where+  rnf (NodeIdentifier n) = rnf n `seq` ()+  rnf (ProcessIdentifier n) = rnf n `seq` ()+  rnf n@SendPortIdentifier{} = n `seq` ()  instance Show Identifier where   show (NodeIdentifier nid)     = show nid@@ -316,6 +321,9 @@   show (SendPortId (ProcessId (NodeId addr) (LocalProcessId _ plid)) clid)     = "cid://" ++ show addr ++ ":" ++ show plid ++ ":" ++ show clid +instance NFData SendPortId where+  rnf (SendPortId p _) = rnf p `seq` ()+ data TypedChannel = forall a. Serializable a => TypedChannel (Weak (TQueue a))  -- | The send send of a typed channel (serializable)@@ -327,7 +335,7 @@  instance (Serializable a) => Binary (SendPort a) where instance (Hashable a) => Hashable (SendPort a) where-instance (NFData a) => NFData (SendPort a) where+instance (NFData a) => NFData (SendPort a) where rnf (SendPort x) = x `seq` ()  -- | The receive end of a typed channel (not serializable) --@@ -365,6 +373,14 @@   }   deriving (Typeable) +instance NFData Message where+#if MIN_VERSION_bytestring(0,10,0)+  rnf (EncodedMessage _ e) = rnf e `seq` ()+#else+  rnf (EncodedMessage _ e) = BSL.length e `seq` ()+#endif+  rnf (UnencodedMessage _ a) = a `seq` ()   -- forced to WHNF only+ instance Show Message where   show (EncodedMessage fp enc) = show enc ++ " :: " ++ showFingerprint fp []   show (UnencodedMessage _ uenc) = "[unencoded message] :: " ++ (show $ typeOf uenc)@@ -428,8 +444,11 @@   , monitorRefCounter :: !Int32   }   deriving (Eq, Ord, Show, Typeable, Generic)-instance Hashable MonitorRef where+instance Hashable MonitorRef +instance NFData MonitorRef where+  rnf (MonitorRef i _) = rnf i `seq` ()+ -- | Message sent by process monitors data ProcessMonitorNotification =     ProcessMonitorNotification !MonitorRef !ProcessId !DiedReason@@ -496,6 +515,10 @@   | DiedUnknownId   deriving (Show, Eq) +instance NFData DiedReason where+  rnf (DiedException s) = rnf s `seq` ()+  rnf x = x `seq` ()+ -- | (Asynchronous) reply from unmonitor newtype DidUnmonitor = DidUnmonitor MonitorRef   deriving (Typeable, Binary)@@ -673,9 +696,6 @@ instance Binary SendPortId where   put cid = put (sendPortProcessId cid) >> put (sendPortLocalId cid)   get = SendPortId <$> get <*> get--instance NFData SendPortId where-  rnf cid = (sendPortProcessId cid) `seq` (sendPortLocalId cid) `seq` ()  instance Binary Identifier where   put (ProcessIdentifier pid)  = putWord8 0 >> put pid

@@ -88,7 +88,11 @@   , hPutStrLn   , hSetBuffering   )+#if MIN_VERSION_time(1,5,0)+import Data.Time.Format (defaultTimeLocale)+#else import System.Locale (defaultTimeLocale)+#endif import System.Mem.Weak   ( Weak   )

@@ -73,7 +73,11 @@  -- | The fingerprint of the typeRep of the argument fingerprint :: Typeable a => a -> Fingerprint+#if MIN_VERSION_base(4,8,0)+fingerprint a = let TypeRep fp _ _ _ = typeOf a in fp+#else fingerprint a = let TypeRep fp _ _ = typeOf a in fp+#endif  -- | Show fingerprint (for debugging purposes) showFingerprint :: Fingerprint -> ShowS