git.iko.soy/distributed-process
on mx-fix help sign in
distributed-process/src/Control/Distributed/Process/Serializable.hs
83 lines 2.8 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, toForeignPtr )
34import Foreign.Storable (pokeByteOff, peekByteOff, sizeOf)
35import Foreign.ForeignPtr (withForeignPtr)
36import System.IO.Unsafe (unsafePerformIO)
38-- | Reification of 'Serializable' (see "Control.Distributed.Process.Closure")
39data SerializableDict a where
40 SerializableDict :: Serializable a => SerializableDict a
41 deriving (Typeable)
43-- | Reification of 'Typeable'.
44data TypeableDict a where
45 TypeableDict :: Typeable a => TypeableDict a
46 deriving (Typeable)
48-- | Objects that can be sent across the network
49class (Binary a, Typeable a) => Serializable a
50instance (Binary a, Typeable a) => Serializable a
52-- | Encode type representation as a bytestring
53encodeFingerprint :: Fingerprint -> ByteString
54encodeFingerprint fp =
55 -- Since all CH nodes will run precisely the same binary, we don't have to
56 -- worry about cross-arch issues here (like endianness)
57 BSI.unsafeCreate sizeOfFingerprint $ \p -> pokeByteOff p 0 fp
59-- | Decode a bytestring into a fingerprint. Throws an IO exception on failure
60decodeFingerprint :: ByteString -> Fingerprint
61decodeFingerprint bs
62 | BS.length bs /= sizeOfFingerprint =
63 throw $ userError "decodeFingerprint: Invalid length"
64 | otherwise = unsafePerformIO $ do
65 let (fp, offset, _) = BSI.toForeignPtr bs
66 withForeignPtr fp $ \p -> peekByteOff p offset
68-- | Size of a fingerprint
69sizeOfFingerprint :: Int
70sizeOfFingerprint = sizeOf (undefined :: Fingerprint)
72-- | The fingerprint of the typeRep of the argument
73fingerprint :: Typeable a => a -> Fingerprint
74#if MIN_VERSION_base(4,8,0)
75fingerprint a = let TypeRep fp _ _ _ = typeOf a in fp
76#else
77fingerprint a = let TypeRep fp _ _ = typeOf a in fp
78#endif
80-- | Show fingerprint (for debugging purposes)
81showFingerprint :: Fingerprint -> ShowS
82showFingerprint (Fingerprint hi lo) =
83 showString "(" . showHex hi . showString "," . showHex lo . showString ")"