@@ -1,342 +1,156 @@
1−-- | `ArrayBuffer` serialization primitives in the “builder monad” style.
2−-- | An API on top of
3−-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
4−-- | which provides a `Builder` monoid and a `PutM` monad which are roughly
5−-- | equivalent to the Haskell
6−-- | [`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
7−-- | module.
8−-- | This library defines no typeclasses.
9−-- |
10−-- | See purescript-parsing-dataview for deserialization.
11−-- |
12−-- | # Usage Examples
13−-- |
14−-- | All `ArrayBuffer` building must occur in `Effect`.
15−-- |
16−-- | ## Serialize an integer
17−-- |
18−-- | Create a two-byte `buf :: ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two’s-complement.
19−-- | ```purescript
20−-- | buf <- execPut $ putInt32be (-2)
21−-- | ```
22−-- |
23−-- | ## Serialize a `String` as UTF8
24−-- |
25−-- | Create a `buf :: ArrayBuffer` which contains a `String` encoded as UTF8 with a length prefix in a
26−-- | way that's compatible with the
27−-- | [`Binary.Put.putStringUtf8`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html#v:putStringUtf8)
28−-- | function from the Haskell
29−-- | [__binary__](https://hackage.haskell.org/package/binary)
30−-- | library.
31−-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).
32−-- | ```purescript
33−-- | buf <- execPut $ do
34−-- | let stringbuf = Data.ArrayBuffer.Typed.buffer $ Data.TextEncoding.encodeUtf8 "Black Lives Matter"
35−-- | -- Put a 64-bit big-endian length prefix for the length of the utf8 string, in bytes.
36−-- | putUint32be 0
37−-- | putUint32be $ Data.Uint.fromInt $ Data.ArrayBuffer.byteLength stringbuf
38−-- | putArrayBuffer stringbuf
39−-- | ```
1+-- | This module provides a `Builder` monoid and a `PutM` monad
2+-- | for serializing `Data.ArrayBuffer.Types.ArrayBuffer`s.
3+-- | See the package README for usage examples.
404-- |
41−-- | ## Serialize an `Array Int`
5+-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
6+-- | functions in this module must be run in a `MonadEffect` context.
427-- |
43−-- | Create a `buf :: ArrayBuffer` which encodes an `Array Int` with a length prefix in a
44−-- | way that's compatible with the
45−-- | [`Binary` instance for `[Int32]`](https://hackage.haskell.org/package/binary/docs/Data-Binary.html#t:Binary)
46−-- | from the Haskell
47−-- | [__binary__](https://hackage.haskell.org/package/binary)
48−-- | library.
49−-- | ```purescript
50−-- | let x = [1,2,3] :: Array Int
51−-- | buf <- execPut $
52−-- | -- Put a 64-bit big-endian length prefix for the length of the array, in bytes.
53−-- | putUint32be 0
54−-- | putUint32be $ Data.Uint.fromInt $ Data.Array.length x
55−-- | traverse_ putInt32be x
56−-- | ```
57−module Build
58−( Builder
59−, PutM
60−, Put
61−, execBuilder
62−, execPutM
63−, execPut
64−, putArrayBuffer
65−, putUint8
66−, putInt8
67−, putUint16be
68−, putUint16le
69−, putInt16be
70−, putInt16le
71−, putUint32be
72−, putUint32le
73−, putInt32be
74−, putInt32le
75−, putFloat32be
76−, putFloat32le
77−, putFloat64be
78−, putFloat64le
79−)
80−where
8+-- | For other operations for working with `ArrayBuffer`, see
9+-- | module
10+-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
11+-- | in package __arraybuffer__.
12+module 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
8137
8238import Prelude
83−import Effect (Effect)
84−import Effect.Class (class MonadEffect, liftEffect)
85−import Data.UInt (UInt)
86−import Data.Float32 (Float32)
87−import Data.Maybe (Maybe(..))
88−import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)
8939
90−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
91−import Data.ArrayBuffer.ArrayBuffer as AB
92−import Data.ArrayBuffer.DataView as DV
93−import Data.ArrayBuffer.Typed as AT
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)
45+import Data.Float32 (Float32)
46+import Data.UInt (UInt)
47+import Effect (Effect)
48+import Effect.Class (class MonadEffect)
9449
95−-- | Writer monad transformer for `Builder`.
50+-- | The `PutM` monad is a `WriterT Builder` transformer monad which
51+-- | gives us do-notation for the `Builder` monoid. The base monad must be
52+-- | a `MonadEffect`.
53+-- |
54+-- | To append `Builder`s in this monad call `tell`, or any of the `put*`
55+-- | functions in this module.
9656type PutM = WriterT Builder
9757
98−-- | `Put` monad is the non-transformer version of `PutM`.
58+-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
9959type Put = PutM Effect
10060
101− -- Note: use liftEffect to call the ArrayBuffer Effect functions
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
10264
103−-- | Builder for `ArrayBuffer`s.
104−-- |
105−-- | It is common to build an `ArrayBuffer` by issuing a sequence of `put`
106−-- | commands in a `Put` monad, and this is the case which the Builder monoid
107−-- | is optimized for.
108−-- |
109−-- | # Implementation Details
110−-- |
111−-- | Implements an unbalanced binary tree to get
112−-- | * *O(1)* `snoc` (add element to end)
113−-- | * *O(1)* monoid `append` (concatenation)
114−-- | * *O(n)* `fold`
115−-- |
116−-- | For monoid `append`, what we actually get is *O(k)* where *k* is
117−-- | proportional to the number of `append`s which have already been performed.
118−-- |
119−-- | `append`ing a singleton `Builder` to the right is treated as a `snoc`.
120−-- | Specifically, the special case of `append l r` where `r` has a `Null`
121−-- | left subtree doesn't increase *k*. So as long as we're right-appending
122−-- | singleton `Builder`s, then we still get *O(1)* `append`.
123−-- |
124−-- | `append` is O(n), in the worst case, if the `Builder` has been built
125−-- | entirely by `append`ing. If the Builder has been built mostly by
126−-- | `snoc`ing, then `append` approaches *O(1)*.
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.
12770-- |
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.
12875-- |
129−-- | If a Builder is built entirely by `snoc`ing, it will look like a
130−-- | left-only binary tree, a.k.a. a linked list.
76+-- | In a `PutM` monad do-block, we can
13177-- |
13278-- | ```
133−-- | ⬤
134−-- | ╱
135−-- | ⬤
136−-- | ╱
137−-- | ⬤
138−-- | ╱
139−-- | ⬤
140−-- | ```
79+-- | do
80+-- | messageBuilder <- subBuilder $ do
81+-- | putField1
82+-- | putField2
14183-- |
142−-- | If two of these `snoc`-built trees are `append`ed, then the new tree
143−-- | will look like
144−-- |
145−-- | ```
146−-- | ⬤
147−-- | ╱ ╲
148−-- | ⬤ ⬤
149−-- | ╱ ╱
150−-- | ⬤ ⬤
151−-- | ╱ ╱
152−-- | ⬤ ⬤
153−-- | ╱
154−-- | ⬤
84+-- | putInt32be $ length messageBuilder
85+-- | tell messageBuilder
15586-- | ```
156−-- |
157−-- | This is all similar to
158−-- | https://hackage.haskell.org/package/bytestring-tree-builder
159−-- | , except that the `Tree` https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree
160−-- | structure in __bytestring-tree-builder__ only carries values in its
161−-- | leaves, and therefore I think has an *O(n log(n))* fold. This `Builder`
162−-- | has an *O(n)* fold.
163−-- |
164−-- | We hope that this implementation is fairly fast, but we
165−-- | haven't chosen this implementation because it's fast, we've chosen
166−-- | this implementation because it's simple. This library provides basic
167−-- | ArrayBuffer serialization with the familar “put monad” style.
168−-- | The only currently existing Purescript libary which does ArrayBuffer
169−-- | serialization is
170−-- | https://pursuit.purescript.org/packages/purescript-arraybuffer-class
171−-- | , and that library is heavily typeclass-based and designed
172−-- | for compatibility with the Haskell cereal library.
173−-- | If someone wants to create a fast Purescript ArrayBuffer serialization
174−-- | library, then they can benchmark against this one to prove that the new
175−-- | one is fast.
176−-- |
177−-- | One relatively cheap and simple performance improvement for this library would be to
178−-- | remove the Null constructor of Builder and instead use Javascript nulls.
179−data Builder
180− = Node Builder ArrayBuffer Builder
181− | Null
87+subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
88+subBuilder = lift <<< execWriterT
18289
183−instance semigroupBuilder :: Semigroup Builder where
184− append Null Null = Null
185− append l Null = l
186− append Null r = r
187− append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
188− append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
189− -- of the left tree
190− append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
191− -- side of the left tree
192− -- to find the rightmost
193− -- Null
194−
195−instance monoidBuilder :: Monoid Builder where
196− mempty = Null
197−
198−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
199−foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
200−foldl f a Null = a
201−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
202−
203−-- | Monomorphic foldM copied from
204−-- | https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM
205−foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
206−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
207−
208−singleton :: ArrayBuffer -> Builder
209−singleton buf = Node Null buf Null
210−
211−-- | Add an ArrayBuffer to the end of the Builder.
212−snoc :: Builder -> ArrayBuffer -> Builder
213−snoc bs x = Node bs x Null
214−
215−-- | Build a single `ArrayBuffer` from a `Builder`.
216−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
217−execBuilder bldr = do
218− let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
219− -- Allocate the final ArrayBuffer
220− buf <- liftEffect $ AB.empty buflen
221− -- Then copy each ArrayBuffer into the final ArrayBuffer.
222− -- To memcpy from one ArrayBuffer to another, apparently we have to first view
223− -- both ArrayBuffers as ArrayView (Typed Array).
224− newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
225− _ <- foldM
226− ( \offset a -> do
227− let offset' = offset + AB.byteLength a
228− aview <- liftEffect (AT.whole a :: Effect Uint8Array)
229− _ <- liftEffect $ AT.setTyped newview (Just offset') aview
230− pure offset'
231− ) 0 bldr
232− pure buf
90+-- | Append an `ArrayBuffer` to the builder.
91+putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
92+putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
23393
234−-- | Monad computation to build an `ArrayBuffer` in any `MonadEffect`.
235−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
236−execPutM = execBuilder <=< execWriterT
94+-- | Append a `DataView` to the builder.
95+putDataView :: forall m. Monad m => DataView -> PutM m Unit
96+putDataView = tell <<< Internal.singleton <<< Internal.View
23797
238−-- | Monad computation to build an `ArrayBuffer` in the `Effect` monad.
239−execPut :: Put Unit -> Effect ArrayBuffer
240−execPut = execPutM
241−
242−-- | Append an `ArrayBuffer` to the builder.
243−putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
244−putArrayBuffer = tell <<< singleton
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
245101
246102-- | Append an 8-bit unsigned integer (byte) to the builder.
247−putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
248−putUint8 x = do
249− buf <- liftEffect $ AB.empty 1
250− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
251− tell $ singleton buf
103+putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
104+putUint8 = putArrayBuffer <=< Internal.encodeUint8
252105
253106-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
254−putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
255−putInt8 x = do
256− buf <- liftEffect $ AB.empty 1
257− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
258− tell $ singleton buf
107+putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
108+putInt8 = putArrayBuffer <=< Internal.encodeInt8
259109
260110-- | Append a 16-bit big-endian unsigned integer to the builder.
261−putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
262−putUint16be x = do
263− buf <- liftEffect $ AB.empty 2
264− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
265− tell $ singleton buf
111+putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
112+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
266113
267114-- | Append a 16-bit little-endian unsigned integer to the builder.
268−putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
269−putUint16le x = do
270− buf <- liftEffect $ AB.empty 2
271− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
272− tell $ singleton buf
115+putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
116+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
273117
274118-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
275−putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
276−putInt16be x = do
277− buf <- liftEffect $ AB.empty 2
278− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
279− tell $ singleton buf
119+putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
120+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
280121
281122-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
282−putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
283−putInt16le x = do
284− buf <- liftEffect $ AB.empty 2
285− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
286− tell $ singleton buf
123+putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
124+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
287125
288126-- | Append a 32-bit big-endian unsigned integer to the builder.
289−putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
290−putUint32be x = do
291− buf <- liftEffect $ AB.empty 4
292− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
293− tell $ singleton buf
127+putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
128+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
294129
295130-- | Append a 32-bit little-endian unsigned integer to the builder.
296−putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
297−putUint32le x = do
298− buf <- liftEffect $ AB.empty 4
299− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
300− tell $ singleton buf
131+putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
132+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
301133
302134-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
303−putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
304−putInt32be x = do
305− buf <- liftEffect $ AB.empty 4
306− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
307− tell $ singleton buf
135+putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
136+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
308137
309138-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
310−putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
311−putInt32le x = do
312− buf <- liftEffect $ AB.empty 4
313− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
314− tell $ singleton buf
139+putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
140+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
315141
316142-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
317−putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
318−putFloat32be x = do
319− buf <- liftEffect $ AB.empty 4
320− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
321− tell $ singleton buf
143+putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
144+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
322145
323146-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
324−putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
325−putFloat32le x = do
326− buf <- liftEffect $ AB.empty 4
327− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
328− tell $ singleton buf
147+putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
148+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
329149
330150-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
331−putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
332−putFloat64be x = do
333− buf <- liftEffect $ AB.empty 8
334− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
335− tell $ singleton buf
151+putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
152+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
336153
337154-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
338−putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
339−putFloat64le x = do
340− buf <- liftEffect $ AB.empty 8
341− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
342− tell $ singleton buf
155+putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
156+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le