git.iko.soy/distributed-process
on 97a4efd help sign in
distributed-process/src/Control/Distributed/Process/Serializable.hs
75 lines 2.7 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 ) where
17import Data.Binary (Binary)
19#if MIN_VERSION_base(4,7,0)
20import Data.Typeable (Typeable)
21import Data.Typeable.Internal (TypeRep(TypeRep), typeOf)
22#else
23import Data.Typeable (Typeable(..))
24import Data.Typeable.Internal (TypeRep(TypeRep))
25#endif
27import Numeric (showHex)
28import Control.Exception (throw)
29import GHC.Fingerprint.Type (Fingerprint(..))
30import Data.ByteString (ByteString)
31import qualified Data.ByteString as BS
32import qualified Data.ByteString.Internal as BSI ( unsafeCreate
33 , inlinePerformIO
34 , toForeignPtr
35 )
36import Foreign.Storable (pokeByteOff, peekByteOff, sizeOf)
37import Foreign.ForeignPtr (withForeignPtr)
39-- | Reification of 'Serializable' (see "Control.Distributed.Process.Closure")
40data SerializableDict a where
41 SerializableDict :: Serializable a => SerializableDict a
42 deriving (Typeable)
44-- | Objects that can be sent across the network
45class (Binary a, Typeable a) => Serializable a
46instance (Binary a, Typeable a) => Serializable a
48-- | Encode type representation as a bytestring
49encodeFingerprint :: Fingerprint -> ByteString
50encodeFingerprint fp =
51 -- Since all CH nodes will run precisely the same binary, we don't have to
52 -- worry about cross-arch issues here (like endianness)
53 BSI.unsafeCreate sizeOfFingerprint $ \p -> pokeByteOff p 0 fp
55-- | Decode a bytestring into a fingerprint. Throws an IO exception on failure
56decodeFingerprint :: ByteString -> Fingerprint
57decodeFingerprint bs
58 | BS.length bs /= sizeOfFingerprint =
59 throw $ userError "decodeFingerprint: Invalid length"
60 | otherwise = BSI.inlinePerformIO $ do
61 let (fp, offset, _) = BSI.toForeignPtr bs
62 withForeignPtr fp $ \p -> peekByteOff p offset
64-- | Size of a fingerprint
65sizeOfFingerprint :: Int
66sizeOfFingerprint = sizeOf (undefined :: Fingerprint)
68-- | The fingerprint of the typeRep of the argument
69fingerprint :: Typeable a => a -> Fingerprint
70fingerprint a = let TypeRep fp _ _ = typeOf a in fp
72-- | Show fingerprint (for debugging purposes)
73showFingerprint :: Fingerprint -> ShowS
74showFingerprint (Fingerprint hi lo) =
75 showString "(" . showHex hi . showString "," . showHex lo . showString ")"