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