git.iko.soy/distributed-process
on master help sign in
distributed-process/src/Control/Distributed/Process/Serializable.hs
73 lines 2.6 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE UndecidableInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE GADTs #-}
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)
20import Data.Typeable (Typeable, typeRepFingerprint, typeOf)
22import Numeric (showHex)
23import Control.Exception (throw)
24import GHC.Fingerprint.Type (Fingerprint(..))
25import Data.ByteString (ByteString)
26import qualified Data.ByteString as BS
27import qualified Data.ByteString.Internal as BSI ( unsafeCreate, toForeignPtr )
28import Foreign.Storable (pokeByteOff, peekByteOff, sizeOf)
29import Foreign.ForeignPtr (withForeignPtr)
30import System.IO.Unsafe (unsafePerformIO)
32-- | Reification of 'Serializable' (see "Control.Distributed.Process.Closure")
33data SerializableDict a where
34 SerializableDict :: Serializable a => SerializableDict a
35 deriving (Typeable)
37-- | Reification of 'Typeable'.
38data TypeableDict a where
39 TypeableDict :: Typeable a => TypeableDict a
40 deriving (Typeable)
42-- | Objects that can be sent across the network
43class (Binary a, Typeable a) => Serializable a
44instance (Binary a, Typeable a) => Serializable a
46-- | Encode type representation as a bytestring
47encodeFingerprint :: Fingerprint -> ByteString
48encodeFingerprint fp =
49 -- Since all CH nodes will run precisely the same binary, we don't have to
50 -- worry about cross-arch issues here (like endianness)
51 BSI.unsafeCreate sizeOfFingerprint $ \p -> pokeByteOff p 0 fp
53-- | Decode a bytestring into a fingerprint. Throws an IO exception on failure
54decodeFingerprint :: ByteString -> Fingerprint
55decodeFingerprint bs
56 | BS.length bs /= sizeOfFingerprint =
57 throw $ userError "decodeFingerprint: Invalid length"
58 | otherwise = unsafePerformIO $ do
59 let (fp, offset, _) = BSI.toForeignPtr bs
60 withForeignPtr fp $ \p -> peekByteOff p offset
62-- | Size of a fingerprint
63sizeOfFingerprint :: Int
64sizeOfFingerprint = sizeOf (undefined :: Fingerprint)
66-- | The fingerprint of the typeRep of the argument
67fingerprint :: Typeable a => a -> Fingerprint
68fingerprint = typeRepFingerprint . typeOf
70-- | Show fingerprint (for debugging purposes)
71showFingerprint :: Fingerprint -> ShowS
72showFingerprint (Fingerprint hi lo) =
73 showString "(" . showHex hi . showString "," . showHex lo . showString ")"