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