@@ -5,152 +5,403 @@
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+, putArrayBuffer
18+, putUint8
19+, putInt8
20+, putUint16be
21+, putUint16le
22+, putInt16be
23+, putInt16le
24+, putUint32be
25+, putUint32le
26+, putInt32be
27+, putInt32le
28+, putFloat32be
29+, putFloat32le
30+, putFloat64be
31+, putFloat64le
32+, Builder
33+, (<>>)
34+, execBuilder
35+, singleton
36+, snoc
37+, encodeUint8
38+, encodeInt8
39+, encodeUint16be
40+, encodeUint16le
41+, encodeInt16be
42+, encodeInt16le
43+, encodeUint32be
44+, encodeUint32le
45+, encodeInt32be
46+, encodeInt32le
47+, encodeFloat32be
48+, encodeFloat32le
49+, encodeFloat64be
50+, encodeFloat64le
51+)
52+where
3753
3854import Prelude
3955
40−import Control.Monad.Rec.Class (class MonadRec)
41−import 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)
56+import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)
57+import Data.ArrayBuffer.ArrayBuffer as AB
58+import Data.ArrayBuffer.DataView as DV
59+import Data.ArrayBuffer.Typed as AT
60+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
4561import Data.Float32 (Float32)
62+import Data.Maybe (Maybe(..))
4663import Data.UInt (UInt)
4764import Effect (Effect)
48−import Effect.Class (class MonadEffect)
65+import Effect.Class (class MonadEffect, liftEffect)
4966
5067-- | The `PutM` monad is a `WriterT Builder` transformer monad which
5168-- | gives us do-notation for the `Builder` monoid. The base monad must be
5269-- | a `MonadEffect`.
53−-- |
54−-- | To append `Builder`s in this monad call `tell`, or any of the `put*`
55−-- | functions in this module.
5670type PutM = WriterT Builder
5771
58−-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
72+-- | The `Put` monad is a `WriterT Builder Effect` monad which
73+-- | gives us do-notation for the `Builder` monoid.
5974type Put = PutM Effect
6075
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
64−
65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
66−execPut :: Put Unit -> Effect ArrayBuffer
67−execPut = execPutM
68−
69−-- | Build up a sub-`Builder` without `tell`ing it to the `Writer` yet.
76+-- | Monoidal builder for `ArrayBuffer`s.
7077-- |
71−-- | One case where we might want to call a `subBuilder` is when
72−-- | serializing length-prefixed messages in some protocol. In that case,
73−-- | we must serialize the message first, calculate the message length,
74−-- | append the message length, and then append the message.
78+-- | ### Left-associative `<>>` append operator
7579-- |
76−-- | In a `PutM` monad do-block, we can
80+-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
81+-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
7782-- |
78−-- | ```
79−-- | do
80−-- | messageBuilder <- subBuilder $ do
81−-- | putField1
82−-- | putField2
83+-- | The `Builder` monoid in this library is efficient when we `snoc` single
84+-- | items onto the end of it, or when we only `cons` single items to the
85+-- | beginning, but it can be less efficient when we are mixing `cons` and
86+-- | `snoc`.
87+-- | This matters when we're appending three or more `Builder`s
88+-- | in one associative expression, because the
89+-- | `Semigroup` append operator `<>` is right-associative.
8390-- |
84−-- | putInt32be $ length messageBuilder
85−-- | tell messageBuilder
91+-- | To solve this, we provide an operator `<>>` for appending `Builders`.
92+-- | `<>>` is exactly the same as `<>`, but left-associative.
93+-- | This only matters when we're chaining together three
94+-- | or more `Builder`s in a single associative expression.
95+-- | Instead of
96+-- | ```
97+-- | builder₁ <> builder₂ <> builder₃
98+-- | ```
99+-- | we should always prefer to
100+-- | write
86101-- | ```
87−subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
88−subBuilder = lift <<< execWriterT
102+-- | builder₁ <>> builder₂ <>> builder₃
103+-- | ```
104+-- | so that we get the efficient
105+-- | `snoc`ing of `Builder`s.
106+-- |
107+-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
108+-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
109+-- | `snoc` case.
110+-- |
111+data Builder
112+ = Node Builder ArrayBuffer Builder
113+ | Null
89114
90−-- | Append an `ArrayBuffer` to the builder.
91−putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
92−putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
115+instance semigroupBuilder :: Semigroup Builder where
116+ append Null Null = Null
117+ append l Null = l
118+ append Null r = r
119+ append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
120+ append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
121+ -- of the left tree
122+ append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
123+ -- side of the left tree
124+ -- to find the rightmost
125+ -- Null
126+
127+infixl 5 append as <>>
128+
129+instance monoidBuilder :: Monoid Builder where
130+ mempty = Null
131+
132+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
133+foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
134+foldl f a Null = a
135+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
93136
94−-- | Append a `DataView` to the builder.
95−putDataView :: forall m. Monad m => DataView -> PutM m Unit
96−putDataView = tell <<< Internal.singleton <<< Internal.View
137+-- | Monomorphic foldM copied from
138+-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
139+foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
140+foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
97141
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
142+-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
143+singleton :: ArrayBuffer -> Builder
144+singleton buf = Node Null buf Null
145+
146+-- | Add an `ArrayBuffer` to the end of the `Builder`. *O(1)*
147+snoc :: Builder -> ArrayBuffer -> Builder
148+snoc bs x = Node bs x Null
149+
150+-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
151+execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
152+execBuilder bldr = do
153+ let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
154+ -- Allocate the final ArrayBuffer
155+ buf <- liftEffect $ AB.empty buflen
156+ -- Then copy each ArrayBuffer into the final ArrayBuffer.
157+ -- To memcpy from one ArrayBuffer to another, apparently we have to first view
158+ -- both ArrayBuffers as ArrayView (Typed Array).
159+ newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
160+ _ <- foldM
161+ ( \offset a -> do
162+ aview <- liftEffect (AT.whole a :: Effect Uint8Array)
163+ _ <- liftEffect $ AT.setTyped newview (Just offset) aview
164+ pure $ offset + AB.byteLength a
165+ ) 0 bldr
166+ pure buf
167+
168+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
169+execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
170+execPutM = execBuilder <=< execWriterT
171+
172+-- | Build an `ArrayBuffer` with do-notation. *O(n)*
173+execPut :: Put Unit -> Effect ArrayBuffer
174+execPut = execPutM
175+
176+-- | Append an `ArrayBuffer` to the builder.
177+putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
178+putArrayBuffer = tell <<< singleton
179+
180+-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
181+encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
182+encodeUint8 x = do
183+ buf <- liftEffect $ AB.empty 1
184+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
185+ pure buf
101186
102187-- | 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
188+putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
189+putUint8 = putArrayBuffer <=< encodeUint8
190+
191+-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
192+encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
193+encodeInt8 x = do
194+ buf <- liftEffect $ AB.empty 1
195+ _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
196+ pure buf
105197
106198-- | 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
199+putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
200+putInt8 = putArrayBuffer <=< encodeInt8
201+
202+-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
203+encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
204+encodeUint16be x = do
205+ buf <- liftEffect $ AB.empty 2
206+ _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
207+ pure buf
109208
110209-- | 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
210+putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
211+putUint16be = putArrayBuffer <=< encodeUint16be
212+
213+-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
214+encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
215+encodeUint16le x = do
216+ buf <- liftEffect $ AB.empty 2
217+ _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
218+ pure buf
113219
114220-- | 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
221+putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
222+putUint16le = putArrayBuffer <=< encodeUint16le
223+
224+-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
225+encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
226+encodeInt16be x = do
227+ buf <- liftEffect $ AB.empty 2
228+ _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
229+ pure buf
117230
118231-- | 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
232+putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
233+putInt16be = putArrayBuffer <=< encodeInt16be
234+
235+-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
236+encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
237+encodeInt16le x = do
238+ buf <- liftEffect $ AB.empty 2
239+ _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
240+ pure buf
121241
122242-- | 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
243+putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
244+putInt16le = putArrayBuffer <=< encodeInt16le
245+
246+-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
247+encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
248+encodeUint32be x = do
249+ buf <- liftEffect $ AB.empty 4
250+ _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
251+ pure buf
125252
126253-- | 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
254+putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
255+putUint32be = putArrayBuffer <=< encodeUint32be
256+
257+-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
258+encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
259+encodeUint32le x = do
260+ buf <- liftEffect $ AB.empty 4
261+ _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
262+ pure buf
129263
130264-- | 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
265+putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
266+putUint32le = putArrayBuffer <=< encodeUint32le
267+
268+-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
269+encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
270+encodeInt32be x = do
271+ buf <- liftEffect $ AB.empty 4
272+ _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
273+ pure buf
133274
134275-- | 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
276+putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
277+putInt32be = putArrayBuffer <=< encodeInt32be
278+
279+-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
280+encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
281+encodeInt32le x = do
282+ buf <- liftEffect $ AB.empty 4
283+ _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
284+ pure buf
137285
138286-- | 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
287+putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
288+putInt32le = putArrayBuffer <=< encodeInt32le
289+
290+-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
291+encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
292+encodeFloat32be x = do
293+ buf <- liftEffect $ AB.empty 4
294+ _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
295+ pure buf
141296
142297-- | 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
298+putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
299+putFloat32be = putArrayBuffer <=< encodeFloat32be
300+
301+-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
302+encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
303+encodeFloat32le x = do
304+ buf <- liftEffect $ AB.empty 4
305+ _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
306+ pure buf
145307
146308-- | 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
309+putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
310+putFloat32le = putArrayBuffer <=< encodeFloat32le
311+
312+-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
313+encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
314+encodeFloat64be x = do
315+ buf <- liftEffect $ AB.empty 8
316+ _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
317+ pure buf
149318
150319-- | 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
320+putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
321+putFloat64be = putArrayBuffer <=< encodeFloat64be
322+
323+-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
324+encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
325+encodeFloat64le x = do
326+ buf <- liftEffect $ AB.empty 8
327+ _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
328+ pure buf
153329
154330-- | 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
331+putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
332+putFloat64le = putArrayBuffer <=< encodeFloat64le
333+
334+
335+-- ## Implementation Details
336+--
337+-- We want our `Builder` to be a data structure with
338+-- * *O(1)* monoid append
339+-- * *O(n)* fold
340+--
341+-- Our `Builder` implementation is an unbalanced binary tree.
342+--
343+-- For monoid `append`, what we actually get is *O(1)* when either the
344+-- left or right tree is a singleton. If that's not true, then in the
345+-- unlikely worst case `append` might be *O(n)*.
346+--
347+-- `Builder` is optimized what we consider to be normal usage, that is,
348+-- `snoc`ing singleton elements to the end of the `Builder`.
349+--
350+-- If a Builder is built entirely by `snoc`ing, it will look like a
351+-- left-only binary tree, a.k.a. a linked list.
352+--
353+-- ```
354+-- ④
355+-- ╱
356+-- ③
357+-- ╱
358+-- ②
359+-- ╱
360+-- ①
361+-- ```
362+--
363+-- If two of these `snoc`-built trees are `append`ed, then the new tree
364+-- will look like
365+--
366+-- ```
367+-- ④
368+-- ╱ ╲
369+-- ③ ⑧
370+-- ╱ ╱
371+-- ② ⑦
372+-- ╱ ╱
373+-- ① ⑥
374+-- ╱
375+-- ⑤
376+-- ```
377+--
378+-- This is all similar to
379+-- [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
380+-- , except that the
381+-- [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
382+-- structure in __bytestring-tree-builder__ only carries values in its
383+-- leaves, which is how it achieves *O(1)* appending, at the cost of
384+-- a higher coefficient time factor on the fold.
385+--
386+-- We hope that this implementation is fairly fast, but we
387+-- haven't chosen this implementation because it's fast, we've chosen
388+-- this implementation because it's simple.
389+-- If someone wants to create a fast Purescript ArrayBuffer serialization
390+-- library, then they can benchmark against this one to prove that the new
391+-- one is fast.
392+--
393+-- One relatively cheap and simple performance improvement for this library would be to
394+-- remove the Null constructor of `Builder` and instead use Javascript nulls.
395+--
396+-- In the longer term, it might make sense to try to change the Builder so
397+-- that it works like the
398+-- https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
399+--
400+-- Here are some benchmarks of different Haskell ByteString builders
401+-- https://github.com/haskell-perf/strict-bytestring-builders
402+--
403+-- We've tried to design the API for this library with minimal assumptions,
404+-- so that if we want to change the Builder implementation later then we can.
405+--
406+-- Another way this could go:
407+-- https://kodimensional.dev/posts/2019-03-25-comonadic-builders