git.iko.soy/streamly
on a819eb7 help sign in
streamly/core/src/Streamly/Internal/Data/Serialize.hs
214 lines 7.5 kB history raw
1-- |
2-- Module : Streamly.Internal.Data.Serialize
3-- Copyright : (c) 2023 Composewell Technologies
4-- License : BSD3-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Portability : GHC
7--
9module Streamly.Internal.Data.Serialize
10 ( Size(..)
11 , Serialize(..)
12 , encode
13 , pinnedEncode
14 , decode
15 ) where
17--------------------------------------------------------------------------------
18-- Imports
19--------------------------------------------------------------------------------
21#include "assert.hs"
23import Control.Monad (void)
24import Data.List (foldl')
25import Data.Proxy (Proxy (..))
26import Streamly.Internal.Data.Unbox (MutableByteArray(..), PinnedState(..))
27import Streamly.Internal.Data.Array.Type (Array(..))
28import Streamly.Internal.System.IO (unsafeInlineIO)
29import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))
30import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))
31import GHC.Stable (StablePtr(..))
33import qualified Streamly.Internal.Data.Unbox as Unbox
34import qualified Streamly.Internal.Data.Array as Array
36import GHC.Exts
38--------------------------------------------------------------------------------
39-- Types
40--------------------------------------------------------------------------------
42-- | Info about the length of a serializable type. Length can depend on the
43-- value or can be independent.
44data Size a
45 = VarSize (a -> Int)
46 | ConstSize !Int
48-- | A type implementing the 'Serialize' interface supplies operations for
49-- reading and writing the type from and to a mutable byte array (an unboxed
50-- representation of the type) in memory. The read operation 'deserialize'
51-- deserializes the boxed type from the mutable byte array. The write operation
52-- 'serialize' serializes the boxed type to the mutable byte array.
53--
54-- IMPORTANT: The serialized data's byte ordering is not normalized, which means
55-- it remains the same as the machine's byte order where the function is
56-- executed. Consequently, it may not be compatible across machines with
57-- different byte ordering.
58--
59-- 'Serialize' contains enough information to serialize and deserialize variable
60-- length types.
61--
62-- >>> import Streamly.Internal.Data.Serialize (Serialize(..), Size(..))
63--
64-- >>> :{
65-- data Object = Object
66-- { _varLen :: [Int]
67-- , _constLen :: Int
68-- }
69-- :}
70--
71-- >>> :{
72-- instance Serialize Object where
73-- size =
74-- case (size :: Size [Int], size :: Size Int) of
75-- (VarSize f, ConstSize g) ->
76-- VarSize $ \obj ->
77-- f (_varLen obj) + g
78-- _ -> error "size is not defined properly"
79-- deserialize i arr = do
80-- (i1, x0) <- deserialize i arr
81-- (i2, x1) <- deserialize i1 arr
82-- pure (i2, Object x0 x1)
83-- serialize i arr (Object x0 x1) = do
84-- i1 <- serialize i arr x0
85-- i2 <- serialize i1 arr x1
86-- pure i2
87-- :}
88--
89class Serialize a where
90 -- | Get the 'Size', in bytes, reqired to store the serialized
91 -- representation of the type. Size cannot be zero.
92 size :: Size a
94 -- We can implement the following functions without returning the `Int`
95 -- offset but that may require traversing the Haskell structure again to get
96 -- the size. Therefore, this is a performance optimization.
98 -- | Deserialize a value from the given byte-index in the array. Returns a
99 -- tuple of the next byte-index and the deserialized value.
100 deserialize :: Int -> MutableByteArray -> IO (Int, a)
102 -- | Write the serialized representation of the value in the array at the
103 -- given byte-index. Returns the next byte-index.
104 serialize :: Int -> MutableByteArray -> a -> IO Int
106--------------------------------------------------------------------------------
107-- Instances
108--------------------------------------------------------------------------------
110#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \
111instance Serialize _type where \
112; {-# INLINE size #-} \
113; size = ConstSize $ Unbox.sizeOf (Proxy :: Proxy _type) \
114; {-# INLINE deserialize #-} \
115; deserialize off arr = \
116 Unbox.peekByteIndex off arr >>= \
117 \val -> let sz = Unbox.sizeOf (Proxy :: Proxy _type) \
118 in pure (off + sz, val) \
119; {-# INLINE serialize #-} \
120; serialize off arr val = \
121 Unbox.pokeByteIndex off arr val \
122 >> let sz = Unbox.sizeOf (Proxy :: Proxy _type) \
123 in pure (off + sz)
125DERIVE_SERIALIZE_FROM_UNBOX(Bool)
126DERIVE_SERIALIZE_FROM_UNBOX(Char)
127DERIVE_SERIALIZE_FROM_UNBOX(Int8)
128DERIVE_SERIALIZE_FROM_UNBOX(Int16)
129DERIVE_SERIALIZE_FROM_UNBOX(Int32)
130DERIVE_SERIALIZE_FROM_UNBOX(Int)
131DERIVE_SERIALIZE_FROM_UNBOX(Int64)
132DERIVE_SERIALIZE_FROM_UNBOX(Word)
133DERIVE_SERIALIZE_FROM_UNBOX(Word8)
134DERIVE_SERIALIZE_FROM_UNBOX(Word16)
135DERIVE_SERIALIZE_FROM_UNBOX(Word32)
136DERIVE_SERIALIZE_FROM_UNBOX(Word64)
137DERIVE_SERIALIZE_FROM_UNBOX(Double)
138DERIVE_SERIALIZE_FROM_UNBOX(Float)
139DERIVE_SERIALIZE_FROM_UNBOX((StablePtr a))
140DERIVE_SERIALIZE_FROM_UNBOX((Ptr a))
141DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))
143instance forall a. Serialize a => Serialize [a] where
145 {-# INLINE size #-}
146 size = VarSize $ \lst ->
147 case size :: Size a of
148 VarSize f ->
149 foldl'
150 (\acc x -> acc + f x)
151 (Unbox.sizeOf (Proxy :: Proxy Int))
152 lst
153 ConstSize sz ->
154 length lst
155 * sz
156 + Unbox.sizeOf (Proxy :: Proxy Int)
158 {-# INLINE deserialize #-}
159 deserialize off arr = do
160 len <- Unbox.peekByteIndex off arr :: IO Int
161 let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int)
162 let peekList buf o 0 = pure (o, reverse buf)
163 peekList buf o i = do
164 (o1, x) <- deserialize o arr
165 peekList (x:buf) o1 (i - 1)
166 peekList [] off1 len
168 {-# INLINE serialize #-}
169 serialize off arr val = do
170 void $ serialize off arr (length val)
171 let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int)
172 let pokeList o [] = pure o
173 pokeList o (x:xs) = do
174 o1 <- serialize o arr x
175 pokeList o1 xs
176 pokeList off1 val
178--------------------------------------------------------------------------------
179-- High level functions
180--------------------------------------------------------------------------------
182{-# INLINE encodeAs #-}
183encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8
184encodeAs ps a =
185 unsafeInlineIO $ do
186 let len =
187 case size :: Size a of
188 ConstSize sz -> sz
189 VarSize f -> f a
190 -- We encode the length of the encoding as a header hence the 8 extra
191 -- bytes to encode Int64
192 mbarr <- Unbox.newBytesAs ps (8 + len)
193 off1 <- serialize 0 mbarr (fromIntegral len :: Int64)
194 off2 <- serialize off1 mbarr a
195 assertM(off2 == len + off1)
196 pure $ Array mbarr 0 len
198{-# INLINE encode #-}
199encode :: Serialize a => a -> Array Word8
200encode = encodeAs Unpinned
202{-# INLINE pinnedEncode #-}
203pinnedEncode :: Serialize a => a -> Array Word8
204pinnedEncode = encodeAs Pinned
206{-# INLINE decode #-}
207decode :: Serialize a => Array Word8 -> a
208decode arr@(Array {..}) = unsafeInlineIO $ do
209 let lenArr = Array.length arr
210 (off1, lenEncoding :: Int64) <- deserialize 0 arrContents
211 (off2, val) <- deserialize off1 arrContents
212 assertM(fromIntegral lenEncoding + off1 == off2)
213 assertM(lenArr == off2)
214 pure val