2 -- (c) The University of Glasgow 2002-2006
6 {-# LANGUAGE ScopedTypeVariables #-}
8 -- * Main Serialized data type
12 -- * Going into and out of 'Serialized'
13 toSerialized, fromSerialized,
15 -- * Handy serialization functions
16 serializeWithData, deserializeWithData,
25 import Data.Word ( Word8 )
27 #if __GLASGOW_HASKELL__ > 609
34 -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types
35 data Serialized = Serialized TypeRep [Word8]
37 instance Outputable Serialized where
38 ppr (Serialized the_type bytes) = int (length bytes) <+> ptext (sLit "of type") <+> text (show the_type)
40 instance Binary Serialized where
41 put_ bh (Serialized the_type bytes) = do
47 return (Serialized the_type bytes)
49 -- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later
50 toSerialized :: Typeable a => (a -> [Word8]) -> a -> Serialized
51 toSerialized serialize what = Serialized (typeOf what) (serialize what)
53 -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.
54 -- Otherwise return @Nothing@.
55 fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
56 fromSerialized deserialize (Serialized the_type bytes)
57 | the_type == typeOf (undefined :: a) = Just (deserialize bytes)
60 -- | Force the contents of the Serialized value so weknow it doesn't contain any bottoms
61 seqSerialized :: Serialized -> ()
62 seqSerialized (Serialized the_type bytes) = the_type `seq` bytes `seqList` ()
65 -- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'
66 serializeWithData :: Data a => a -> [Word8]
67 serializeWithData what = serializeWithData' what []
69 serializeWithData' :: Data a => a -> [Word8] -> [Word8]
70 serializeWithData' what = fst $ gfoldl (\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a))
71 (\x -> (serializeConstr (constrRep (toConstr what)), x))
74 -- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData'
75 deserializeWithData :: Data a => [Word8] -> a
76 deserializeWithData = snd . deserializeWithData'
78 deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)
79 deserializeWithData' bytes = deserializeConstr bytes $ \constr_rep bytes ->
80 gunfold (\(bytes, b_to_r) -> let (bytes', b) = deserializeWithData' bytes in (bytes', b_to_r b))
82 (repConstr (dataTypeOf (undefined :: a)) constr_rep)
85 serializeConstr :: ConstrRep -> [Word8] -> [Word8]
86 serializeConstr (AlgConstr ix) = serializeWord8 1 . serializeInt ix
87 serializeConstr (IntConstr i) = serializeWord8 2 . serializeInteger i
88 serializeConstr (FloatConstr r) = serializeWord8 3 . serializeRational r
89 #if __GLASGOW_HASKELL__ < 611
90 serializeConstr (StringConstr s) = serializeWord8 4 . serializeString s
92 serializeConstr (CharConstr c) = serializeWord8 4 . serializeChar c
96 deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a
97 deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->
99 1 -> deserializeInt bytes $ \ix -> k (AlgConstr ix)
100 2 -> deserializeInteger bytes $ \i -> k (IntConstr i)
101 3 -> deserializeRational bytes $ \r -> k (FloatConstr r)
102 #if __GLASGOW_HASKELL__ >= 611
103 4 -> deserializeChar bytes $ \c -> k (CharConstr c)
105 4 -> deserializeString bytes $ \s -> k (StringConstr s)
107 x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes
110 serializeFixedWidthNum :: forall a. (Num a, Integral a, Bits a) => a -> [Word8] -> [Word8]
111 serializeFixedWidthNum what = go (bitSize what) what
113 go :: Int -> a -> [Word8] -> [Word8]
116 | otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest
118 deserializeFixedWidthNum :: forall a b. (Num a, Integral a, Bits a) => [Word8] -> (a -> [Word8] -> b) -> b
119 deserializeFixedWidthNum bytes k = go (bitSize (undefined :: a)) bytes k
121 go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b
123 | size <= 0 = k 0 bytes
124 | otherwise = case bytes of
125 (byte:bytes) -> go (size - 8) bytes (\x -> k ((x `shiftL` 8) .|. fromIntegral byte))
126 [] -> error "deserializeFixedWidthNum: unexpected end of stream"
129 serializeEnum :: (Enum a) => a -> [Word8] -> [Word8]
130 serializeEnum = serializeInt . fromEnum
132 deserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b
133 deserializeEnum bytes k = deserializeInt bytes (k . toEnum)
136 serializeWord8 :: Word8 -> [Word8] -> [Word8]
137 serializeWord8 x = (x:)
139 deserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a
140 deserializeWord8 (byte:bytes) k = k byte bytes
141 deserializeWord8 [] _ = error "deserializeWord8: unexpected end of stream"
144 serializeInt :: Int -> [Word8] -> [Word8]
145 serializeInt = serializeFixedWidthNum
147 deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a
148 deserializeInt = deserializeFixedWidthNum
151 serializeRational :: (Real a) => a -> [Word8] -> [Word8]
152 serializeRational = serializeString . show . toRational
154 deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b
155 deserializeRational bytes k = deserializeString bytes (k . fromRational . read)
158 serializeInteger :: Integer -> [Word8] -> [Word8]
159 serializeInteger = serializeString . show
161 deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a
162 deserializeInteger bytes k = deserializeString bytes (k . read)
165 #if __GLASGOW_HASKELL__ >= 611
166 serializeChar :: Char -> [Word8] -> [Word8]
167 serializeChar = serializeString . show
169 deserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a
170 deserializeChar bytes k = deserializeString bytes (k . read)
174 serializeString :: String -> [Word8] -> [Word8]
175 serializeString = serializeList serializeEnum
177 deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a
178 deserializeString = deserializeList deserializeEnum
181 serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
182 serializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs)
184 deserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c)
185 -> [Word8] -> ([a] -> [Word8] -> b) -> b
186 deserializeList deserialize_element bytes k = deserializeInt bytes $ \len bytes -> go len bytes k
188 go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
190 | len <= 0 = k [] bytes
191 | otherwise = deserialize_element bytes (\elt bytes -> go (len - 1) bytes (k . (elt:)))