git.iko.soy/distributed-process
on 368e681 help sign in
distributed-process/src/Control/Distributed/Process/Serializable.hs
90 lines 3.1 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE UndecidableInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE CPP #-}
7module Control.Distributed.Process.Serializable
8 ( Serializable
9 , encodeFingerprint
10 , decodeFingerprint
11 , fingerprint
12 , sizeOfFingerprint
13 , Fingerprint
14 , showFingerprint
15 , SerializableDict(SerializableDict)
16 , TypeableDict(TypeableDict)
17 ) where
19import Data.Binary (Binary)
21#if MIN_VERSION_base(4,10,0)
22import Data.Typeable (Typeable)
23import Type.Reflection (typeRep)
24import Type.Reflection.Unsafe (TypeRep, typeRepFingerprint)
25#elif MIN_VERSION_base(4,7,0)
26import Data.Typeable (Typeable)
27import Data.Typeable.Internal (TypeRep(TypeRep), typeOf)
28#else
29import Data.Typeable (Typeable(..))
30import Data.Typeable.Internal (TypeRep(TypeRep))
31#endif
33import Numeric (showHex)
34import Control.Exception (throw)
35import GHC.Fingerprint.Type (Fingerprint(..))
36import Data.ByteString (ByteString)
37import qualified Data.ByteString as BS
38import qualified Data.ByteString.Internal as BSI ( unsafeCreate, toForeignPtr )
39import Foreign.Storable (pokeByteOff, peekByteOff, sizeOf)
40import Foreign.ForeignPtr (withForeignPtr)
41import System.IO.Unsafe (unsafePerformIO)
43-- | Reification of 'Serializable' (see "Control.Distributed.Process.Closure")
44data SerializableDict a where
45 SerializableDict :: Serializable a => SerializableDict a
46 deriving (Typeable)
48-- | Reification of 'Typeable'.
49data TypeableDict a where
50 TypeableDict :: Typeable a => TypeableDict a
51 deriving (Typeable)
53-- | Objects that can be sent across the network
54class (Binary a, Typeable a) => Serializable a
55instance (Binary a, Typeable a) => Serializable a
57-- | Encode type representation as a bytestring
58encodeFingerprint :: Fingerprint -> ByteString
59encodeFingerprint fp =
60 -- Since all CH nodes will run precisely the same binary, we don't have to
61 -- worry about cross-arch issues here (like endianness)
62 BSI.unsafeCreate sizeOfFingerprint $ \p -> pokeByteOff p 0 fp
64-- | Decode a bytestring into a fingerprint. Throws an IO exception on failure
65decodeFingerprint :: ByteString -> Fingerprint
66decodeFingerprint bs
67 | BS.length bs /= sizeOfFingerprint =
68 throw $ userError "decodeFingerprint: Invalid length"
69 | otherwise = unsafePerformIO $ do
70 let (fp, offset, _) = BSI.toForeignPtr bs
71 withForeignPtr fp $ \p -> peekByteOff p offset
73-- | Size of a fingerprint
74sizeOfFingerprint :: Int
75sizeOfFingerprint = sizeOf (undefined :: Fingerprint)
77-- | The fingerprint of the typeRep of the argument
78fingerprint :: forall a. Typeable a => a -> Fingerprint
79#if MIN_VERSION_base(4,10,0)
80fingerprint _ = typeRepFingerprint (typeRep :: TypeRep a)
81#elif MIN_VERSION_base(4,8,0)
82fingerprint a = let TypeRep fp _ _ _ = typeOf a in fp
83#else
84fingerprint a = let TypeRep fp _ _ = typeOf a in fp
85#endif
87-- | Show fingerprint (for debugging purposes)
88showFingerprint :: Fingerprint -> ShowS
89showFingerprint (Fingerprint hi lo) =
90 showString "(" . showHex hi . showString "," . showHex lo . showString ")"