@@ -1,156 +1,225 @@
1−-- | This module provides a `Builder` monoid and a `PutM` monad
1+-- | `ArrayBuffer` serialization primitives. (Not typeclass-based.)
2−-- | for serializing `Data.ArrayBuffer.Types.ArrayBuffer`s.
2+-- |
3−-- | See the package README for usage examples.
3+-- | Provides a `Builder` monoid which is roughly equivalent to the
5+-- | Provides a `PutM` monad which is roughly equivalent to `PutM` from the
6+-- | Haskell __binary__ library.
8+-- | See purescript-parsing-dataview for deserialization.
5−-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
10+-- | # Usage Examples
6−-- | functions in this module must be run in a `MonadEffect` context.
11+-- |
7−-- |
12+-- | All `ArrayBuffer` building must occur in `Effect`.
8−-- | For other operations for working with `ArrayBuffer`, see
13+-- |
9−-- | module
14+-- | ## Serialize an integer
16+-- | Create a two-byte `ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two's-complement.
18+-- | buf <- execPut $ putInt32be (-2)
21+-- | ## Serialize a UTF8 string
23+-- | Create an `ArrayBuffer` which contains a `String` encoded as UTF8 in a way that's compatible
25+-- | [`Binary.Put.putStringUtf8`](https://hackage.haskell.org/package/binary-0.8.7.0/docs/Data-Binary-Put.html#v:putStringUtf8)
26+-- | function from the Haskell
27+-- | [__binary__](https://hackage.haskell.org/package/bytestring-0.10.10.0/docs/Data-ByteString-Builder-Prim.html#v:primMapListBounded)
10−-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
29+-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/1.0.0/docs/Data.TextEncoding#v:encodeUtf8).
11−-- | in package __arraybuffer__.
30+-- | ```purescript
12−module Data.ArrayBuffer.Builder
31+-- | buf <- execPut $ do
13− ( PutM
32+-- | stringbuf <- = Data.ArrayBuffer.Typed.buffer $ encodeUtf8 "ACAB"
14− , Put
33+-- | -- Adds a 64-bit length prefix for the length of the utf8 string, in bytes
15− , execPutM
34+-- | putUint32be 0
16− , execPut
35+-- | putUint32be $ Data.ArrayBuffer.byteLength stringbuf
18− , putArrayBuffer
36+-- | putArrayBuffer stringbuf
19− , putDataView
37+-- | ```
35− , module Data.ArrayBuffer.Builder.Internal
38−import Prelude
39+module Build
40−import Control.Monad.Rec.Class (class MonadRec)
48+import Prelude
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)
47import Effect (Effect)
49import Effect (Effect)
48−import Effect.Class (class MonadEffect)
50+import Effect.Class (class MonadEffect, liftEffect)
51+import Data.UInt (UInt)
52+import Data.Maybe (Maybe(..))
53+import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)
50−-- | The `PutM` monad is a `WriterT Builder` transformer monad which
55+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
51−-- | gives us do-notation for the `Builder` monoid. The base monad must be
56+import Data.ArrayBuffer.ArrayBuffer as AB
52−-- | a `MonadEffect`.
57+import Data.ArrayBuffer.DataView as DV
53−-- |
58+import Data.ArrayBuffer.Typed as AT
54−-- | To append `Builder`s in this monad call `tell`, or any of the `put*`
59+
55−-- | functions in this module.
60+-- | Writer monad transformer for `Builder`.
56type PutM = WriterT Builder
61type PutM = WriterT Builder
58−-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
63+-- | `Put` monad is the non-transformer version of `PutM`.
59type Put = PutM Effect
64type Put = PutM Effect
61−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
66+ -- Note: use liftEffect to call the ArrayBuffer Effect functions
62−execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
63−execPutM = Internal.execBuilder <=< execWriterT
65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
68+-- | Builder for `ArrayBuffer`s.
66−execPut :: Put Unit -> Effect ArrayBuffer
69+-- |
67−execPut = execPutM
70+-- | It is common to build an `ArrayBuffer` by issuing a sequence of `put`
68−
71+-- | commands in a `Put` monad, and this is the case which the Builder monoid
69−-- | Build up a sub-`Builder` without `tell`ing it to the `Writer` yet.
72+-- | is optimized for.
74+-- | # Implementation Details
76+-- | Implements an unbalanced binary tree to get
77+-- | * *O(1)* `snoc` (add element to end)
78+-- | * *O(1)* monoid `append` (concatenation)
71−-- | One case where we might want to call a `subBuilder` is when
81+-- | For monoid `append`, what we actually get is *O(k)* where *k* is
72−-- | serializing length-prefixed messages in some protocol. In that case,
82+-- | proportional to the number of `append`s which have already been performed.
73−-- | we must serialize the message first, calculate the message length,
74−-- | append the message length, and then append the message.
76−-- | In a `PutM` monad do-block, we can
84+-- | `append`ing a singleton `Builder` to the right is treated as a `snoc`.
85+-- | Specifically, the special case of `append l r` where `r` has a `Null`
86+-- | left subtree doesn't increase *k*. So as long as we're right-appending
87+-- | singleton `Builder`s, then we still get *O(1)* `append`.
89+-- | `append` is O(n), in the worst case, if the `Builder` has been built
90+-- | entirely by `append`ing. If the Builder has been built mostly by
91+-- | `snoc`ing, then `append` approaches *O(1)*.
94+-- | If a Builder is built entirely by `snoc`ing, it will look like a
95+-- | left-only tree, a.k.a. a linked list.
80−-- | messageBuilder <- subBuilder $ do
99+-- | ╱
81−-- | putField1
100+-- | ⬤
82−-- | putField2
101+-- | ╱
107+-- | If two of these `snoc`-built trees are `append`ed, then the new tree
84−-- | putInt32be $ length messageBuilder
85−-- | tell messageBuilder
87−subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
111+-- | ⬤
122+-- | This is all similar to
123+-- | https://hackage.haskell.org/package/bytestring-tree-builder
124+-- | , except that the `Tree` https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree
125+-- | structure in __bytestring-tree-builder__ only carries values in its
126+-- | leaves, and therefore I think has an *O(n log(n))* fold. This `Builder`
127+-- | has an *O(n)* fold.
130+ = Node Builder ArrayBuffer Builder
133+instance semigroupBuilder :: Semigroup Builder where
134+ append Null Null = Null
137+ append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
138+ append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
140+ append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
141+ -- side of the left tree
142+ -- to find the rightmost
145+instance monoidBuilder :: Monoid Builder where
148+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
149+foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
151+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
153+-- | foldM : "Note this function is not generally stack-safe..." ???
154+foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
155+foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
157+singleton :: ArrayBuffer -> Builder
158+singleton buf = Node Null buf Null
160+-- | Add an ArrayBuffer to the end of the Builder.
161+snoc :: Builder -> ArrayBuffer -> Builder
162+snoc bs x = Node bs x Null
164+-- | Run a computation to build an `ArrayBuffer` in any `MonadEffect`.
165+execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
166+execPutM putmonad = do
88−subBuilder = lift <<< execWriterT
167+ bldr <- execWriterT putmonad
168+ let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
169+ -- Allocate the final ArrayBuffer
170+ buf <- liftEffect $ AB.empty buflen
171+ -- Then copy each ArrayBuffer into the final ArrayBuffer.
172+ -- To memcpy from one ArrayBuffer to another, apparently we have to first view
173+ -- both ArrayBuffers as ArrayView (Typed Array).
174+ newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
177+ let offset' = offset + AB.byteLength a
178+ aview <- liftEffect (AT.whole a :: Effect Uint8Array)
179+ _ <- liftEffect $ AT.setTyped newview (Just offset') aview
184+-- | Run a computation to build an `ArrayBuffer` in the `Effect` monad.
185+execPut :: Put Unit -> Effect ArrayBuffer
90-- | Append an `ArrayBuffer` to the builder.
188-- | Append an `ArrayBuffer` to the builder.
91−putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
189+putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
92−putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
190+putArrayBuffer = tell <<< singleton
94−-- | Append a `DataView` to the builder.
95−putDataView :: forall m. Monad m => DataView -> PutM m Unit
96−putDataView = tell <<< Internal.singleton <<< Internal.View
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
102-- | Append an 8-bit unsigned integer (byte) to the builder.
192-- | Append an 8-bit unsigned integer (byte) to the builder.
103−putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
193+putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
104−putUint8 = putArrayBuffer <=< Internal.encodeUint8
194+putUint8 x = do
105−
195+ buf <- liftEffect $ AB.empty 1
106−-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
196+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
107−putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
197+ tell $ singleton buf
108−putInt8 = putArrayBuffer <=< Internal.encodeInt8
110-- | Append a 16-bit big-endian unsigned integer to the builder.
199-- | Append a 16-bit big-endian unsigned integer to the builder.
111−putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
200+putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
112−putUint16be = putArrayBuffer <=< Internal.encodeUint16be
201+putUint16be x = do
202+ buf <- liftEffect $ AB.empty 2
203+ _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
204+ tell $ singleton buf
114-- | Append a 16-bit little-endian unsigned integer to the builder.
206-- | Append a 16-bit little-endian unsigned integer to the builder.
115−putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
207+putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
116−putUint16le = putArrayBuffer <=< Internal.encodeUint16le
208+putUint16le x = do
117−
209+ buf <- liftEffect $ AB.empty 2
118−-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
210+ _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
119−putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
211+ tell $ singleton buf
120−putInt16be = putArrayBuffer <=< Internal.encodeInt16be
212+
122−-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
213+-- | Append a 16-bit big-endian signed integer to the builder.
123−putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
214+putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
124−putInt16le = putArrayBuffer <=< Internal.encodeInt16le
215+putInt16be x = do
125−
216+ buf <- liftEffect $ AB.empty 2
126−-- | Append a 32-bit big-endian unsigned integer to the builder.
217+ _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
127−putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
218+ tell $ singleton buf
128−putUint32be = putArrayBuffer <=< Internal.encodeUint32be
219+
130−-- | Append a 32-bit little-endian unsigned integer to the builder.
220+-- | Append a 16-bit little-endian signed integer to the builder.
131−putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
221+putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
132−putUint32le = putArrayBuffer <=< Internal.encodeUint32le
222+putInt16le x = do
133−
223+ buf <- liftEffect $ AB.empty 2
134−-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
224+ _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
135−putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
225+ tell $ singleton buf
136−putInt32be = putArrayBuffer <=< Internal.encodeInt32be
138−-- | 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
142−-- | 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
146−-- | 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
150−-- | 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
154−-- | 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