1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
--
-- (c) The University of Glasgow 2002-2006
--
-- Serialized values
module GHC.Serialized (
-- * Main Serialized data type
Serialized(..),
-- * Going into and out of 'Serialized'
toSerialized, fromSerialized,
-- * Handy serialization functions
serializeWithData, deserializeWithData,
) where
import Data.Bits
import Data.Word ( Word8 )
import Data.Data
-- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types
data Serialized = Serialized TypeRep [Word8]
-- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later
toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized
toSerialized serialize what = Serialized (typeOf what) (serialize what)
-- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.
-- Otherwise return @Nothing@.
fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
#if MIN_VERSION_base(4,10,0)
fromSerialized deserialize (Serialized the_type bytes)
| the_type == rep = Just (deserialize bytes)
| otherwise = Nothing
where rep = typeRep (Proxy :: Proxy a)
#else
fromSerialized deserialize (Serialized the_type bytes)
| the_type == typeOf (undefined :: a) = Just (deserialize bytes)
| otherwise = Nothing
#endif
-- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'
serializeWithData :: Data a => a -> [Word8]
serializeWithData what = serializeWithData' what []
serializeWithData' :: Data a => a -> [Word8] -> [Word8]
serializeWithData' what = fst $ gfoldl (\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a))
(\x -> (serializeConstr (constrRep (toConstr what)), x))
what
-- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData'
deserializeWithData :: Data a => [Word8] -> a
deserializeWithData = snd . deserializeWithData'
deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)
deserializeWithData' bytes = deserializeConstr bytes $ \constr_rep bytes ->
gunfold (\(bytes, b_to_r) -> let (bytes', b) = deserializeWithData' bytes in (bytes', b_to_r b))
(\x -> (bytes, x))
(repConstr (dataTypeOf (undefined :: a)) constr_rep)
serializeConstr :: ConstrRep -> [Word8] -> [Word8]
serializeConstr (AlgConstr ix) = serializeWord8 1 . serializeInt ix
serializeConstr (IntConstr i) = serializeWord8 2 . serializeInteger i
serializeConstr (FloatConstr r) = serializeWord8 3 . serializeRational r
serializeConstr (CharConstr c) = serializeWord8 4 . serializeChar c
deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a
deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->
case constr_ix of
1 -> deserializeInt bytes $ \ix -> k (AlgConstr ix)
2 -> deserializeInteger bytes $ \i -> k (IntConstr i)
3 -> deserializeRational bytes $ \r -> k (FloatConstr r)
4 -> deserializeChar bytes $ \c -> k (CharConstr c)
x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes
serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum what = go (finiteBitSize what) what
where
go :: Int -> a -> [Word8] -> [Word8]
go size current rest
| size <= 0 = rest
| otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest
deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k
where
go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b
go size bytes k
| size <= 0 = k 0 bytes
| otherwise = case bytes of
(byte:bytes) -> go (size - 8) bytes (\x -> k ((x `shiftL` 8) .|. fromIntegral byte))
[] -> error "deserializeFixedWidthNum: unexpected end of stream"
serializeEnum :: (Enum a) => a -> [Word8] -> [Word8]
serializeEnum = serializeInt . fromEnum
deserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b
deserializeEnum bytes k = deserializeInt bytes (k . toEnum)
serializeWord8 :: Word8 -> [Word8] -> [Word8]
serializeWord8 x = (x:)
deserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a
deserializeWord8 (byte:bytes) k = k byte bytes
deserializeWord8 [] _ = error "deserializeWord8: unexpected end of stream"
serializeInt :: Int -> [Word8] -> [Word8]
serializeInt = serializeFixedWidthNum
deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a
deserializeInt = deserializeFixedWidthNum
serializeRational :: (Real a) => a -> [Word8] -> [Word8]
serializeRational = serializeString . show . toRational
deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeRational bytes k = deserializeString bytes (k . fromRational . read)
serializeInteger :: Integer -> [Word8] -> [Word8]
serializeInteger = serializeString . show
deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a
deserializeInteger bytes k = deserializeString bytes (k . read)
serializeChar :: Char -> [Word8] -> [Word8]
serializeChar = serializeString . show
deserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a
deserializeChar bytes k = deserializeString bytes (k . read)
serializeString :: String -> [Word8] -> [Word8]
serializeString = serializeList serializeEnum
deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a
deserializeString = deserializeList deserializeEnum
serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
serializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs)
deserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c)
-> [Word8] -> ([a] -> [Word8] -> b) -> b
deserializeList deserialize_element bytes k = deserializeInt bytes $ \len bytes -> go len bytes k
where
go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
go len bytes k
| len <= 0 = k [] bytes
| otherwise = deserialize_element bytes (\elt bytes -> go (len - 1) bytes (k . (elt:)))
|
