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