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