Merge pull request #189 from tweag/ghc-7.10

Add compatibility with ghc-7.10

distributed-process.cabal

@@ -38,22 +38,27 @@ flag prof
   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,
                      hashable >= 1.2.0.5 && < 1.3,
                      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 @@ Library
                       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
 

src/Control/Distributed/Process/Internal/Closure/TH.hs

@@ -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 @@ import Language.Haskell.TH
   , 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.Serializable
   )
 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 :: Name -> [TyVarBndr] -> Type -> Q [Dec]
 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]

src/Control/Distributed/Process/Internal/Primitives.hs

@@ -124,7 +124,11 @@ import Prelude hiding (catch)
 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)

src/Control/Distributed/Process/Internal/Types.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving  #-}
 {-# LANGUAGE GADTs  #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE CPP #-}
 
 -- | Types used throughout the Cloud Haskell framework
 --
@@ -137,7 +138,7 @@ import GHC.Generics
 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
@@ -162,7 +163,7 @@ data ProcessId = ProcessId
   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
@@ -177,6 +178,10 @@ data Identifier =
   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
@@ -317,6 +322,9 @@ instance Show SendPortId where
   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)
@@ -328,7 +336,7 @@ newtype SendPort a = SendPort {
 
 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)
 --
@@ -366,6 +374,14 @@ data Message =
   }
   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)
@@ -429,7 +445,10 @@ data MonitorRef = MonitorRef
   , 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 =
@@ -497,6 +516,10 @@ data DiedReason =
   | 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)
@@ -678,9 +701,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
   put (NodeIdentifier nid)     = putWord8 1 >> put nid

src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs

@@ -88,7 +88,11 @@ import System.IO
   , 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
   )

src/Control/Distributed/Process/Serializable.hs

@@ -73,7 +73,11 @@ sizeOfFingerprint = sizeOf (undefined :: Fingerprint)
 
 -- | 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