diff --git a/distributed-process.cabal b/distributed-process.cabal index 3a938843..5fdfada9 100644 --- a/distributed-process.cabal +++ b/distributed-process.cabal @@ -38,6 +38,13 @@ 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, @@ -45,15 +52,13 @@ Library 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 diff --git a/src/Control/Distributed/Process/Internal/Closure/TH.hs b/src/Control/Distributed/Process/Internal/Closure/TH.hs index ea710912..8ba46e22 100644 --- a/src/Control/Distributed/Process/Internal/Closure/TH.hs +++ b/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] diff --git a/src/Control/Distributed/Process/Internal/Primitives.hs b/src/Control/Distributed/Process/Internal/Primitives.hs index ed23d591..5485b7de 100644 --- a/src/Control/Distributed/Process/Internal/Primitives.hs +++ b/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) diff --git a/src/Control/Distributed/Process/Internal/Types.hs b/src/Control/Distributed/Process/Internal/Types.hs index f15b9685..b5013a09 100644 --- a/src/Control/Distributed/Process/Internal/Types.hs +++ b/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 diff --git a/src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs b/src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs index 267da9a9..65049314 100644 --- a/src/Control/Distributed/Process/Management/Internal/Trace/Tracer.hs +++ b/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 ) diff --git a/src/Control/Distributed/Process/Serializable.hs b/src/Control/Distributed/Process/Serializable.hs index 9c29feac..44dc9e51 100644 --- a/src/Control/Distributed/Process/Serializable.hs +++ b/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