diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,15 @@ 2017-02-05 Tim Watson 0.3.0 +* re-implement whereIsRemote in terms of whereIsRemoteAsync +* re-implement whereisOrStart to avoid leaking zombie processes +* implement general NFSerializable instances +* make Resolvable instance of (NodeId, String) exception safe +* remove dependency on data-accessor +* Relax upper bound on time for testing +* documentation fixes and improvements + +2017-02-05 Tim Watson 0.3.0 + * Update dependency bounds - drop support for distributed-process < 0.6.6 * Drop support for GHC < 7.10 * Fixes for testing with latest stack and CI changes diff --git a/distributed-process-extras.cabal b/distributed-process-extras.cabal --- a/distributed-process-extras.cabal +++ b/distributed-process-extras.cabal @@ -1,5 +1,5 @@ name: distributed-process-extras -version: 0.3.0 +version: 0.3.1 cabal-version: >=1.8 build-type: Simple license: BSD3 @@ -31,7 +31,6 @@ library build-depends: base >= 4.6 && < 5, - data-accessor >= 0.2.2.3, distributed-process >= 0.6.6 && < 0.7, binary >= 0.6.3.0 && < 0.9, deepseq >= 1.3.0.1 && < 1.6, @@ -168,7 +167,7 @@ network >= 2.3 && < 2.7, HUnit >= 1.2 && < 2, stm >= 2.3 && < 2.5, - time > 1.4 && < 1.8, + time > 1.4 && < 1.9, test-framework >= 0.6 && < 0.9, test-framework-hunit, transformers, diff --git a/src/Control/Distributed/Process/Extras.hs b/src/Control/Distributed/Process/Extras.hs --- a/src/Control/Distributed/Process/Extras.hs +++ b/src/Control/Distributed/Process/Extras.hs @@ -33,6 +33,13 @@ semantics of these operations, and therefore the /unsafe/ moniker will remain in place, in one form or another, for all functions and modules that use them. +[Addressing/Interaction Tools] + +The various type classes exposed here, along with some common data types (such +as @Shutdown@, @ServerDisconnected@, etc.) are intended to simplify your CH +programs, and facilitate easily plugging code into higher level libraries such +as distributed-process-client-server and distributed-process-supervisor. + [Error/Exception Handling] It is /important/ not to be too general when catching exceptions in @@ -110,12 +117,9 @@ import Control.Distributed.Process.Extras.UnsafePrimitives import Control.Distributed.Process.Extras.Internal.Primitives hiding (__remoteTable) import qualified Control.Distributed.Process.Extras.Internal.Primitives (__remoteTable) -import qualified Control.Distributed.Process.Extras.Internal.Types (__remoteTable) -- remote table __remoteTable :: RemoteTable -> RemoteTable __remoteTable = - Control.Distributed.Process.Extras.Internal.Primitives.__remoteTable . - Control.Distributed.Process.Extras.Internal.Types.__remoteTable - + Control.Distributed.Process.Extras.Internal.Primitives.__remoteTable diff --git a/src/Control/Distributed/Process/Extras/Internal/Primitives.hs b/src/Control/Distributed/Process/Extras/Internal/Primitives.hs --- a/src/Control/Distributed/Process/Extras/Internal/Primitives.hs +++ b/src/Control/Distributed/Process/Extras/Internal/Primitives.hs @@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Distributed.Process.Extras.Internal.Primitives --- Copyright : (c) Tim Watson 2013, Parallel Scientific (Jeff Epstein) 2012 +-- Copyright : (c) Tim Watson 2013 - 2017, Parallel Scientific (Jeff Epstein) 2012 -- License : BSD3 (see the file LICENSE) -- -- Maintainers : Jeff Epstein, Tim Watson @@ -56,7 +56,7 @@ ) where import Control.Concurrent (myThreadId, throwTo) -import Control.Distributed.Process hiding (monitor) +import Control.Distributed.Process hiding (monitor, finally, catch) import qualified Control.Distributed.Process as P (monitor) import Control.Distributed.Process.Closure (seqCP, remotable, mkClosure) import Control.Distributed.Process.Serializable (Serializable) @@ -71,6 +71,7 @@ , whereisRemote ) import Control.Monad (void) +import Control.Monad.Catch (finally, catchIf) import Data.Maybe (isJust, fromJust) -- utility @@ -96,9 +97,12 @@ (\_ -> return ()) ] +-- | deliver = flip sendTo deliver :: (Addressable a, Serializable m) => m -> a -> Process () deliver = flip sendTo +-- | True if getProcessInfo /= Nothing +-- NB: only works for local processes. isProcessAlive :: ProcessId -> Process Bool isProcessAlive pid = getProcessInfo pid >>= \info -> return $ info /= Nothing @@ -133,7 +137,7 @@ matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mRef) (\(ProcessMonitorNotification _ _ dr) -> die $ ExitOther (show dr)) , matchChan recvStart (\() -> return pid) - ] + ] `finally` (unmonitor mRef) -- | Node local version of 'Control.Distributed.Process.spawnLink'. -- Note that this is just the sequential composition of 'spawn' and 'link'. @@ -182,31 +186,20 @@ -- is started. This is a handy way to start per-node named servers. -- whereisOrStart :: String -> Process () -> Process ProcessId -whereisOrStart name proc = - do mpid <- whereis name - case mpid of - Just pid -> return pid - Nothing -> - do caller <- getSelfPid - pid <- spawnLocal $ - do self <- getSelfPid - register name self - send caller (RegisterSelf,self) - () <- expect - proc - ref <- P.monitor pid - ret <- receiveWait - [ matchIf (\(ProcessMonitorNotification aref _ _) -> ref == aref) - (\(ProcessMonitorNotification _ _ _) -> return Nothing), - matchIf (\(RegisterSelf,apid) -> apid == pid) - (\(RegisterSelf,_) -> return $ Just pid) - ] - case ret of - Nothing -> whereisOrStart name proc - Just somepid -> - do unmonitor ref - send somepid () - return somepid +whereisOrStart name proc = do + (sigStart, recvStart) <- newChan + (_, mRef) <- spawnMonitorLocal $ do + us <- getSelfPid + catchIf (\(ProcessRegistrationException _ r) -> isJust r) + (register name us >> sendChan sigStart us) + (\(ProcessRegistrationException _ rPid) -> + sendChan sigStart $ fromJust rPid) + proc + receiveWait [ + matchIf (\(ProcessMonitorNotification ref _ _) -> ref == mRef) + (\(ProcessMonitorNotification _ _ dr) -> die $ ExitOther (show dr)) + , matchChan recvStart return + ] `finally` (unmonitor mRef) registerSelf :: (String, ProcessId) -> Process () registerSelf (name,target) = @@ -287,4 +280,3 @@ matchRef r = matchIf (\(ProcessMonitorNotification r' _ _) -> r == r') (\(ProcessMonitorNotification _ _ d) -> do return (Left (ExitOther (show d)))) - diff --git a/src/Control/Distributed/Process/Extras/Internal/Queue/SeqQ.hs b/src/Control/Distributed/Process/Extras/Internal/Queue/SeqQ.hs --- a/src/Control/Distributed/Process/Extras/Internal/Queue/SeqQ.hs +++ b/src/Control/Distributed/Process/Extras/Internal/Queue/SeqQ.hs @@ -1,15 +1,3 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Distributed.Process.Extras.Internal.Queue.SeqQ --- Copyright : (c) Tim Watson 2012 - 2013 --- License : BSD3 (see the file LICENSE) --- --- Maintainer : Tim Watson --- Stability : experimental --- --- A simple FIFO queue implementation backed by @Data.Sequence@. ------------------------------------------------------------------------------ - module Control.Distributed.Process.Extras.Internal.Queue.SeqQ ( SeqQ , empty @@ -21,6 +9,8 @@ ) where +-- A simple FIFO queue implementation backed by @Data.Sequence@. + import Data.Sequence ( Seq , ViewR(..) @@ -63,4 +53,3 @@ case (viewr (q s)) of EmptyR -> Nothing a -> Just a - diff --git a/src/Control/Distributed/Process/Extras/Internal/Types.hs b/src/Control/Distributed/Process/Extras/Internal/Types.hs --- a/src/Control/Distributed/Process/Extras/Internal/Types.hs +++ b/src/Control/Distributed/Process/Extras/Internal/Types.hs @@ -1,11 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} -- | Types used throughout the Extras package -- @@ -32,8 +30,6 @@ , ExitReason(..) , ServerDisconnected(..) , NFSerializable - -- remote table - , __remoteTable ) where import Control.Concurrent.MVar @@ -42,19 +38,15 @@ , modifyMVar ) import Control.DeepSeq (NFData(..), ($!!)) -import Control.Distributed.Process hiding (send) +import Control.Distributed.Process hiding (send, catch) import qualified Control.Distributed.Process as P ( send , unsafeSend , unsafeNSend ) -import Control.Distributed.Process.Closure - ( remotable - , mkClosure - , functionTDict - ) import Control.Distributed.Process.Serializable - +import Control.Exception (SomeException) +import Control.Monad.Catch (catch) import Data.Binary import Data.Foldable (traverse_) import Data.Typeable (Typeable) @@ -73,10 +65,9 @@ -- behaviour by using /unsafe/ primitives in this way. -- class (NFData a, Serializable a) => NFSerializable a +instance (NFData a, Serializable a) => NFSerializable a -instance NFSerializable ProcessId instance (NFSerializable a) => NFSerializable (SendPort a) -instance NFSerializable Message -- | Tags provide uniqueness for messages, so that they can be -- matched with their response. @@ -98,14 +89,20 @@ getTag :: TagPool -> Process Tag getTag tp = liftIO $ modifyMVar tp (\tag -> return (tag+1,tag)) -$(remotable ['whereis]) - --- | A synchronous version of 'whereis', this relies on 'call' --- to perform the relevant monitoring of the remote node. +-- | A synchronous version of 'whereis', this monitors the remote node +-- and returns @Nothing@ if the node goes down (since a remote node failing +-- or being non-contactible has the same effect as a process not being +-- registered from the caller's point of view). whereisRemote :: NodeId -> String -> Process (Maybe ProcessId) -whereisRemote node name = - call $(functionTDict 'whereis) node ($(mkClosure 'whereis) name) - +whereisRemote node name = do + mRef <- monitorNode node + whereisRemoteAsync node name + receiveWait [ matchIf (\(NodeMonitorNotification ref nid _) -> ref == mRef && + nid == node) + (\NodeMonitorNotification{} -> return Nothing) + , matchIf (\(WhereIsReply n _) -> n == name) + (\(WhereIsReply _ mPid) -> return mPid) + ] -- | Wait cancellation message. data CancelWait = CancelWait @@ -158,6 +155,8 @@ exitProc :: (Resolvable p, Serializable m) => p -> m -> Process () exitProc r m = resolve r >>= traverse_ (flip exit $ m) +instance Resolvable p => Killable p + -- | resolve the Resolvable or die with specified msg plus details of what didn't resolve resolveOrDie :: (Resolvable a) => a -> String -> Process ProcessId resolveOrDie resolvable failureMsg = do @@ -185,7 +184,8 @@ unresolvableMessage s = "CannotResolveRegisteredName[" ++ s ++ "]" instance Resolvable (NodeId, String) where - resolve (nid, pname) = whereisRemote nid pname + resolve (nid, pname) = + whereisRemote nid pname `catch` (\(_ :: SomeException) -> return Nothing) unresolvableMessage (n, s) = "CannotResolveRemoteRegisteredName[name: " ++ s ++ ", node: " ++ (show n) ++ "]" @@ -220,8 +220,8 @@ unsafeSendTo name msg = P.unsafeNSend name $!! msg instance Routable (NodeId, String) where - sendTo (nid, pname) msg = nsendRemote nid pname msg - unsafeSendTo = sendTo -- because serialisation *must* take place + sendTo (nid, pname) = nsendRemote nid pname + unsafeSendTo = sendTo -- because serialisation *must* take place instance Routable (Message -> Process ()) where sendTo f = f . wrapMessage @@ -269,7 +269,7 @@ -- useful exit reasons -- | Given when a server is unobtainable. -data ServerDisconnected = ServerDisconnected !DiedReason +newtype ServerDisconnected = ServerDisconnected DiedReason deriving (Typeable, Generic) instance Binary ServerDisconnected where instance NFData ServerDisconnected where diff --git a/src/Control/Distributed/Process/Extras/Internal/Unsafe.hs b/src/Control/Distributed/Process/Extras/Internal/Unsafe.hs --- a/src/Control/Distributed/Process/Extras/Internal/Unsafe.hs +++ b/src/Control/Distributed/Process/Extras/Internal/Unsafe.hs @@ -1,11 +1,20 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -- | If you don't know exactly what this module is for and precisely -- how to use the types within, you should move on, quickly! -- +-- [Implementation Notes] +-- This module provides facilities for forcibly sending non-serializable +-- data via cloud haskell's messaging primitives, such as @send@ et al. +-- Of course, if you attmept to do this when interacting with a remote process, +-- your application will break. +-- +-- NB: this module will be deprecated in the next dot release, pending rewrite +-- of the libraries that currently rely on it, to use the new supporting APIs +-- for STM interactions in distributed-process-client-server. +-- module Control.Distributed.Process.Extras.Internal.Unsafe ( -- * Copying non-serializable data PCopy() @@ -125,4 +134,3 @@ matchInputStream (ReadSTM stm) = matchSTM stm return matchInputStream Null = match (\NullInputStream -> do error "NullInputStream") - diff --git a/src/Control/Distributed/Process/Extras/Monitoring.hs b/src/Control/Distributed/Process/Extras/Monitoring.hs --- a/src/Control/Distributed/Process/Extras/Monitoring.hs +++ b/src/Control/Distributed/Process/Extras/Monitoring.hs @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Distributed.Process.Extras.Monitoring --- Copyright : (c) Tim Watson 2013 - 2014 +-- Copyright : (c) Tim Watson 2013 - 2017 -- License : BSD3 (see the file LICENSE) -- -- Maintainer : Tim Watson @@ -136,4 +136,3 @@ nodeUp = NodeUp . NodeId nodeDown = NodeDown . NodeId - diff --git a/src/Control/Distributed/Process/Extras/SystemLog.hs b/src/Control/Distributed/Process/Extras/SystemLog.hs --- a/src/Control/Distributed/Process/Extras/SystemLog.hs +++ b/src/Control/Distributed/Process/Extras/SystemLog.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Distributed.Process.Extras.SystemLog --- Copyright : (c) Tim Watson 2013 - 2014 +-- Copyright : (c) Tim Watson 2013 - 2017 -- License : BSD3 (see the file LICENSE) -- -- Maintainer : Tim Watson @@ -86,18 +86,10 @@ ( Resolvable(..) , Routable(..) , Addressable - , NFSerializable ) import Control.Distributed.Process.Serializable import Control.Exception (SomeException) import Control.Monad.Catch (catch) -import Data.Accessor - ( Accessor - , accessor - , (^:) - , (^=) - , (^.) - ) import Data.Binary import Data.Typeable (Typeable) import GHC.Generics @@ -142,11 +134,11 @@ instance Binary AddFormatter data LogState = - LogState { output :: !(String -> Process ()) - , cleanup :: !(Process ()) - , _level :: !LogLevel - , _format :: !(String -> Process String) - , _formatters :: ![Message -> Process (Maybe String)] + LogState { output :: !(String -> Process ()) + , cleanup :: !(Process ()) + , level :: !LogLevel + , format :: !(String -> Process String) + , formatters :: ![Message -> Process (Maybe String)] } data LogMessage = @@ -166,7 +158,6 @@ unsafeSendTo _ = mxNotify type LogText = String -instance NFSerializable LogText newtype LogClient = LogClient { agent :: ProcessId } instance Resolvable LogClient where @@ -206,7 +197,7 @@ -> l -> String -> Process () -report f l = f l +report f l = f l client :: Process (Maybe LogClient) client = resolve logProcessName >>= return . maybe Nothing (Just . LogClient) @@ -269,17 +260,17 @@ systemLog o c l f = go $ LogState o c l f defaultFormatters where go :: LogState -> Process ProcessId - go st = do + go st = mxAgentWithFinalize mxLogId st [ -- these are the messages we're /really/ interested in - (mxSink $ \(m :: LogMessage) -> do + (mxSink $ \(m :: LogMessage) -> case m of - (LogMessage msg lvl) -> do + (LogMessage msg lvl) -> mxGetLocal >>= outputMin lvl msg >> mxReceive (LogData dat lvl) -> handleRawMsg dat lvl) -- complex messages rely on properly registered formatters - , (mxSink $ \(ev :: MxEvent) -> do + , (mxSink $ \(ev :: MxEvent) -> case ev of (MxUser msg) -> handleRawMsg msg Debug -- we treat trace/log events like regular log events at @@ -289,14 +280,14 @@ -- command message handling , (mxSink $ \(SetLevel lvl) -> - mxGetLocal >>= mxSetLocal . (level ^= lvl) >> mxReceive) + mxGetLocal >>= \st' -> mxSetLocal st' { level = lvl } >> mxReceive) , (mxSink $ \(AddFormatter f') -> do fmt <- liftMX $ catch (unClosure f' >>= return . Just) (\(_ :: SomeException) -> return Nothing) case fmt of Nothing -> mxReady Just mf -> do - mxUpdateLocal (formatters ^: (mf:)) + mxUpdateLocal (\s -> s { formatters = mf:formatters s }) mxReceive) ] runCleanup @@ -309,15 +300,15 @@ Just str -> outputMin lvl' str st >> mxReceive Nothing -> mxReceive -- we cannot format a Message, so we ignore it - handleEvent (MxConnected _ ep) = do + handleEvent (MxConnected _ ep) = mxGetLocal >>= outputMin Notice - ("Endpoint: " ++ (show ep) ++ " Disconnected") - handleEvent (MxDisconnected _ ep) = do + ("Endpoint: " ++ show ep ++ " Disconnected") + handleEvent (MxDisconnected _ ep) = mxGetLocal >>= outputMin Notice - ("Endpoint " ++ (show ep) ++ " Connected") + ("Endpoint " ++ show ep ++ " Connected") handleEvent _ = return () - formatMsg m st = let fms = st ^. formatters in formatMsg' m fms + formatMsg m LogState{..} = let fms = formatters in formatMsg' m fms formatMsg' _ [] = return Nothing formatMsg' m (f':fs) = do @@ -326,22 +317,12 @@ ok@(Just _) -> return ok Nothing -> formatMsg' m fs - outputMin minLvl msgData st = - case minLvl >= (st ^. level) of - True -> liftMX $ ((st ^. format) msgData >>= (output st)) + outputMin minLvl msgData LogState{..} = + case minLvl >= level of + True -> liftMX (format msgData >>= output) False -> return () defaultFormatters = [basicDataFormat] basicDataFormat :: Message -> Process (Maybe String) basicDataFormat = unwrapMessage - -level :: Accessor LogState LogLevel -level = accessor _level (\l s -> s { _level = l }) - -format :: Accessor LogState LogFormat -format = accessor _format (\f s -> s { _format = f }) - -formatters :: Accessor LogState [Message -> Process (Maybe String)] -formatters = accessor _formatters (\n' st -> st { _formatters = n' }) - diff --git a/src/Control/Distributed/Process/Extras/Timer.hs b/src/Control/Distributed/Process/Extras/Timer.hs --- a/src/Control/Distributed/Process/Extras/Timer.hs +++ b/src/Control/Distributed/Process/Extras/Timer.hs @@ -1,12 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Distributed.Process.Extras.Timer --- Copyright : (c) Tim Watson 2012 +-- Copyright : (c) Tim Watson 2012 - 2017 -- License : BSD3 (see the file LICENSE) -- -- Maintainer : Tim Watson @@ -42,6 +40,7 @@ import Control.Distributed.Process.Extras.UnsafePrimitives (send) import Control.Distributed.Process.Extras.Internal.Types (NFSerializable) import Control.Distributed.Process.Extras.Time +import Control.Monad (unless, void) import Data.Binary import Data.Typeable (Typeable) import Prelude hiding (init) @@ -57,7 +56,6 @@ instance Binary TimerConfig where instance NFData TimerConfig where rnf tc = tc `seq` () -instance NFSerializable TimerConfig -- | represents a 'tick' event that timers can generate data Tick = Tick @@ -65,7 +63,6 @@ instance Binary Tick where instance NFData Tick where rnf t = t `seq` () -instance NFSerializable Tick data SleepingPill = SleepingPill deriving (Typeable, Generic, Eq, Show) @@ -99,7 +96,7 @@ -> a -> Process TimerRef sendAfter t pid msg = runAfter t proc - where proc = do { send pid msg } + where proc = send pid msg -- | runs the supplied process action(s) after @t@ has elapsed runAfter :: TimeInterval -> Process () -> Process TimerRef @@ -138,11 +135,11 @@ -- out, after which the timer will continue running. To stop a long-running -- timer permanently, you should use 'cancelTimer' instead. resetTimer :: TimerRef -> Process () -resetTimer = (flip send) Reset +resetTimer = flip send Reset -- | permanently cancels a timer cancelTimer :: TimerRef -> Process () -cancelTimer = (flip send) Cancel +cancelTimer = flip send Cancel -- | cancels a running timer and flushes any viable timer messages from the -- process' message queue. This function should only be called by the process @@ -155,9 +152,9 @@ return () where performFlush mRef Infinity = receiveWait $ filters mRef performFlush mRef NoDelay = performFlush mRef (Delay $ microSeconds 0) - performFlush mRef (Delay i) = receiveTimeout (asTimeout i) (filters mRef) >> return () + performFlush mRef (Delay i) = void (receiveTimeout (asTimeout i) (filters mRef)) filters mRef = [ - matchIf (\x -> x == ignore) + matchIf (== ignore) (\_ -> return ()) , matchIf (\(ProcessMonitorNotification mRef' _ _) -> mRef == mRef') (\_ -> return ()) ] @@ -178,7 +175,6 @@ case cancel of Nothing -> runProc cancelOnReset Just Cancel -> return () - Just Reset -> if cancelOnReset then return () - else runTimer t proc cancelOnReset + Just Reset -> unless cancelOnReset $ runTimer t proc cancelOnReset where runProc True = proc runProc False = proc >> runTimer t proc cancelOnReset diff --git a/src/Control/Distributed/Process/Extras/UnsafePrimitives.hs b/src/Control/Distributed/Process/Extras/UnsafePrimitives.hs --- a/src/Control/Distributed/Process/Extras/UnsafePrimitives.hs +++ b/src/Control/Distributed/Process/Extras/UnsafePrimitives.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Distributed.Process.Extras.UnsafePrimitives --- Copyright : (c) Tim Watson 2013 +-- Copyright : (c) Tim Watson 2013 - 2017 -- License : BSD3 (see the file LICENSE) -- -- Maintainer : Tim Watson @@ -60,4 +60,3 @@ -- | Create an unencoded @Message@ for any @Serializable@ type. wrapMessage :: NFSerializable a => a -> Message wrapMessage msg = Unsafe.wrapMessage $!! msg - diff --git a/tests/TestTimer.hs b/tests/TestTimer.hs --- a/tests/TestTimer.hs +++ b/tests/TestTimer.hs @@ -16,7 +16,6 @@ import Control.Distributed.Process import Control.Distributed.Process.Node import Control.Distributed.Process.Serializable() -import Control.Distributed.Process.Extras (NFSerializable) import Control.Distributed.Process.Extras.Time import Control.Distributed.Process.Extras.Timer import Control.Distributed.Process.SysTest.Utils @@ -28,9 +27,7 @@ import GHC.Generics --- orphan instance instance NFData Ping where -instance NFSerializable Ping testSendAfter :: TestResult Bool -> Process () testSendAfter result = @@ -66,7 +63,7 @@ pid <- periodically delay noop ref <- monitor pid _ <- getProcessInfo pid - + cancelTimer pid _ <- receiveWait [