@@ -3,6 +3,7 @@
33{-# LANGUAGE GeneralizedNewtypeDeriving #-}
44{-# LANGUAGE GADTs #-}
55{-# LANGUAGE DeriveGeneric #-}
6+{-# LANGUAGE CPP #-}
67
78-- | Types used throughout the Cloud Haskell framework
89--
@@ -137,7 +138,7 @@ import GHC.Generics
137138newtype NodeId = NodeId { nodeAddress :: NT.EndPointAddress }
138139 deriving (Eq, Ord, Typeable, Data, Generic)
139140instance Binary NodeId where
140−instance NFData NodeId
141+instance NFData NodeId where rnf (NodeId a) = rnf a `seq` ()
141142instance Hashable NodeId where
142143instance Show NodeId where
143144 show (NodeId addr) = "nid://" ++ show addr
@@ -162,7 +163,7 @@ data ProcessId = ProcessId
162163 deriving (Eq, Ord, Typeable, Data, Generic)
163164
164165instance Binary ProcessId where
165−instance NFData ProcessId where
166+instance NFData ProcessId where rnf (ProcessId n _) = rnf n `seq` ()
166167instance Hashable ProcessId where
167168
168169instance Show ProcessId where
@@ -177,6 +178,10 @@ data Identifier =
177178 deriving (Eq, Ord, Generic)
178179
179180instance Hashable Identifier where
181+instance NFData Identifier where
182+ rnf (NodeIdentifier n) = rnf n `seq` ()
183+ rnf (ProcessIdentifier n) = rnf n `seq` ()
184+ rnf n@SendPortIdentifier{} = n `seq` ()
180185
181186instance Show Identifier where
182187 show (NodeIdentifier nid) = show nid
@@ -317,6 +322,9 @@ instance Show SendPortId where
317322 show (SendPortId (ProcessId (NodeId addr) (LocalProcessId _ plid)) clid)
318323 = "cid://" ++ show addr ++ ":" ++ show plid ++ ":" ++ show clid
319324
325+instance NFData SendPortId where
326+ rnf (SendPortId p _) = rnf p `seq` ()
327+
320328data TypedChannel = forall a. Serializable a => TypedChannel (Weak (TQueue a))
321329
322330-- | The send send of a typed channel (serializable)
@@ -328,7 +336,7 @@ newtype SendPort a = SendPort {
328336
329337instance (Serializable a) => Binary (SendPort a) where
330338instance (Hashable a) => Hashable (SendPort a) where
331−instance (NFData a) => NFData (SendPort a) where
339+instance (NFData a) => NFData (SendPort a) where rnf (SendPort x) = x `seq` ()
332340
333341-- | The receive end of a typed channel (not serializable)
334342--
@@ -366,6 +374,14 @@ data Message =
366374 }
367375 deriving (Typeable)
368376
377+instance NFData Message where
378+#if MIN_VERSION_bytestring(0,10,0)
379+ rnf (EncodedMessage _ e) = rnf e `seq` ()
380+#else
381+ rnf (EncodedMessage _ e) = BSL.length e `seq` ()
382+#endif
383+ rnf (UnencodedMessage _ a) = a `seq` () -- forced to WHNF only
384+
369385instance Show Message where
370386 show (EncodedMessage fp enc) = show enc ++ " :: " ++ showFingerprint fp []
371387 show (UnencodedMessage _ uenc) = "[unencoded message] :: " ++ (show $ typeOf uenc)
@@ -429,7 +445,10 @@ data MonitorRef = MonitorRef
429445 , monitorRefCounter :: !Int32
430446 }
431447 deriving (Eq, Ord, Show, Typeable, Generic)
432−instance Hashable MonitorRef where
448+instance Hashable MonitorRef
449+
450+instance NFData MonitorRef where
451+ rnf (MonitorRef i _) = rnf i `seq` ()
433452
434453-- | Message sent by process monitors
435454data ProcessMonitorNotification =
@@ -497,6 +516,10 @@ data DiedReason =
497516 | DiedUnknownId
498517 deriving (Show, Eq)
499518
519+instance NFData DiedReason where
520+ rnf (DiedException s) = rnf s `seq` ()
521+ rnf x = x `seq` ()
522+
500523-- | (Asynchronous) reply from unmonitor
501524newtype DidUnmonitor = DidUnmonitor MonitorRef
502525 deriving (Typeable, Binary)
@@ -678,9 +701,6 @@ instance Binary SendPortId where
678701 put cid = put (sendPortProcessId cid) >> put (sendPortLocalId cid)
679702 get = SendPortId <$> get <*> get
680703
681−instance NFData SendPortId where
682− rnf cid = (sendPortProcessId cid) `seq` (sendPortLocalId cid) `seq` ()
683−
684704instance Binary Identifier where
685705 put (ProcessIdentifier pid) = putWord8 0 >> put pid
686706 put (NodeIdentifier nid) = putWord8 1 >> put nid