@@ -1,41 +1,225 @@
1−module Builder
1+-- | `ArrayBuffer` serialization primitives. (Not typeclass-based.)
2+-- |
3+-- | Provides a `Builder` monoid which is roughly equivalent to the
4+-- |
5+-- | Provides a `PutM` monad which is roughly equivalent to `PutM` from the
6+-- | Haskell __binary__ library.
7+-- |
8+-- | See purescript-parsing-dataview for deserialization.
9+-- |
10+-- | # Usage Examples
11+-- |
12+-- | All `ArrayBuffer` building must occur in `Effect`.
13+-- |
14+-- | ## Serialize an integer
15+-- |
16+-- | Create a two-byte `ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two's-complement.
17+-- | ```purescript
18+-- | buf <- execPut $ putInt32be (-2)
19+-- | ```
20+-- |
21+-- | ## Serialize a UTF8 string
22+-- |
23+-- | Create an `ArrayBuffer` which contains a `String` encoded as UTF8 in a way that's compatible
24+-- | with the
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)
28+-- | library.
29+-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/1.0.0/docs/Data.TextEncoding#v:encodeUtf8).
30+-- | ```purescript
31+-- | buf <- execPut $ do
32+-- | stringbuf <- = Data.ArrayBuffer.Typed.buffer $ encodeUtf8 "ACAB"
33+-- | -- Adds a 64-bit length prefix for the length of the utf8 string, in bytes
34+-- | putUint32be 0
35+-- | putUint32be $ Data.ArrayBuffer.byteLength stringbuf
36+-- | putArrayBuffer stringbuf
37+-- | ```
38+
39+module Build
240( Builder
41+, PutM
42+, Put
43+, execPutM
44+, execPut
345)
446where
547
6−import Data.ArrayBuffer.Types
48+import Prelude
49+import Effect (Effect)
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)
54+
55+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
56+import Data.ArrayBuffer.ArrayBuffer as AB
57+import Data.ArrayBuffer.DataView as DV
58+import Data.ArrayBuffer.Typed as AT
59+
60+-- | Writer monad transformer for `Builder`.
61+type PutM = WriterT Builder
62+
63+-- | `Put` monad is the non-transformer version of `PutM`.
64+type Put = PutM Effect
765
8−type PutM m a = forall m a. (MonadEffect m) => WriterT Builder m a
9−type Put = PutM Effect Unit
1066 -- Note: use liftEffect to call the ArrayBuffer Effect functions
1167
1268-- | Builder for `ArrayBuffer`s.
1369-- |
14−-- | It is common to build an `ArrayBuffer` by issuing a sequence of `tell`
15−-- | commands in a `WriterT Builder IO` monad.
70+-- | It is common to build an `ArrayBuffer` by issuing a sequence of `put`
71+-- | commands in a `Put` monad, and this is the case which the Builder monoid
72+-- | is optimized for.
73+-- |
74+-- | # Implementation Details
75+-- |
76+-- | Implements an unbalanced binary tree to get
77+-- | * *O(1)* `snoc` (add element to end)
78+-- | * *O(1)* monoid `append` (concatenation)
79+-- | * *O(n)* `fold`
80+-- |
81+-- | For monoid `append`, what we actually get is *O(k)* where *k* is
82+-- | proportional to the number of `append`s which have already been performed.
83+-- |
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`.
88+-- |
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)*.
92+-- |
93+-- |
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.
96+-- |
97+-- | ```
98+-- | ⬤
99+-- | ╱
100+-- | ⬤
101+-- | ╱
102+-- | ⬤
103+-- | ╱
104+-- | ⬤
105+-- | ```
106+-- |
107+-- | If two of these `snoc`-built trees are `append`ed, then the new tree
108+-- | will look like
109+-- |
110+-- | ```
111+-- | ⬤
112+-- | ╱ ╲
113+-- | ⬤ ⬤
114+-- | ╱ ╱
115+-- | ⬤ ⬤
116+-- | ╱ ╱
117+-- | ⬤ ⬤
118+-- | ╱
119+-- | ⬤
120+-- | ```
121+-- |
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.
16128-- |
17−-- | *O(1)* `mappend` and *O(1)* `snoc` and *O(n)* `fold`.
18129data Builder
19− = Node ArrayBuffer Builder Builder
130+ = Node Builder ArrayBuffer Builder
20131 | Null
21132
22133instance semigroupBuilder :: Semigroup Builder where
23134 append Null Null = Null
24135 append l Null = l
25136 append Null r = r
26− append (Node lx ll lr) (Node rx rl rr) = Node lx (Node )
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
139+ -- of the left tree
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
143+ -- Null
27144
28−-- data Builder
29−-- = Tree (Nullable Builder) (Nullable Builder)
30−-- | Leaf ArrayBuffer
31−--
32−-- instance semigroupBuilder :: Semigroup Builder where
33−-- append
145+instance monoidBuilder :: Monoid Builder where
146+ mempty = Null
34147
35−data Builder
36− = Tree Builder Builder
37− | Snoc Builder ArrayBuffer
38− | Nil
148+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
149+foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
150+foldl f a Null = a
151+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
152+
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)
156+
157+singleton :: ArrayBuffer -> Builder
158+singleton buf = Node Null buf Null
159+
160+-- | Add an ArrayBuffer to the end of the Builder.
161+snoc :: Builder -> ArrayBuffer -> Builder
162+snoc bs x = Node bs x Null
163+
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
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)
175+ _ <- foldM
176+ ( \offset a -> do
177+ let offset' = offset + AB.byteLength a
178+ aview <- liftEffect (AT.whole a :: Effect Uint8Array)
179+ _ <- liftEffect $ AT.setTyped newview (Just offset') aview
180+ pure offset'
181+ ) 0 bldr
182+ pure buf
183+
184+-- | Run a computation to build an `ArrayBuffer` in the `Effect` monad.
185+execPut :: Put Unit -> Effect ArrayBuffer
186+execPut = execPutM
187+
188+-- | Append an `ArrayBuffer` to the builder.
189+putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
190+putArrayBuffer = tell <<< singleton
191+
192+-- | Append an 8-bit unsigned integer (byte) to the builder.
193+putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
194+putUint8 x = do
195+ buf <- liftEffect $ AB.empty 1
196+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
197+ tell $ singleton buf
198+
199+-- | Append a 16-bit big-endian unsigned integer to the builder.
200+putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
201+putUint16be x = do
202+ buf <- liftEffect $ AB.empty 2
203+ _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
204+ tell $ singleton buf
205+
206+-- | Append a 16-bit little-endian unsigned integer to the builder.
207+putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
208+putUint16le x = do
209+ buf <- liftEffect $ AB.empty 2
210+ _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
211+ tell $ singleton buf
212+
213+-- | Append a 16-bit big-endian signed integer to the builder.
214+putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
215+putInt16be x = do
216+ buf <- liftEffect $ AB.empty 2
217+ _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
218+ tell $ singleton buf
39219
40−-- Note use `censor` instead of `tell` to accumulate, so we don't have to make
41−-- a dummy List and then strip it off.
220+-- | Append a 16-bit little-endian signed integer to the builder.
221+putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
222+putInt16le x = do
223+ buf <- liftEffect $ AB.empty 2
224+ _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
225+ tell $ singleton buf