git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on master help sign in
Internal module
commit58bd806ba64bd778414d218d90d82237091d0935 authorJames Brock <jamesbrock@gmail.com> dateThu 6 May 2021, 15:13 (5 years ago) parent74cee89
3 files changed+403−369
src/Data/ArrayBuffer/Builder.purs+29−364 src/Data/ArrayBuffer/Internal.purs+367 test/Main.purs+7−5
src/Data/ArrayBuffer/Builder.purs+29−364
@@ -31,47 +31,26 @@ module Data.ArrayBuffer.Builder
3131, putFloat32le
3232, putFloat64be
3333, putFloat64le
34−, Builder
35−, (<>>)
36−, Bytes
37−, toView
38−, execBuilder
39−, length
40−, singleton
41−, singleton_
42−, cons
43−, cons_
44−, snoc
45−, snoc_
46−, encodeUint8
47−, encodeInt8
48−, encodeUint16be
49−, encodeUint16le
50−, encodeInt16be
51−, encodeInt16le
52−, encodeUint32be
53−, encodeUint32le
54−, encodeInt32be
55−, encodeInt32le
56−, encodeFloat32be
57−, encodeFloat32le
58−, encodeFloat64be
59−, encodeFloat64le
34+, module Data.ArrayBuffer.Builder.Internal
6035)
6136where
6237
38+import Data.ArrayBuffer.Builder.Internal
39+ ( Builder
40+ , (<>>)
41+ , length
42+ )
43+
44+import Data.ArrayBuffer.Builder.Internal as Internal
45+
6346import Prelude
6447
6548import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
66−import Data.ArrayBuffer.ArrayBuffer as AB
67−import Data.ArrayBuffer.DataView as DV
68−import Data.ArrayBuffer.Typed as AT
69−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, DataView, ByteLength)
49+import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
7050import Data.Float32 (Float32)
71−import Data.Maybe (Maybe(..))
7251import Data.UInt (UInt)
7352import Effect (Effect)
74−import Effect.Class (class MonadEffect, liftEffect)
53+import Effect.Class (class MonadEffect)
7554
7655-- | The `PutM` monad is a `WriterT Builder` transformer monad which
7756-- | gives us do-notation for the `Builder` monoid. The base monad must be
@@ -84,149 +63,11 @@ type PutM = WriterT Builder
8463-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
8564type Put = PutM Effect
8665
87−-- | Monoidal builder for `ArrayBuffer`s.
88−-- |
89−-- | We can add two types of things to the `Builder`: `ArrayBuffer`s and
90−-- | `DataView`s.
91−-- | We might prefer
92−-- | to add a `DataView` to a `Builder` when we’re adding a large slice of data
93−-- | from some other `ArrayBuffer`, so that we don’t
94−-- | need an extra intermediate copy of the slice.
95−-- | Our convention is that functions which add `DataView`s to
96−-- | the `Builder` are suffixed with underscore (`_`).
97−-- |
98−-- | ### Left-associative `<>>` append operator
99−-- |
100−-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
101−-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
102−-- |
103−-- | The `Builder` monoid in this library is efficient when we `snoc` single
104−-- | items onto the end of it, or when we only `cons` single items to the
105−-- | beginning, but it can be less efficient when we are mixing `cons` and
106−-- | `snoc`.
107−-- | This matters when we're appending three or more `Builder`s
108−-- | in one associative expression, because the
109−-- | `Semigroup` append operator `<>` is right-associative.
110−-- |
111−-- | To solve this, we provide an operator `<>>` for appending `Builders`.
112−-- | `<>>` is exactly the same as `<>`, but left-associative.
113−-- | This only matters when we're chaining together three
114−-- | or more `Builder`s in a single associative expression.
115−-- | Instead of
116−-- | ```
117−-- | builder₁ <> builder₂ <> builder₃
118−-- | ```
119−-- | we should always prefer to
120−-- | write
121−-- | ```
122−-- | builder₁ <>> builder₂ <>> builder₃
123−-- | ```
124−-- | so that we get the efficient
125−-- | `snoc`ing of `Builder`s.
126−-- |
127−-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
128−-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
129−-- | `snoc` case.
130−-- |
131−data Builder
132− = Node Builder Bytes Builder
133− | Null
134−
135−instance semigroupBuilder :: Semigroup Builder where
136− append Null Null = Null
137− append l Null = l
138− append Null r = r
139− append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
140− append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
141− -- of the left tree
142− append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
143− -- side of the left tree
144− -- to find the rightmost
145− -- Null
146−
147−infixl 5 append as <>>
148−
149−instance monoidBuilder :: Monoid Builder where
150− mempty = Null
151−
152−-- | For distinguishing between `ArrayBuffer` and `DataView`.
153−data Bytes
154− = ByteBuff ArrayBuffer
155− | ByteView DataView
156−
157−toView :: Bytes -> DataView
158−toView (ByteBuff ab) = DV.whole ab
159−toView (ByteView dv) = dv
160−
161−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
162−foldl :: forall b. (b -> Bytes -> b) -> b -> Builder -> b
163−foldl _ a Null = a
164−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
165−
166−-- | Monomorphic foldM copied from
167−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
168−foldM :: forall b m. (Monad m) => (b -> Bytes -> m b) -> b -> Builder -> m b
169−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
170−
171−-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
172−singleton :: ArrayBuffer -> Builder
173−singleton buf = Node Null (ByteBuff buf) Null
174−
175−-- | Construct a `Builder` with a single `DataView`. *O(1)*
176−singleton_ :: DataView -> Builder
177−singleton_ buf = Node Null (ByteView buf) Null
178−
179−-- | Prepend an `ArrayBuffer` to the beginning of the `Builder`. *O(1)*
180−cons :: ArrayBuffer -> Builder -> Builder
181−cons x bs = Node Null (ByteBuff x) bs
182−
183−-- | Prepend a `DataView` to the beginning of the `Builder`. *O(1)*
184−cons_ :: DataView -> Builder -> Builder
185−cons_ x bs = Node Null (ByteView x) bs
186−
187−-- | Append an `ArrayBuffer` to the end of the `Builder`. *O(1)*
188−snoc :: Builder -> ArrayBuffer -> Builder
189−snoc bs x = Node bs (ByteBuff x) Null
190−
191−-- | Append a `DataView` to the end of the `Builder`. *O(1)*
192−snoc_ :: Builder -> DataView -> Builder
193−snoc_ bs x = Node bs (ByteView x) Null
194−
195−-- | Calculate the total byte length of the `Builder`. *O(n)*
196−length :: Builder -> ByteLength
197−length bldr = foldl (\b a -> b + len a) 0 bldr
198− where
199− len (ByteBuff ab) = AB.byteLength ab
200− len (ByteView dv) = DV.byteLength dv
201−
202−-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
203−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
204−execBuilder bldr = do
205− let buflen = length bldr
206− -- Allocate the final ArrayBuffer
207− buf <- liftEffect $ AB.empty buflen
208− -- Then copy each ArrayBuffer into the final ArrayBuffer.
209− -- To memcpy from one ArrayBuffer to another, apparently we have to first view
210− -- both ArrayBuffers as ArrayView (Typed Array).
211− newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
212− _ <- foldM
213− ( \offset a -> do
214− aview <- liftEffect $ toUint8Array a
215− _ <- liftEffect $ AT.setTyped newview (Just offset) aview
216− pure $ offset + AT.byteLength aview
217− ) 0 bldr
218− pure buf
219− where
220− toUint8Array :: Bytes -> Effect Uint8Array
221− toUint8Array (ByteBuff ab) = AT.whole ab
222− toUint8Array (ByteView dv) =
223− AT.part (DV.buffer dv) (DV.byteOffset dv) (DV.byteLength dv)
224−
22566-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
22667execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
227−execPutM = execBuilder <=< execWriterT
68+execPutM = Internal.execBuilder <=< execWriterT
22869
229−-- | Build an `ArrayBuffer` with do-notation. *O(n)*
70+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)*
23071execPut :: Put Unit -> Effect ArrayBuffer
23172execPut = execPutM
23273
@@ -239,7 +80,6 @@ execPut = execPutM
23980-- |
24081-- | In a `PutM` monad do-block, we can
24182-- |
242−-- |
24383-- | ```
24484-- | do
24585-- | messageBuilder <- subBuilder $ do
@@ -254,239 +94,64 @@ subBuilder = lift <<< execWriterT
25494
25595-- | Append an `ArrayBuffer` to the builder.
25696putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
257−putArrayBuffer = tell <<< singleton
97+putArrayBuffer = tell <<< Internal.singleton
25898
25999-- | Append a `DataView` to the builder.
260100putDataView :: forall m. (MonadEffect m) => DataView -> PutM m Unit
261−putDataView = tell <<< singleton_
262−
263−-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
264−encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
265−encodeUint8 x = do
266− buf <- liftEffect $ AB.empty 1
267− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
268− pure buf
101+putDataView = tell <<< Internal.singleton_
269102
270103-- | Append an 8-bit unsigned integer (byte) to the builder.
271104putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
272−putUint8 = putArrayBuffer <=< encodeUint8
273−
274−-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
275−encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
276−encodeInt8 x = do
277− buf <- liftEffect $ AB.empty 1
278− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
279− pure buf
105+putUint8 = putArrayBuffer <=< Internal.encodeUint8
280106
281107-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
282108putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
283−putInt8 = putArrayBuffer <=< encodeInt8
284−
285−-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
286−encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
287−encodeUint16be x = do
288− buf <- liftEffect $ AB.empty 2
289− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
290− pure buf
109+putInt8 = putArrayBuffer <=< Internal.encodeInt8
291110
292111-- | Append a 16-bit big-endian unsigned integer to the builder.
293112putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
294−putUint16be = putArrayBuffer <=< encodeUint16be
295−
296−-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
297−encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
298−encodeUint16le x = do
299− buf <- liftEffect $ AB.empty 2
300− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
301− pure buf
113+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
302114
303115-- | Append a 16-bit little-endian unsigned integer to the builder.
304116putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
305−putUint16le = putArrayBuffer <=< encodeUint16le
306−
307−-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
308−encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
309−encodeInt16be x = do
310− buf <- liftEffect $ AB.empty 2
311− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
312− pure buf
117+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
313118
314119-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
315120putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
316−putInt16be = putArrayBuffer <=< encodeInt16be
317−
318−-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
319−encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
320−encodeInt16le x = do
321− buf <- liftEffect $ AB.empty 2
322− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
323− pure buf
121+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
324122
325123-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
326124putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
327−putInt16le = putArrayBuffer <=< encodeInt16le
328−
329−-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
330−encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
331−encodeUint32be x = do
332− buf <- liftEffect $ AB.empty 4
333− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
334− pure buf
125+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
335126
336127-- | Append a 32-bit big-endian unsigned integer to the builder.
337128putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
338−putUint32be = putArrayBuffer <=< encodeUint32be
339−
340−-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
341−encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
342−encodeUint32le x = do
343− buf <- liftEffect $ AB.empty 4
344− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
345− pure buf
129+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
346130
347131-- | Append a 32-bit little-endian unsigned integer to the builder.
348132putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
349−putUint32le = putArrayBuffer <=< encodeUint32le
350−
351−-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
352−encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
353−encodeInt32be x = do
354− buf <- liftEffect $ AB.empty 4
355− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
356− pure buf
133+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
357134
358135-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
359136putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
360−putInt32be = putArrayBuffer <=< encodeInt32be
361−
362−-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
363−encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
364−encodeInt32le x = do
365− buf <- liftEffect $ AB.empty 4
366− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
367− pure buf
137+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
368138
369139-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
370140putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
371−putInt32le = putArrayBuffer <=< encodeInt32le
372−
373−-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
374−encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
375−encodeFloat32be x = do
376− buf <- liftEffect $ AB.empty 4
377− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
378− pure buf
141+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
379142
380143-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
381144putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
382−putFloat32be = putArrayBuffer <=< encodeFloat32be
383−
384−-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
385−encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
386−encodeFloat32le x = do
387− buf <- liftEffect $ AB.empty 4
388− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
389− pure buf
145+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
390146
391147-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
392148putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
393−putFloat32le = putArrayBuffer <=< encodeFloat32le
394−
395−-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
396−encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
397−encodeFloat64be x = do
398− buf <- liftEffect $ AB.empty 8
399− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
400− pure buf
149+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
401150
402151-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
403152putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
404−putFloat64be = putArrayBuffer <=< encodeFloat64be
405−
406−-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
407−encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
408−encodeFloat64le x = do
409− buf <- liftEffect $ AB.empty 8
410− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
411− pure buf
153+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
412154
413155-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
414156putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
415−putFloat64le = putArrayBuffer <=< encodeFloat64le
416−
417−
418−-- ## Implementation Details
419−--
420−-- We want our `Builder` to be a data structure with
421−-- * *O(1)* monoid append
422−-- * *O(n)* fold
423−--
424−-- Our `Builder` implementation is an unbalanced binary tree.
425−--
426−-- For monoid `append`, what we actually get is *O(1)* when either the
427−-- left or right tree is a singleton. If that's not true, then in the
428−-- unlikely worst case `append` might be *O(n)*.
429−--
430−-- `Builder` is optimized for what we consider to be normal usage, that is,
431−-- `snoc`ing singleton elements to the end of the `Builder`.
432−--
433−-- If a Builder is built entirely by `snoc`ing, it will look like a
434−-- left-only binary tree, a.k.a. a linked list.
435−--
436−-- ```
437−-- ④
438−-- ╱
439−-- ③
440−-- ╱
441−-- ②
442−-- ╱
443−-- ①
444−-- ```
445−--
446−-- If two of these `snoc`-built trees are `append`ed, then the new tree
447−-- will look like
448−--
449−-- ```
450−-- ④
451−-- ╱ ╲
452−-- ③ ⑧
453−-- ╱ ╱
454−-- ② ⑦
455−-- ╱ ╱
456−-- ① ⑥
457−-- ╱
458−-- ⑤
459−-- ```
460−--
461−-- This is all similar to
462−-- [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
463−-- , except that the
464−-- [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
465−-- structure in __bytestring-tree-builder__ only carries values in its
466−-- leaves, which is how it achieves *O(1)* appending, at the cost of
467−-- a higher coefficient time factor on the fold.
468−--
469−-- We hope that this implementation is fairly fast, but we
470−-- haven't chosen this implementation because it's fast, we've chosen
471−-- this implementation because it's simple.
472−-- If someone wants to create a fast Purescript ArrayBuffer serialization
473−-- library, then they can benchmark against this one to prove that the new
474−-- one is fast.
475−--
476−-- One relatively cheap and simple performance improvement for this library would be to
477−-- remove the Null constructor of `Builder` and instead use Javascript nulls.
478−-- UPDATE Actually no, we need the Null constructor for the Monoid instance.
479−--
480−-- In the longer term, it might make sense to try to change the Builder so
481−-- that it works like the
482−-- https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
483−--
484−-- Here are some benchmarks of different Haskell ByteString builders
485−-- https://github.com/haskell-perf/strict-bytestring-builders
486−--
487−-- We've tried to design the API for this library with minimal assumptions,
488−-- so that if we want to change the Builder implementation later then we can.
489−--
490−-- Another way this could go:
491−-- https://kodimensional.dev/posts/2019-03-25-comonadic-builders
492−
157+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
src/Data/ArrayBuffer/Internal.pursnew file+367
@@ -0,0 +1,367 @@
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+-- | __UPDATE__ Actually no, we need the Null constructor for the Monoid instance.
69+-- |
70+-- | In the longer term, it might make sense to try to change the `Builder` so
71+-- | that it works like the
72+-- | https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
73+-- |
74+-- | Here are some benchmarks of different Haskell ByteString builders
75+-- | https://github.com/haskell-perf/strict-bytestring-builders
76+-- |
77+-- | We've tried to design the API for this library with minimal assumptions,
78+-- | so that if we want to change the `Builder` implementation later then we can.
79+-- |
80+-- | Another way this could go:
81+-- | https://kodimensional.dev/posts/2019-03-25-comonadic-builders
82+-- |
83+-- | Our convention is that functions which add `DataView`s to
84+-- | the `Builder` are suffixed with underscore (`_`).
85+-- |
86+module Data.ArrayBuffer.Builder.Internal
87+( Builder(..)
88+, (<>>)
89+, Bytes(..)
90+, toView
91+, execBuilder
92+, length
93+, foldl
94+, foldM
95+, singleton
96+, singleton_
97+, cons
98+, cons_
99+, snoc
100+, snoc_
101+, encodeUint8
102+, encodeInt8
103+, encodeUint16be
104+, encodeUint16le
105+, encodeInt16be
106+, encodeInt16le
107+, encodeUint32be
108+, encodeUint32le
109+, encodeInt32be
110+, encodeInt32le
111+, encodeFloat32be
112+, encodeFloat32le
113+, encodeFloat64be
114+, encodeFloat64le
115+)
116+where
117+
118+import Prelude
119+
120+import Data.ArrayBuffer.ArrayBuffer as AB
121+import Data.ArrayBuffer.DataView as DV
122+import Data.ArrayBuffer.Typed as AT
123+import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
124+import Data.Float32 (Float32)
125+import Data.Maybe (Maybe(..))
126+import Data.UInt (UInt)
127+import Effect (Effect)
128+import Effect.Class (class MonadEffect, liftEffect)
129+
130+-- | Monoidal builder for `ArrayBuffer`s.
131+-- |
132+-- | We can add two types of things to the `Builder`:
133+-- | 1. `ArrayBuffer`
134+-- | 2. `DataView`
135+-- |
136+-- | We might prefer
137+-- | to add a `DataView` to a `Builder` when we’re adding a large slice of data
138+-- | from some other `ArrayBuffer`, so that we don’t
139+-- | need an extra intermediate copy of the slice.
140+data Builder
141+ = Node Builder Bytes Builder
142+ | Null
143+
144+-- | ### Left-associative `<>>` append operator
145+-- |
146+-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
147+-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
148+-- |
149+-- | The `Builder` monoid in this library is efficient when we `snoc` single
150+-- | items onto the end of it, or when we only `cons` single items to the
151+-- | beginning, but it can be less efficient when we are mixing `cons` and
152+-- | `snoc`.
153+-- | Most of the time we want to `snoc`, but the `Semigroup` append
154+-- | operator `<>` is right-associative,
155+-- | which means it chains like `cons`.
156+-- |
157+-- | To solve this, we provide an operator `<>>` for appending `Builders`.
158+-- | `<>>` is exactly the same as `<>`, but left-associative,
159+-- | which means it chains like `snoc`.
160+-- |
161+-- | This __only matters__ when we're chaining together three
162+-- | or more `Builder`s in a single associative expression.
163+-- | Instead of
164+-- | ```
165+-- | builder₁ <> builder₂ <> builder₃
166+-- | ```
167+-- | we should always prefer to
168+-- | write
169+-- | ```
170+-- | builder₁ <>> builder₂ <>> builder₃
171+-- | ```
172+-- | so that we get the efficient
173+-- | `snoc`ing of `Builder`s.
174+-- |
175+-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
176+-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
177+-- | `snoc` case.
178+-- |
179+instance semigroupBuilder :: Semigroup Builder where
180+ append Null Null = Null
181+ append l Null = l
182+ append Null r = r
183+ append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
184+ append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
185+ -- of the left tree
186+ append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
187+ -- side of the left tree
188+ -- to find the rightmost
189+ -- Null
190+
191+infixl 5 append as <>>
192+
193+instance monoidBuilder :: Monoid Builder where
194+ mempty = Null
195+
196+-- | For distinguishing between `ArrayBuffer` and `DataView`.
197+data Bytes
198+ = ByteBuff ArrayBuffer
199+ | ByteView DataView
200+
201+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
202+foldl :: forall b. (b -> Bytes -> b) -> b -> Builder -> b
203+foldl _ a Null = a
204+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
205+
206+-- | Monomorphic foldM copied from
207+-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
208+foldM :: forall b m. (Monad m) => (b -> Bytes -> m b) -> b -> Builder -> m b
209+foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
210+
211+-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
212+singleton :: ArrayBuffer -> Builder
213+singleton buf = Node Null (ByteBuff buf) Null
214+
215+-- | Construct a `Builder` with a single `DataView`. *O(1)*
216+singleton_ :: DataView -> Builder
217+singleton_ buf = Node Null (ByteView buf) Null
218+
219+-- | Calculate the total byte length of the `Builder`, without actually
220+-- | building it yet. *O(n)*
221+length :: Builder -> ByteLength
222+length bldr = foldl (\b a -> b + len a) 0 bldr
223+ where
224+ len (ByteBuff ab) = AB.byteLength ab
225+ len (ByteView dv) = DV.byteLength dv
226+
227+ -- | View the contents of `Bytes` as a `DataView`.
228+toView :: Bytes -> DataView
229+toView (ByteBuff ab) = DV.whole ab
230+toView (ByteView dv) = dv
231+
232+-- | Prepend an `ArrayBuffer` to the beginning of the `Builder`. *O(1)*
233+cons :: ArrayBuffer -> Builder -> Builder
234+cons x bs = Node Null (ByteBuff x) bs
235+
236+-- | Prepend a `DataView` to the beginning of the `Builder`. *O(1)*
237+cons_ :: DataView -> Builder -> Builder
238+cons_ x bs = Node Null (ByteView x) bs
239+
240+-- | Append an `ArrayBuffer` to the end of the `Builder`. *O(1)*
241+snoc :: Builder -> ArrayBuffer -> Builder
242+snoc bs x = Node bs (ByteBuff x) Null
243+
244+-- | Append a `DataView` to the end of the `Builder`. *O(1)*
245+snoc_ :: Builder -> DataView -> Builder
246+snoc_ bs x = Node bs (ByteView x) Null
247+
248+-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
249+execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
250+execBuilder bldr = do
251+ let buflen = length bldr
252+ -- Allocate the final ArrayBuffer
253+ buf <- liftEffect $ AB.empty buflen
254+ -- Then copy each ArrayBuffer into the final ArrayBuffer.
255+ -- To memcpy from one ArrayBuffer to another, apparently we have to first view
256+ -- both ArrayBuffers as ArrayView (Typed Array).
257+ newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
258+ _ <- foldM
259+ ( \offset a -> do
260+ aview <- liftEffect $ toUint8Array a
261+ _ <- liftEffect $ AT.setTyped newview (Just offset) aview
262+ pure $ offset + AT.byteLength aview
263+ ) 0 bldr
264+ pure buf
265+ where
266+ toUint8Array :: Bytes -> Effect Uint8Array
267+ toUint8Array (ByteBuff ab) = AT.whole ab
268+ toUint8Array (ByteView dv) =
269+ AT.part (DV.buffer dv) (DV.byteOffset dv) (DV.byteLength dv)
270+
271+-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
272+encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
273+encodeUint8 x = do
274+ buf <- liftEffect $ AB.empty 1
275+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
276+ pure buf
277+
278+-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
279+encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
280+encodeInt8 x = do
281+ buf <- liftEffect $ AB.empty 1
282+ _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
283+ pure buf
284+
285+-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
286+encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
287+encodeUint16be x = do
288+ buf <- liftEffect $ AB.empty 2
289+ _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
290+ pure buf
291+
292+-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
293+encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
294+encodeUint16le x = do
295+ buf <- liftEffect $ AB.empty 2
296+ _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
297+ pure buf
298+
299+-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
300+encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
301+encodeInt16be x = do
302+ buf <- liftEffect $ AB.empty 2
303+ _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
304+ pure buf
305+
306+-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
307+encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
308+encodeInt16le x = do
309+ buf <- liftEffect $ AB.empty 2
310+ _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
311+ pure buf
312+
313+-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
314+encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
315+encodeUint32be x = do
316+ buf <- liftEffect $ AB.empty 4
317+ _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
318+ pure buf
319+
320+-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
321+encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
322+encodeUint32le x = do
323+ buf <- liftEffect $ AB.empty 4
324+ _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
325+ pure buf
326+
327+-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
328+encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
329+encodeInt32be x = do
330+ buf <- liftEffect $ AB.empty 4
331+ _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
332+ pure buf
333+
334+-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
335+encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
336+encodeInt32le x = do
337+ buf <- liftEffect $ AB.empty 4
338+ _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
339+ pure buf
340+
341+-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
342+encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
343+encodeFloat32be x = do
344+ buf <- liftEffect $ AB.empty 4
345+ _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
346+ pure buf
347+
348+-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
349+encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
350+encodeFloat32le x = do
351+ buf <- liftEffect $ AB.empty 4
352+ _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
353+ pure buf
354+
355+-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
356+encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
357+encodeFloat64be x = do
358+ buf <- liftEffect $ AB.empty 8
359+ _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
360+ pure buf
361+
362+-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
363+encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
364+encodeFloat64le x = do
365+ buf <- liftEffect $ AB.empty 8
366+ _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
367+ pure buf
test/Main.purs+7−5
@@ -1,14 +1,16 @@
11module Test.Main where
22
3−import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
4−import Data.ArrayBuffer.Types (ArrayBuffer,Uint8Array)
5−import Data.ArrayBuffer.Typed as AT
3+import Data.ArrayBuffer.Builder
4+
5+import Control.Monad.Writer.Trans (tell)
6+import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, singleton_, (<>>))
67import Data.ArrayBuffer.DataView as DV
8+import Data.ArrayBuffer.Typed as AT
9+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
710import Data.UInt as UInt
811import Effect (Effect)
12+import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
913import Test.Assert (assertEqual')
10−import Data.ArrayBuffer.Builder
11−import Control.Monad.Writer.Trans (tell)
1214
1315asBytes :: ArrayBuffer -> Effect (Array Int)
1416asBytes x = do