git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on master help sign in
rowtype-yoga/purescript-arraybuffer-builder/src/Data/ArrayBuffer/Internal.purs
368 lines 13 kB history raw
1-- | Internal module.
2-- |
3-- | You probably don’t want to import anything from this module.
4-- |
5-- | ## Implementation Details
6-- |
7-- | We want our `Builder` to be a data structure with
8-- | * *O(1)* monoid append
9-- | * *O(n)* fold
10-- |
11-- | Our `Builder` implementation is an unbalanced binary tree.
12-- |
13-- | For monoid `append`, what we actually get is *O(1)* when either the
14-- | left or right tree is a singleton. If that's not true, then in the
15-- | unlikely worst case `append` might be *O(n)*.
16-- |
17-- | `Builder` is optimized for what we consider to be normal usage, that is,
18-- | `snoc`ing singleton elements to the end of the `Builder`.
19-- |
20-- | If a Builder is built entirely by `snoc`ing, it will look like a
21-- | left-only binary tree, a.k.a. a linked list.
22-- |
23-- | ```
24-- | ④
25-- | ╱
26-- | ③
27-- | ╱
28-- | ②
29-- | ╱
30-- | ①
31-- | ```
32-- |
33-- | If two of these `snoc`-built trees are `append`ed, then the new tree
34-- | will look like
35-- |
36-- | ```
37-- | ④
38-- | ╱ ╲
39-- | ③ ⑧
40-- | ╱ ╱
41-- | ② ⑦
42-- | ╱ ╱
43-- | ① ⑥
44-- | ╱
45-- | ⑤
46-- | ```
47-- |
48-- | This is all similar to
49-- | [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
50-- | , except that the
51-- | [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
52-- | structure in __bytestring-tree-builder__ only carries values in its
53-- | leaves, which is how it achieves consistent *O(1)* appending, at the cost of
54-- | a higher coefficient time factor on the fold.
55-- |
56-- | We hope that this implementation is fairly fast, since it is similar to
57-- | __bytestring-tree-builder__
58-- | which “according to the benchmarks … beats all the alternatives.”
59-- | However, we
60-- | haven’t chosen this implementation because it’s fast, we've chosen
61-- | this implementation because it’s simple.
62-- | If someone wants to create a fast PureScript `ArrayBuffer` serialization
63-- | library, then they can benchmark against this one to prove that the new
64-- | one is fast.
65-- |
66-- | One relatively cheap and simple performance improvement for this library would be to
67-- | remove the `Null` constructor of `Builder` and instead use Javascript nulls?
68-- |
69-- | In the longer term, it might make sense to try to change the `Builder` so
70-- | that it works like the
71-- | https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html .
72-- | That’s the approach taken by
73-- | https://pursuit.purescript.org/packages/purescript-dynamic-buffers .
74-- |
75-- | Here are some benchmarks of different Haskell ByteString builders
76-- | https://github.com/haskell-perf/strict-bytestring-builders
77-- |
78-- | We've tried to design the API for this library with minimal assumptions,
79-- | so that if we want to change the `Builder` implementation later then we can.
80-- |
81module Data.ArrayBuffer.Builder.Internal
82 ( Builder(..)
83 , (<>>)
84 , DataBuff(..)
85 , toView
86 , execBuilder
87 , length
88 , foldl
89 , foldM
90 , singleton
91 , cons
92 , snoc
93 , encodeUint8
94 , encodeInt8
95 , encodeUint16be
96 , encodeUint16le
97 , encodeInt16be
98 , encodeInt16le
99 , encodeUint32be
100 , encodeUint32le
101 , encodeInt32be
102 , encodeInt32le
103 , encodeFloat32be
104 , encodeFloat32le
105 , encodeFloat64be
106 , encodeFloat64le
107 ) where
109import Prelude
111import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
112import Data.ArrayBuffer.ArrayBuffer as AB
113import Data.ArrayBuffer.DataView as DV
114import Data.ArrayBuffer.Typed as AT
115import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
116import Data.Float32 (Float32)
117import Data.Identity (Identity)
118import Data.List (List(..), uncons, (:))
119import Data.Maybe (Maybe(..))
120import Data.Newtype (unwrap)
121import Data.UInt (UInt)
122import Effect (Effect)
123import Effect.Class (class MonadEffect, liftEffect)
125-- | For distinguishing between `ArrayBuffer` and `DataView`.
126data DataBuff
127 = Buff ArrayBuffer
128 | View DataView
130-- Concerning DataViews.
131-- https://v8.dev/blog/dataview
133-- | View the contents of `DataBuff` as a `DataView`.
134toView :: DataBuff -> DataView
135toView (Buff ab) = DV.whole ab
136toView (View dv) = dv
138-- | Monoidal builder for `ArrayBuffer`s.
139-- |
140-- | We can add two types of things to the `Builder`:
141-- | 1. `ArrayBuffer`
142-- | 2. `DataView`
143-- |
144-- | We might prefer
145-- | to add a `DataView` to a `Builder` when we’re adding a large slice of data
146-- | from some other `ArrayBuffer`, so that we don’t
147-- | need an extra intermediate copy of the slice.
148data Builder
149 = Node Builder DataBuff Builder
150 | Null
152-- | ### Left-associative `<>>` append operator
153-- |
154-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
155-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
156-- |
157-- | The `Builder` monoid in this library is efficient when we `snoc` single
158-- | items onto the end of it, or when we only `cons` single items to the
159-- | beginning, but it can be less efficient when we are mixing `cons` and
160-- | `snoc`.
161-- | Most of the time we want to `snoc`, but the `Semigroup` append
162-- | operator `<>` is right-associative,
163-- | which means it chains like `cons`.
164-- |
165-- | To solve this, we provide an operator `<>>` for appending `Builders`.
166-- | `<>>` is exactly the same as `<>`, but left-associative,
167-- | which means it chains like `snoc`.
168-- |
169-- | This __only matters__ when we're chaining together three
170-- | or more `Builder`s in a single associative expression.
171-- | Instead of
172-- | ```
173-- | builder₁ <> builder₂ <> builder₃
174-- | ```
175-- | we should always prefer to
176-- | write
177-- | ```
178-- | builder₁ <>> builder₂ <>> builder₃
179-- | ```
180-- | so that we get the efficient
181-- | `snoc`ing of `Builder`s.
182-- |
183-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
184-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
185-- | `snoc` case.
186-- |
187instance semigroupBuilder :: Semigroup Builder where
188 append Null Null = Null
189 append l Null = l
190 append Null r = r
191 append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
192 append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
193 -- of the left tree
194 append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
196-- side of the left tree
197-- to find the rightmost
198-- Null
200infixl 5 append as <>>
202instance monoidBuilder :: Monoid Builder where
203 mempty = Null
205-- | Stack-safe `foldl` over a `Builder`. *O(n)*
206foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a
207foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b
209-- | Stack-safe `foldM` over a `Builder`. *O(n)*.
210foldM :: forall m a. MonadRec m => (a -> DataBuff -> m a) -> a -> Builder -> m a
211-- The Art of Computer Programming 2.3.1
212-- Inorder traversal using a stack
213-- https://yuyuan.org/MorrisAlgorithm/
214foldM f a0 b = tailRecM outer { p: b, stack: Nil, accum: a0 }
215 where
216 outer { p, stack, accum } = do
217 stack' <- tailRecM inner { p_: p, stack_: stack }
218 case uncons stack' of
219 Nothing -> pure $ Done accum
220 Just { head: Node _ x r, tail } -> do
221 accum' <- f accum x
222 pure $ Loop { p: r, stack: tail, accum: accum' }
223 Just { head: Null } -> pure $ Done accum
224 inner { p_: Null, stack_ } = pure $ Done stack_
225 inner { p_: n@(Node l _ _), stack_ } = pure $ Loop { p_: l, stack_: n : stack_ }
227-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
228singleton :: DataBuff -> Builder
229singleton buf = Node Null buf Null
231-- | Calculate the total byte length of the `Builder`, without actually
232-- | building it yet. *O(n)*
233length :: Builder -> ByteLength
234length bldr = foldl (\b a -> b + len a) 0 bldr
235 where
236 len (Buff ab) = AB.byteLength ab
237 len (View dv) = DV.byteLength dv
239-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
240cons :: DataBuff -> Builder -> Builder
241cons x bs = Node Null x bs
243-- | Append a `DataBuff` to the end of the `Builder`. *O(1)*
244snoc :: Builder -> DataBuff -> Builder
245snoc bs x = Node bs x Null
247-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
248execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer
249execBuilder bldr = do
250 let buflen = length bldr
251 -- Allocate the final ArrayBuffer
252 buf <- liftEffect $ AB.empty buflen
253 -- Then copy each ArrayBuffer into the final ArrayBuffer.
254 -- To memcpy from one ArrayBuffer to another, apparently we have to first view
255 -- both ArrayBuffers as ArrayView (Typed Array).
256 newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
257 _ <- foldM
258 ( \offset a -> do
259 aview <- liftEffect $ toUint8Array a
260 _ <- liftEffect $ AT.setTyped newview (Just offset) aview
261 pure $ offset + AT.byteLength aview
262 )
263 0
264 bldr
265 pure buf
266 where
267 toUint8Array :: DataBuff -> Effect Uint8Array
268 toUint8Array (Buff ab) = AT.whole ab
269 toUint8Array (View dv) =
270 AT.part (DV.buffer dv) (DV.byteOffset dv) (DV.byteLength dv)
272-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
273encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
274encodeUint8 x = do
275 buf <- liftEffect $ AB.empty 1
276 _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
277 pure buf
279-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
280encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
281encodeInt8 x = do
282 buf <- liftEffect $ AB.empty 1
283 _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
284 pure buf
286-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
287encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
288encodeUint16be x = do
289 buf <- liftEffect $ AB.empty 2
290 _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
291 pure buf
293-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
294encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
295encodeUint16le x = do
296 buf <- liftEffect $ AB.empty 2
297 _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
298 pure buf
300-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
301encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
302encodeInt16be x = do
303 buf <- liftEffect $ AB.empty 2
304 _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
305 pure buf
307-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
308encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
309encodeInt16le x = do
310 buf <- liftEffect $ AB.empty 2
311 _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
312 pure buf
314-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
315encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
316encodeUint32be x = do
317 buf <- liftEffect $ AB.empty 4
318 _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
319 pure buf
321-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
322encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
323encodeUint32le x = do
324 buf <- liftEffect $ AB.empty 4
325 _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
326 pure buf
328-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
329encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
330encodeInt32be x = do
331 buf <- liftEffect $ AB.empty 4
332 _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
333 pure buf
335-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
336encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
337encodeInt32le x = do
338 buf <- liftEffect $ AB.empty 4
339 _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
340 pure buf
342-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
343encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
344encodeFloat32be x = do
345 buf <- liftEffect $ AB.empty 4
346 _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
347 pure buf
349-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
350encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
351encodeFloat32le x = do
352 buf <- liftEffect $ AB.empty 4
353 _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
354 pure buf
356-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
357encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
358encodeFloat64be x = do
359 buf <- liftEffect $ AB.empty 8
360 _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
361 pure buf
363-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
364encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
365encodeFloat64le x = do
366 buf <- liftEffect $ AB.empty 8
367 _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
368 pure buf