@@ -1,368 +0,0 @@
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−-- |
81−module 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
108−
109−import Prelude
110−
111−import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
112−import Data.ArrayBuffer.ArrayBuffer as AB
113−import Data.ArrayBuffer.DataView as DV
114−import Data.ArrayBuffer.Typed as AT
115−import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
116−import Data.Float32 (Float32)
117−import Data.Identity (Identity)
118−import Data.List (List(..), uncons, (:))
119−import Data.Maybe (Maybe(..))
120−import Data.Newtype (unwrap)
121−import Data.UInt (UInt)
122−import Effect (Effect)
123−import Effect.Class (class MonadEffect, liftEffect)
124−
125−-- | For distinguishing between `ArrayBuffer` and `DataView`.
126−data DataBuff
127− = Buff ArrayBuffer
128− | View DataView
129−
130−-- Concerning DataViews.
131−-- https://v8.dev/blog/dataview
132−
133−-- | View the contents of `DataBuff` as a `DataView`.
134−toView :: DataBuff -> DataView
135−toView (Buff ab) = DV.whole ab
136−toView (View dv) = dv
137−
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.
148−data Builder
149− = Node Builder DataBuff Builder
150− | Null
151−
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−-- |
187−instance 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
195−
196−-- side of the left tree
197−-- to find the rightmost
198−-- Null
199−
200−infixl 5 append as <>>
201−
202−instance monoidBuilder :: Monoid Builder where
203− mempty = Null
204−
205−-- | Stack-safe `foldl` over a `Builder`. *O(n)*
206−foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a
207−foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b
208−
209−-- | Stack-safe `foldM` over a `Builder`. *O(n)*.
210−foldM :: 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/
214−foldM 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_ }
226−
227−-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
228−singleton :: DataBuff -> Builder
229−singleton buf = Node Null buf Null
230−
231−-- | Calculate the total byte length of the `Builder`, without actually
232−-- | building it yet. *O(n)*
233−length :: Builder -> ByteLength
234−length 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
238−
239−-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
240−cons :: DataBuff -> Builder -> Builder
241−cons x bs = Node Null x bs
242−
243−-- | Append a `DataBuff` to the end of the `Builder`. *O(1)*
244−snoc :: Builder -> DataBuff -> Builder
245−snoc bs x = Node bs x Null
246−
247−-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
248−execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer
249−execBuilder 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)
271−
272−-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
273−encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
274−encodeUint8 x = do
275− buf <- liftEffect $ AB.empty 1
276− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
277− pure buf
278−
279−-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
280−encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
281−encodeInt8 x = do
282− buf <- liftEffect $ AB.empty 1
283− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
284− pure buf
285−
286−-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
287−encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
288−encodeUint16be x = do
289− buf <- liftEffect $ AB.empty 2
290− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
291− pure buf
292−
293−-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
294−encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
295−encodeUint16le x = do
296− buf <- liftEffect $ AB.empty 2
297− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
298− pure buf
299−
300−-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
301−encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
302−encodeInt16be x = do
303− buf <- liftEffect $ AB.empty 2
304− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
305− pure buf
306−
307−-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
308−encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
309−encodeInt16le x = do
310− buf <- liftEffect $ AB.empty 2
311− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
312− pure buf
313−
314−-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
315−encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
316−encodeUint32be x = do
317− buf <- liftEffect $ AB.empty 4
318− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
319− pure buf
320−
321−-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
322−encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
323−encodeUint32le x = do
324− buf <- liftEffect $ AB.empty 4
325− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
326− pure buf
327−
328−-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
329−encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
330−encodeInt32be x = do
331− buf <- liftEffect $ AB.empty 4
332− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
333− pure buf
334−
335−-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
336−encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
337−encodeInt32le x = do
338− buf <- liftEffect $ AB.empty 4
339− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
340− pure buf
341−
342−-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
343−encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
344−encodeFloat32be x = do
345− buf <- liftEffect $ AB.empty 4
346− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
347− pure buf
348−
349−-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
350−encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
351−encodeFloat32le x = do
352− buf <- liftEffect $ AB.empty 4
353− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
354− pure buf
355−
356−-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
357−encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
358−encodeFloat64be x = do
359− buf <- liftEffect $ AB.empty 8
360− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
361− pure buf
362−
363−-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
364−encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
365−encodeFloat64le x = do
366− buf <- liftEffect $ AB.empty 8
367− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
368− pure buf