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