@@ -1,342 +1,156 @@
1−-- | `ArrayBuffer` serialization primitives in the “builder monad” style.
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
1+-- | This module provides a `Builder` monoid and a `PutM` monad
5−-- | equivalent to the Haskell
2+-- | for serializing `Data.ArrayBuffer.Types.ArrayBuffer`s.
6−-- | [`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
3+-- | See the package README for usage examples.
8−-- | This library defines no typeclasses.
10−-- | See purescript-parsing-dataview for deserialization.
14−-- | All `ArrayBuffer` building must occur in `Effect`.
16−-- | ## Serialize an integer
18−-- | Create a two-byte `buf :: ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two’s-complement.
20−-- | buf <- execPut $ putInt32be (-2)
23−-- | ## Serialize a `String` as UTF8
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)
31−-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).
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.
37−-- | putUint32be $ Data.Uint.fromInt $ Data.ArrayBuffer.byteLength stringbuf
38−-- | putArrayBuffer stringbuf
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.
43−-- | Create a `buf :: ArrayBuffer` which encodes an `Array Int` with a length prefix in a
8+-- | For other operations for working with `ArrayBuffer`, see
44−-- | way that's compatible with the
9+-- | module
45−-- | [`Binary` instance for `[Int32]`](https://hackage.haskell.org/package/binary/docs/Data-Binary.html#t:Binary)
10+-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
46−-- | from the Haskell
11+-- | in package __arraybuffer__.
47−-- | [__binary__](https://hackage.haskell.org/package/binary)
12+module Data.ArrayBuffer.Builder
50−-- | let x = [1,2,3] :: Array Int
52−-- | -- Put a 64-bit big-endian length prefix for the length of the array, in bytes.
54−-- | putUint32be $ Data.Uint.fromInt $ Data.Array.length x
55−-- | traverse_ putInt32be x
62−, execPutM
15+ , execPutM
63−, execPut
16+ , execPut
64−, putArrayBuffer
18+ , putArrayBuffer
65−, putUint8
21+ , putUint8
66−, putInt8
22+ , putInt8
67−, putUint16be
23+ , putUint16be
68−, putUint16le
24+ , putUint16le
69−, putInt16be
25+ , putInt16be
70−, putInt16le
26+ , putInt16le
71−, putUint32be
27+ , putUint32be
72−, putUint32le
28+ , putUint32le
73−, putInt32be
29+ , putInt32be
74−, putInt32le
30+ , putInt32le
75−, putFloat32be
31+ , putFloat32be
76−, putFloat32le
32+ , putFloat32le
77−, putFloat64be
33+ , putFloat64be
78−, putFloat64le
34+ , putFloat64le
79−)
35+ , module Data.ArrayBuffer.Builder.Internal
82import Prelude
38import 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)
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
90−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
44+import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
91−import Data.ArrayBuffer.ArrayBuffer as AB
45+import Data.Float32 (Float32)
92−import Data.ArrayBuffer.DataView as DV
93−import Data.ArrayBuffer.Typed as AT
46+import Data.UInt (UInt)
47+import Effect (Effect)
48+import Effect.Class (class MonadEffect)
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
54+-- | To append `Builder`s in this monad call `tell`, or any of the `put*`
55+-- | functions in this module.
96type PutM = WriterT Builder
56type PutM = WriterT Builder
98−-- | `Put` monad is the non-transformer version of `PutM`.
58+-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
99type Put = PutM Effect
59type Put = PutM Effect
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
103−-- | Builder for `ArrayBuffer`s.
65+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
104−-- |
66+execPut :: Put Unit -> Effect ArrayBuffer
105−-- | It is common to build an `ArrayBuffer` by issuing a sequence of `put`
67+execPut = execPutM
106−-- | commands in a `Put` monad, and this is the case which the Builder monoid
68+
107−-- | is optimized for.
69+-- | Build up a sub-`Builder` without `tell`ing it to the `Writer` yet.
109−-- | # Implementation Details
111−-- | Implements an unbalanced binary tree to get
112−-- | * *O(1)* `snoc` (add element to end)
113−-- | * *O(1)* monoid `append` (concatenation)
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.
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`.
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)*.
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.
129−-- | If a Builder is built entirely by `snoc`ing, it will look like a
76+-- | In a `PutM` monad do-block, we can
130−-- | left-only binary tree, a.k.a. a linked list.
134−-- | ╱
80+-- | messageBuilder <- subBuilder $ do
135−-- | ⬤
81+-- | putField1
136−-- | ╱
82+-- | putField2
142−-- | If two of these `snoc`-built trees are `append`ed, then the new tree
84+-- | putInt32be $ length messageBuilder
143−-- | will look like
85+-- | tell messageBuilder
156−-- |
87+subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
157−-- | This is all similar to
88+subBuilder = lift <<< execWriterT
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.
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
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.
180− = Node Builder ArrayBuffer Builder
183−instance semigroupBuilder :: Semigroup Builder where
90+-- | Append an `ArrayBuffer` to the builder.
184− append Null Null = Null
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
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
195−instance monoidBuilder :: Monoid Builder where
198−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
199−foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
201−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
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
91+putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
206−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
92+putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
208−singleton :: ArrayBuffer -> Builder
209−singleton buf = Node Null buf Null
211−-- | Add an ArrayBuffer to the end of the Builder.
212−snoc :: Builder -> ArrayBuffer -> Builder
213−snoc bs x = Node bs x Null
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)
227− let offset' = offset + AB.byteLength a
228− aview <- liftEffect (AT.whole a :: Effect Uint8Array)
229− _ <- liftEffect $ AT.setTyped newview (Just offset') aview
234−-- | Monad computation to build an `ArrayBuffer` in any `MonadEffect`.
94+-- | Append a `DataView` to the builder.
235−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
95+putDataView :: forall m. Monad m => DataView -> PutM m Unit
236−execPutM = execBuilder <=< execWriterT
96+putDataView = tell <<< Internal.singleton <<< Internal.View
238−-- | Monad computation to build an `ArrayBuffer` in the `Effect` monad.
239−execPut :: Put Unit -> Effect ArrayBuffer
242−-- | Append an `ArrayBuffer` to the builder.
98+-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
243−putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
99+putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
244−putArrayBuffer = tell <<< singleton
100+putDataBuff = tell <<< Internal.singleton
246-- | Append an 8-bit unsigned integer (byte) to the builder.
102-- | Append an 8-bit unsigned integer (byte) to the builder.
247−putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
103+putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
248−putUint8 x = do
104+putUint8 = putArrayBuffer <=< Internal.encodeUint8
249− buf <- liftEffect $ AB.empty 1
250− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
251− tell $ singleton buf
253-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
106-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
254−putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
107+putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
255−putInt8 x = do
108+putInt8 = putArrayBuffer <=< Internal.encodeInt8
256− buf <- liftEffect $ AB.empty 1
257− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
258− tell $ singleton buf
260-- | Append a 16-bit big-endian unsigned integer to the builder.
110-- | Append a 16-bit big-endian unsigned integer to the builder.
261−putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
111+putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
262−putUint16be x = do
112+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
263− buf <- liftEffect $ AB.empty 2
264− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
265− tell $ singleton buf
267-- | Append a 16-bit little-endian unsigned integer to the builder.
114-- | Append a 16-bit little-endian unsigned integer to the builder.
268−putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
115+putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
269−putUint16le x = do
116+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
270− buf <- liftEffect $ AB.empty 2
271− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
272− tell $ singleton buf
274-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
118-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
275−putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
119+putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
276−putInt16be x = do
120+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
277− buf <- liftEffect $ AB.empty 2
278− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
279− tell $ singleton buf
281-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
122-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
282−putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
123+putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
283−putInt16le x = do
124+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
284− buf <- liftEffect $ AB.empty 2
285− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
286− tell $ singleton buf
288-- | Append a 32-bit big-endian unsigned integer to the builder.
126-- | Append a 32-bit big-endian unsigned integer to the builder.
289−putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
127+putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
290−putUint32be x = do
128+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
291− buf <- liftEffect $ AB.empty 4
292− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
293− tell $ singleton buf
295-- | Append a 32-bit little-endian unsigned integer to the builder.
130-- | Append a 32-bit little-endian unsigned integer to the builder.
296−putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
131+putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
297−putUint32le x = do
132+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
298− buf <- liftEffect $ AB.empty 4
299− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
300− tell $ singleton buf
302-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
134-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
303−putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
135+putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
304−putInt32be x = do
136+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
305− buf <- liftEffect $ AB.empty 4
306− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
307− tell $ singleton buf
309-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
138-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
310−putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
139+putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
311−putInt32le x = do
140+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
312− buf <- liftEffect $ AB.empty 4
313− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
314− tell $ singleton buf
316-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
142-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
317−putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
143+putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
318−putFloat32be x = do
144+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
319− buf <- liftEffect $ AB.empty 4
320− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
321− tell $ singleton buf
323-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
146-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
324−putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
147+putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
325−putFloat32le x = do
148+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
326− buf <- liftEffect $ AB.empty 4
327− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
328− tell $ singleton buf
330-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
150-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
331−putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
151+putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
332−putFloat64be x = do
152+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
333− buf <- liftEffect $ AB.empty 8
334− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
335− tell $ singleton buf
337-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
154-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
338−putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
155+putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
339−putFloat64le x = do
156+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
340− buf <- liftEffect $ AB.empty 8
341− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
342− tell $ singleton buf