@@ -0,0 +1,152 @@
1+module Streamly.Internal.Data.Serialize
2+ ( Size(..)
3+ , Serialize(..)
4+ ) where
5+
6+--------------------------------------------------------------------------------
7+-- Imports
8+--------------------------------------------------------------------------------
9+
10+import Control.Monad (void)
11+import Data.List (foldl')
12+import Data.Proxy (Proxy (..))
13+import Streamly.Internal.Data.Unbox (MutableByteArray(..))
14+
15+import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
16+import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))
17+import GHC.Stable (StablePtr(..))
18+
19+import qualified Streamly.Internal.Data.Unbox as Unbox
20+
21+import GHC.Exts
22+
23+--------------------------------------------------------------------------------
24+-- Types
25+--------------------------------------------------------------------------------
26+
27+-- | Info about the length of a serializable type. Length can depend on the
28+-- value or can be independent.
29+data Size a
30+ = VarSize (a -> Int)
31+ | ConstSize !Int
32+
33+-- | A type implementing the 'Serialize' interface supplies operations for
34+-- reading and writing the type from and to a mutable byte array (an unboxed
35+-- representation of the type) in memory. The read operation 'deserialize'
36+-- deserializes the boxed type from the mutable byte array. The write operation
37+-- 'serialize' serializes the boxed type to the mutable byte array.
38+--
39+-- 'Serialize' contains enough information to serialize and deserialize variable
40+-- length types.
41+--
42+-- >>> import Streamly.Internal.Data.Serialize (Serialize(..), Size(..))
43+--
44+-- >>> :{
45+-- data Object = Object
46+-- { _varLen :: [Int]
47+-- , _constLen :: Int
48+-- }
49+-- :}
50+--
51+-- >>> :{
52+-- instance Serialize Object where
53+-- size =
54+-- case (size :: Size [Int], size :: Size Int) of
55+-- (VarSize f, ConstSize g) ->
56+-- VarSize $ \obj ->
57+-- f (_varLen obj) + g
58+-- _ -> error "size is not defined properly"
59+-- deserialize i arr = do
60+-- (i1, x0) <- deserialize i arr
61+-- (i2, x1) <- deserialize i1 arr
62+-- pure (i2, Object x0 x1)
63+-- serialize i arr (Object x0 x1) = do
64+-- i1 <- serialize i arr x0
65+-- i2 <- serialize i1 arr x1
66+-- pure i2
67+-- :}
68+--
69+class Serialize a where
70+ -- | Get the 'Size', in bytes, reqired to store the serialized
71+ -- representation of the type. Size cannot be zero.
72+ size :: Size a
73+
74+ -- We can implement the following functions without returning the `Int`
75+ -- offset but that may require traversing the Haskell structure again to get
76+ -- the size. Therefore, this is a performance optimization.
77+
78+ -- | Deserialize a value from the given byte-index in the array. Returns a
79+ -- tuple of the next byte-index and the deserialized value.
80+ deserialize :: Int -> MutableByteArray -> IO (Int, a)
81+
82+ -- | Write the serialized representation of the value in the array at the
83+ -- given byte-index. Returns the next byte-index.
84+ serialize :: Int -> MutableByteArray -> a -> IO Int
85+
86+--------------------------------------------------------------------------------
87+-- Instances
88+--------------------------------------------------------------------------------
89+
90+#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \
91+instance Serialize _type where \
92+; size = ConstSize $ Unbox.sizeOf (Proxy :: Proxy _type) \
93+; deserialize off arr = \
94+ Unbox.peekByteIndex off arr >>= \
95+ \val -> let sz = Unbox.sizeOf (Proxy :: Proxy _type) \
96+ in pure (off + sz, val) \
97+; serialize off arr val = \
98+ Unbox.pokeByteIndex off arr val \
99+ >> let sz = Unbox.sizeOf (Proxy :: Proxy _type) \
100+ in pure (off + sz)
101+
102+DERIVE_SERIALIZE_FROM_UNBOX(Char)
103+DERIVE_SERIALIZE_FROM_UNBOX(Int8)
104+DERIVE_SERIALIZE_FROM_UNBOX(Int16)
105+DERIVE_SERIALIZE_FROM_UNBOX(Int32)
106+DERIVE_SERIALIZE_FROM_UNBOX(Int)
107+DERIVE_SERIALIZE_FROM_UNBOX(Int64)
108+DERIVE_SERIALIZE_FROM_UNBOX(Word)
109+DERIVE_SERIALIZE_FROM_UNBOX(Word8)
110+DERIVE_SERIALIZE_FROM_UNBOX(Word16)
111+DERIVE_SERIALIZE_FROM_UNBOX(Word32)
112+DERIVE_SERIALIZE_FROM_UNBOX(Word64)
113+DERIVE_SERIALIZE_FROM_UNBOX(Double)
114+DERIVE_SERIALIZE_FROM_UNBOX(Float)
115+DERIVE_SERIALIZE_FROM_UNBOX((StablePtr a))
116+DERIVE_SERIALIZE_FROM_UNBOX((Ptr a))
117+DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))
118+
119+instance forall a. Serialize a => Serialize [a] where
120+
121+ {-# INLINE size #-}
122+ size = VarSize $ \lst ->
123+ case size :: Size a of
124+ VarSize f ->
125+ foldl'
126+ (\acc x -> acc + f x)
127+ (Unbox.sizeOf (Proxy :: Proxy Int))
128+ lst
129+ ConstSize sz ->
130+ length lst
131+ * sz
132+ + Unbox.sizeOf (Proxy :: Proxy Int)
133+
134+ {-# INLINE deserialize #-}
135+ deserialize off arr = do
136+ len <- Unbox.peekByteIndex off arr :: IO Int
137+ let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int)
138+ let peekList buf o 0 = pure (o, reverse buf)
139+ peekList buf o i = do
140+ (o1, x) <- deserialize o arr
141+ peekList (x:buf) o1 (i - 1)
142+ peekList [] off1 len
143+
144+ {-# INLINE serialize #-}
145+ serialize off arr val = do
146+ void $ serialize off arr (length val)
147+ let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int)
148+ let pokeList o [] = pure o
149+ pokeList o (x:xs) = do
150+ o1 <- serialize o arr x
151+ pokeList o1 xs
152+ pokeList off1 val