@@ -1,156 +1,342 @@
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.
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.
49-- |
5−-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
6−-- | functions in this module must be run in a `MonadEffect` context.
10+-- | See purescript-parsing-dataview for deserialization.
711-- |
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
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+-- | ```
40+-- |
41+-- | ## Serialize an `Array Int`
42+-- |
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
3781
3882import Prelude
39−
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)
4783import Effect (Effect)
48−import Effect.Class (class MonadEffect)
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)
4989
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.
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
94+
95+-- | Writer monad transformer for `Builder`.
5696type PutM = WriterT Builder
5797
58−-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
98+-- | `Put` monad is the non-transformer version of `PutM`.
5999type Put = PutM Effect
60100
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
101+ -- Note: use liftEffect to call the ArrayBuffer Effect functions
64102
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.
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.
70108-- |
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.
109+-- | # Implementation Details
75110-- |
76−-- | In a `PutM` monad do-block, we can
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`
77115-- |
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)*.
127+-- |
128+-- |
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.
131+-- |
132+-- | ```
133+-- | ⬤
134+-- | ╱
135+-- | ⬤
136+-- | ╱
137+-- | ⬤
138+-- | ╱
139+-- | ⬤
78140-- | ```
79−-- | do
80−-- | messageBuilder <- subBuilder $ do
81−-- | putField1
82−-- | putField2
83141-- |
84−-- | putInt32be $ length messageBuilder
85−-- | tell messageBuilder
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+-- | ⬤
86155-- | ```
87−subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
88−subBuilder = lift <<< execWriterT
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
89182
90−-- | Append an `ArrayBuffer` to the builder.
91−putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
92−putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
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
93214
94−-- | Append a `DataView` to the builder.
95−putDataView :: forall m. Monad m => DataView -> PutM m Unit
96−putDataView = tell <<< Internal.singleton <<< Internal.View
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
97233
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
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
237+
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
101245
102246-- | 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
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
105252
106253-- | 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
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
109259
110260-- | 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
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
113266
114267-- | 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
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
117273
118274-- | 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
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
121280
122281-- | 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
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
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 x = do
291+ buf <- liftEffect $ AB.empty 4
292+ _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
293+ tell $ singleton buf
129294
130295-- | 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
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
133301
134302-- | 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
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
137308
138309-- | 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
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
141315
142316-- | 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
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
145322
146323-- | 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
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
149329
150330-- | 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
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
153336
154337-- | 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
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