@@ -5,47 +5,67 @@
55-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
66-- | functions in this module must be run in a `MonadEffect` context.
77-- |
8−-- | For other operations for working with `ArrayBuffer`, see
8+-- | For operations for working with `ArrayBuffer`, see
99-- | module
1010-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
11−-- | in package __arraybuffer__.
11+-- | in package __purescript-arraybuffer__.
1212module Data.ArrayBuffer.Builder
13− ( PutM
14− , Put
15− , execPutM
16− , execPut
17− , subBuilder
18− , putArrayBuffer
19− , putDataView
20− , putDataBuff
21− , putUint8
22− , putInt8
23− , putUint16be
24− , putUint16le
25− , putInt16be
26− , putInt16le
27− , putUint32be
28− , putUint32le
29− , putInt32be
30− , putInt32le
31− , putFloat32be
32− , putFloat32le
33− , putFloat64be
34− , putFloat64le
35− , module Data.ArrayBuffer.Builder.Internal
36− ) where
13+( PutM
14+, Put
15+, execPutM
16+, execPut
17+, subBuilder
18+, putArrayBuffer
19+, putUint8
20+, putInt8
21+, putUint16be
22+, putUint16le
23+, putInt16be
24+, putInt16le
25+, putUint32be
26+, putUint32le
27+, putInt32be
28+, putInt32le
29+, putFloat32be
30+, putFloat32le
31+, putFloat64be
32+, putFloat64le
33+, Builder
34+, (<>>)
35+, execBuilder
36+, length
37+, singleton
38+, cons
39+, snoc
40+, encodeUint8
41+, encodeInt8
42+, encodeUint16be
43+, encodeUint16le
44+, encodeInt16be
45+, encodeInt16le
46+, encodeUint32be
47+, encodeUint32le
48+, encodeInt32be
49+, encodeInt32le
50+, encodeFloat32be
51+, encodeFloat32le
52+, encodeFloat64be
53+, encodeFloat64le
54+)
55+where
3756
3857import Prelude
3958
40−import Control.Monad.Rec.Class (class MonadRec)
4159import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
42−import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
43−import Data.ArrayBuffer.Builder.Internal as Internal
44−import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
60+import Data.ArrayBuffer.ArrayBuffer as AB
61+import Data.ArrayBuffer.DataView as DV
62+import Data.ArrayBuffer.Typed as AT
63+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
4564import Data.Float32 (Float32)
65+import Data.Maybe (Maybe(..))
4666import Data.UInt (UInt)
4767import Effect (Effect)
48−import Effect.Class (class MonadEffect)
68+import Effect.Class (class MonadEffect, liftEffect)
4969
5070-- | The `PutM` monad is a `WriterT Builder` transformer monad which
5171-- | gives us do-notation for the `Builder` monoid. The base monad must be
@@ -58,11 +78,111 @@ type PutM = WriterT Builder
5878-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
5979type Put = PutM Effect
6080
61−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
62−execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
63−execPutM = Internal.execBuilder <=< execWriterT
81+-- | Monoidal builder for `ArrayBuffer`s.
82+-- |
83+-- | ### Left-associative `<>>` append operator
84+-- |
85+-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
86+-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
87+-- |
88+-- | The `Builder` monoid in this library is efficient when we `snoc` single
89+-- | items onto the end of it, or when we only `cons` single items to the
90+-- | beginning, but it can be less efficient when we are mixing `cons` and
91+-- | `snoc`.
92+-- | This matters when we're appending three or more `Builder`s
93+-- | in one associative expression, because the
94+-- | `Semigroup` append operator `<>` is right-associative.
95+-- |
96+-- | To solve this, we provide an operator `<>>` for appending `Builders`.
97+-- | `<>>` is exactly the same as `<>`, but left-associative.
98+-- | This only matters when we're chaining together three
99+-- | or more `Builder`s in a single associative expression.
100+-- | Instead of
101+-- | ```
102+-- | builder₁ <> builder₂ <> builder₃
103+-- | ```
104+-- | we should always prefer to
105+-- | write
106+-- | ```
107+-- | builder₁ <>> builder₂ <>> builder₃
108+-- | ```
109+-- | so that we get the efficient
110+-- | `snoc`ing of `Builder`s.
111+-- |
112+-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
113+-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
114+-- | `snoc` case.
115+-- |
116+data Builder
117+ = Node Builder ArrayBuffer Builder
118+ | Null
119+
120+instance semigroupBuilder :: Semigroup Builder where
121+ append Null Null = Null
122+ append l Null = l
123+ append Null r = r
124+ append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
125+ append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
126+ -- of the left tree
127+ append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
128+ -- side of the left tree
129+ -- to find the rightmost
130+ -- Null
131+
132+infixl 5 append as <>>
133+
134+instance monoidBuilder :: Monoid Builder where
135+ mempty = Null
136+
137+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
138+foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
139+foldl f a Null = a
140+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
141+
142+-- | Monomorphic foldM copied from
143+-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
144+foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
145+foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
146+
147+-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
148+singleton :: ArrayBuffer -> Builder
149+singleton buf = Node Null buf Null
150+
151+-- | Prepend an `ArrayBuffer` to the beginning of the `Builder`. *O(1)*
152+cons :: ArrayBuffer -> Builder -> Builder
153+cons x bs = Node Null x bs
154+
155+-- | Append an `ArrayBuffer` to the end of the `Builder`. *O(1)*
156+snoc :: Builder -> ArrayBuffer -> Builder
157+snoc bs x = Node bs x Null
158+
159+-- | Calculate the total byte length of the `Builder`. *O(n)*
160+length :: Builder -> Int
161+length bldr = foldl (\b a -> b + AB.byteLength a) 0 bldr
162+
163+-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
164+execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
165+execBuilder bldr = do
166+ let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
167+ -- Allocate the final ArrayBuffer
168+ buf <- liftEffect $ AB.empty buflen
169+ -- Then copy each ArrayBuffer into the final ArrayBuffer.
170+ -- To memcpy from one ArrayBuffer to another, apparently we have to first view
171+ -- both ArrayBuffers as ArrayView (Typed Array).
172+ newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
173+ _ <- foldM
174+ ( \offset a -> do
175+ aview <- liftEffect (AT.whole a :: Effect Uint8Array)
176+ _ <- liftEffect $ AT.setTyped newview (Just offset) aview
177+ pure $ offset + AB.byteLength a
178+ ) 0 bldr
179+ pure buf
64180
65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
181+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
182+execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
183+execPutM = execBuilder <=< execWriterT
184+
185+-- | Build an `ArrayBuffer` with do-notation. *O(n)*
66186execPut :: Put Unit -> Effect ArrayBuffer
67187execPut = execPutM
68188
@@ -75,6 +195,7 @@ execPut = execPutM
75195-- |
76196-- | In a `PutM` monad do-block, we can
77197-- |
198+-- |
78199-- | ```
79200-- | do
80201-- | messageBuilder <- subBuilder $ do
@@ -84,73 +205,239 @@ execPut = execPutM
84205-- | putInt32be $ length messageBuilder
85206-- | tell messageBuilder
86207-- | ```
87−subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
208+subBuilder :: forall m. (MonadEffect m) => PutM m Unit -> PutM m Builder
88209subBuilder = lift <<< execWriterT
89210
90211-- | Append an `ArrayBuffer` to the builder.
91−putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
92−putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
93−
94−-- | Append a `DataView` to the builder.
95−putDataView :: forall m. Monad m => DataView -> PutM m Unit
96−putDataView = tell <<< Internal.singleton <<< Internal.View
212+putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
213+putArrayBuffer = tell <<< singleton
97214
98−-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
99−putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
100−putDataBuff = tell <<< Internal.singleton
215+-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
216+encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
217+encodeUint8 x = do
218+ buf <- liftEffect $ AB.empty 1
219+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
220+ pure buf
101221
102222-- | Append an 8-bit unsigned integer (byte) to the builder.
103−putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
104−putUint8 = putArrayBuffer <=< Internal.encodeUint8
223+putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
224+putUint8 = putArrayBuffer <=< encodeUint8
225+
226+-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
227+encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
228+encodeInt8 x = do
229+ buf <- liftEffect $ AB.empty 1
230+ _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
231+ pure buf
105232
106233-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
107−putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
108−putInt8 = putArrayBuffer <=< Internal.encodeInt8
234+putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
235+putInt8 = putArrayBuffer <=< encodeInt8
236+
237+-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
238+encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
239+encodeUint16be x = do
240+ buf <- liftEffect $ AB.empty 2
241+ _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
242+ pure buf
109243
110244-- | Append a 16-bit big-endian unsigned integer to the builder.
111−putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
112−putUint16be = putArrayBuffer <=< Internal.encodeUint16be
245+putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
246+putUint16be = putArrayBuffer <=< encodeUint16be
247+
248+-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
249+encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
250+encodeUint16le x = do
251+ buf <- liftEffect $ AB.empty 2
252+ _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
253+ pure buf
113254
114255-- | Append a 16-bit little-endian unsigned integer to the builder.
115−putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
116−putUint16le = putArrayBuffer <=< Internal.encodeUint16le
256+putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
257+putUint16le = putArrayBuffer <=< encodeUint16le
258+
259+-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
260+encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
261+encodeInt16be x = do
262+ buf <- liftEffect $ AB.empty 2
263+ _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
264+ pure buf
117265
118266-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
119−putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
120−putInt16be = putArrayBuffer <=< Internal.encodeInt16be
267+putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
268+putInt16be = putArrayBuffer <=< encodeInt16be
269+
270+-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
271+encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
272+encodeInt16le x = do
273+ buf <- liftEffect $ AB.empty 2
274+ _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
275+ pure buf
121276
122277-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
123−putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
124−putInt16le = putArrayBuffer <=< Internal.encodeInt16le
278+putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
279+putInt16le = putArrayBuffer <=< encodeInt16le
280+
281+-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
282+encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
283+encodeUint32be x = do
284+ buf <- liftEffect $ AB.empty 4
285+ _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
286+ pure buf
125287
126288-- | Append a 32-bit big-endian unsigned integer to the builder.
127−putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
128−putUint32be = putArrayBuffer <=< Internal.encodeUint32be
289+putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
290+putUint32be = putArrayBuffer <=< encodeUint32be
291+
292+-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
293+encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
294+encodeUint32le x = do
295+ buf <- liftEffect $ AB.empty 4
296+ _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
297+ pure buf
129298
130299-- | Append a 32-bit little-endian unsigned integer to the builder.
131−putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
132−putUint32le = putArrayBuffer <=< Internal.encodeUint32le
300+putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
301+putUint32le = putArrayBuffer <=< encodeUint32le
302+
303+-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
304+encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
305+encodeInt32be x = do
306+ buf <- liftEffect $ AB.empty 4
307+ _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
308+ pure buf
133309
134310-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
135−putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
136−putInt32be = putArrayBuffer <=< Internal.encodeInt32be
311+putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
312+putInt32be = putArrayBuffer <=< encodeInt32be
313+
314+-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
315+encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
316+encodeInt32le x = do
317+ buf <- liftEffect $ AB.empty 4
318+ _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
319+ pure buf
137320
138321-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
139−putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
140−putInt32le = putArrayBuffer <=< Internal.encodeInt32le
322+putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
323+putInt32le = putArrayBuffer <=< encodeInt32le
324+
325+-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
326+encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
327+encodeFloat32be x = do
328+ buf <- liftEffect $ AB.empty 4
329+ _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
330+ pure buf
141331
142332-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
143−putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
144−putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
333+putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
334+putFloat32be = putArrayBuffer <=< encodeFloat32be
335+
336+-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
337+encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
338+encodeFloat32le x = do
339+ buf <- liftEffect $ AB.empty 4
340+ _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
341+ pure buf
145342
146343-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
147−putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
148−putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
344+putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
345+putFloat32le = putArrayBuffer <=< encodeFloat32le
346+
347+-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
348+encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
349+encodeFloat64be x = do
350+ buf <- liftEffect $ AB.empty 8
351+ _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
352+ pure buf
149353
150354-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
151−putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
152−putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
355+putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
356+putFloat64be = putArrayBuffer <=< encodeFloat64be
357+
358+-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
359+encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
360+encodeFloat64le x = do
361+ buf <- liftEffect $ AB.empty 8
362+ _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
363+ pure buf
153364
154365-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
155−putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
156−putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
366+putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
367+putFloat64le = putArrayBuffer <=< encodeFloat64le
368+
369+
370+-- ## Implementation Details
371+--
372+-- We want our `Builder` to be a data structure with
373+-- * *O(1)* monoid append
374+-- * *O(n)* fold
375+--
376+-- Our `Builder` implementation is an unbalanced binary tree.
377+--
378+-- For monoid `append`, what we actually get is *O(1)* when either the
379+-- left or right tree is a singleton. If that's not true, then in the
380+-- unlikely worst case `append` might be *O(n)*.
381+--
382+-- `Builder` is optimized what we consider to be normal usage, that is,
383+-- `snoc`ing singleton elements to the end of the `Builder`.
384+--
385+-- If a Builder is built entirely by `snoc`ing, it will look like a
386+-- left-only binary tree, a.k.a. a linked list.
387+--
388+-- ```
389+-- ④
390+-- ╱
391+-- ③
392+-- ╱
393+-- ②
394+-- ╱
395+-- ①
396+-- ```
397+--
398+-- If two of these `snoc`-built trees are `append`ed, then the new tree
399+-- will look like
400+--
401+-- ```
402+-- ④
403+-- ╱ ╲
404+-- ③ ⑧
405+-- ╱ ╱
406+-- ② ⑦
407+-- ╱ ╱
408+-- ① ⑥
409+-- ╱
410+-- ⑤
411+-- ```
412+--
413+-- This is all similar to
414+-- [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
415+-- , except that the
416+-- [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
417+-- structure in __bytestring-tree-builder__ only carries values in its
418+-- leaves, which is how it achieves *O(1)* appending, at the cost of
419+-- a higher coefficient time factor on the fold.
420+--
421+-- We hope that this implementation is fairly fast, but we
422+-- haven't chosen this implementation because it's fast, we've chosen
423+-- this implementation because it's simple.
424+-- If someone wants to create a fast Purescript ArrayBuffer serialization
425+-- library, then they can benchmark against this one to prove that the new
426+-- one is fast.
427+--
428+-- One relatively cheap and simple performance improvement for this library would be to
429+-- remove the Null constructor of `Builder` and instead use Javascript nulls.
430+--
431+-- In the longer term, it might make sense to try to change the Builder so
432+-- that it works like the
433+-- https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
434+--
435+-- Here are some benchmarks of different Haskell ByteString builders
436+-- https://github.com/haskell-perf/strict-bytestring-builders
437+--
438+-- We've tried to design the API for this library with minimal assumptions,
439+-- so that if we want to change the Builder implementation later then we can.
440+--
441+-- Another way this could go:
442+-- https://kodimensional.dev/posts/2019-03-25-comonadic-builders
443+