git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on 1103087 help sign in
rowtype-yoga/purescript-arraybuffer-builder/src/Data/ArrayBuffer/Internal.purs
366 lines 13 kB history raw
1-- | Internal module.
2-- |
3-- | You probably don’t want to import anything from this module.
4-- |
5-- | ## Implementation Details
6-- |
7-- | We want our `Builder` to be a data structure with
8-- | * *O(1)* monoid append
9-- | * *O(n)* fold
10-- |
11-- | Our `Builder` implementation is an unbalanced binary tree.
12-- |
13-- | For monoid `append`, what we actually get is *O(1)* when either the
14-- | left or right tree is a singleton. If that's not true, then in the
15-- | unlikely worst case `append` might be *O(n)*.
16-- |
17-- | `Builder` is optimized for what we consider to be normal usage, that is,
18-- | `snoc`ing singleton elements to the end of the `Builder`.
19-- |
20-- | If a Builder is built entirely by `snoc`ing, it will look like a
21-- | left-only binary tree, a.k.a. a linked list.
22-- |
23-- | ```
24-- | ④
25-- | ╱
26-- | ③
27-- | ╱
28-- | ②
29-- | ╱
30-- | ①
31-- | ```
32-- |
33-- | If two of these `snoc`-built trees are `append`ed, then the new tree
34-- | will look like
35-- |
36-- | ```
37-- | ④
38-- | ╱ ╲
39-- | ③ ⑧
40-- | ╱ ╱
41-- | ② ⑦
42-- | ╱ ╱
43-- | ① ⑥
44-- | ╱
45-- | ⑤
46-- | ```
47-- |
48-- | This is all similar to
49-- | [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
50-- | , except that the
51-- | [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
52-- | structure in __bytestring-tree-builder__ only carries values in its
53-- | leaves, which is how it achieves consistent *O(1)* appending, at the cost of
54-- | a higher coefficient time factor on the fold.
55-- |
56-- | We hope that this implementation is fairly fast, since it is similar to
57-- | __bytestring-tree-builder__
58-- | which “according to the benchmarks … beats all the alternatives.”
59-- | However, we
60-- | haven’t chosen this implementation because it’s fast, we've chosen
61-- | this implementation because it’s simple.
62-- | If someone wants to create a fast PureScript `ArrayBuffer` serialization
63-- | library, then they can benchmark against this one to prove that the new
64-- | one is fast.
65-- |
66-- | One relatively cheap and simple performance improvement for this library would be to
67-- | remove the `Null` constructor of `Builder` and instead use Javascript nulls?
68-- |
69-- | In the longer term, it might make sense to try to change the `Builder` so
70-- | that it works like the
71-- | https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html .
72-- | That’s the approach taken by
73-- | https://pursuit.purescript.org/packages/purescript-dynamic-buffers .
74-- |
75-- | Here are some benchmarks of different Haskell ByteString builders
76-- | https://github.com/haskell-perf/strict-bytestring-builders
77-- |
78-- | We've tried to design the API for this library with minimal assumptions,
79-- | so that if we want to change the `Builder` implementation later then we can.
80-- |
81module Data.ArrayBuffer.Builder.Internal
82( Builder(..)
83, (<>>)
84, DataBuff(..)
85, toView
86, execBuilder
87, length
88, foldl
89, foldM
90, singleton
91, cons
92, snoc
93, encodeUint8
94, encodeInt8
95, encodeUint16be
96, encodeUint16le
97, encodeInt16be
98, encodeInt16le
99, encodeUint32be
100, encodeUint32le
101, encodeInt32be
102, encodeInt32le
103, encodeFloat32be
104, encodeFloat32le
105, encodeFloat64be
106, encodeFloat64le
108where
110import Prelude
112import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
113import Data.ArrayBuffer.ArrayBuffer as AB
114import Data.ArrayBuffer.DataView as DV
115import Data.ArrayBuffer.Typed as AT
116import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
117import Data.Float32 (Float32)
118import Data.Identity (Identity)
119import Data.List (List(..), uncons, (:))
120import Data.Maybe (Maybe(..))
121import Data.Newtype (unwrap)
122import Data.UInt (UInt)
123import Effect (Effect)
124import Effect.Class (class MonadEffect, liftEffect)
126-- | For distinguishing between `ArrayBuffer` and `DataView`.
127data DataBuff
128 = Buff ArrayBuffer
129 | View DataView
131-- Concerning DataViews.
132-- https://v8.dev/blog/dataview
134 -- | View the contents of `DataBuff` as a `DataView`.
135toView :: DataBuff -> DataView
136toView (Buff ab) = DV.whole ab
137toView (View dv) = dv
139-- | Monoidal builder for `ArrayBuffer`s.
140-- |
141-- | We can add two types of things to the `Builder`:
142-- | 1. `ArrayBuffer`
143-- | 2. `DataView`
144-- |
145-- | We might prefer
146-- | to add a `DataView` to a `Builder` when we’re adding a large slice of data
147-- | from some other `ArrayBuffer`, so that we don’t
148-- | need an extra intermediate copy of the slice.
149data Builder
150 = Node Builder DataBuff Builder
151 | Null
153-- | ### Left-associative `<>>` append operator
154-- |
155-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
156-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
157-- |
158-- | The `Builder` monoid in this library is efficient when we `snoc` single
159-- | items onto the end of it, or when we only `cons` single items to the
160-- | beginning, but it can be less efficient when we are mixing `cons` and
161-- | `snoc`.
162-- | Most of the time we want to `snoc`, but the `Semigroup` append
163-- | operator `<>` is right-associative,
164-- | which means it chains like `cons`.
165-- |
166-- | To solve this, we provide an operator `<>>` for appending `Builders`.
167-- | `<>>` is exactly the same as `<>`, but left-associative,
168-- | which means it chains like `snoc`.
169-- |
170-- | This __only matters__ when we're chaining together three
171-- | or more `Builder`s in a single associative expression.
172-- | Instead of
173-- | ```
174-- | builder₁ <> builder₂ <> builder₃
175-- | ```
176-- | we should always prefer to
177-- | write
178-- | ```
179-- | builder₁ <>> builder₂ <>> builder₃
180-- | ```
181-- | so that we get the efficient
182-- | `snoc`ing of `Builder`s.
183-- |
184-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
185-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
186-- | `snoc` case.
187-- |
188instance semigroupBuilder :: Semigroup Builder where
189 append Null Null = Null
190 append l Null = l
191 append Null r = r
192 append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
193 append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
194 -- of the left tree
195 append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
196 -- side of the left tree
197 -- to find the rightmost
198 -- Null
200infixl 5 append as <>>
202instance monoidBuilder :: Monoid Builder where
203 mempty = Null
205-- | Stack-safe `foldl` over a `Builder`. *O(n)*
206foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a
207foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b
209-- | Stack-safe `foldM` over a `Builder`. *O(n)*.
210foldM :: forall m a. MonadRec m => (a -> DataBuff -> m a) -> a -> Builder -> m a
211-- The Art of Computer Programming 2.3.1
212-- Inorder traversal using a stack
213-- https://yuyuan.org/MorrisAlgorithm/
214foldM f a0 b = tailRecM outer {p: b, stack: Nil, accum: a0}
215 where
216 outer {p,stack,accum} = do
217 stack' <- tailRecM inner {p_:p,stack_:stack}
218 case uncons stack' of
219 Nothing -> pure $ Done accum
220 Just {head: Node _ x r, tail} -> do
221 accum' <- f accum x
222 pure $ Loop {p: r, stack: tail, accum: accum'}
223 Just {head:Null} -> pure $ Done accum
224 inner {p_:Null,stack_} = pure $ Done stack_
225 inner {p_: n@(Node l _ _), stack_} = pure $ Loop {p_: l, stack_: n:stack_}
227-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
228singleton :: DataBuff -> Builder
229singleton buf = Node Null buf Null
231-- | Calculate the total byte length of the `Builder`, without actually
232-- | building it yet. *O(n)*
233length :: Builder -> ByteLength
234length bldr = foldl (\b a -> b + len a) 0 bldr
235 where
236 len (Buff ab) = AB.byteLength ab
237 len (View dv) = DV.byteLength dv
239-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
240cons :: DataBuff -> Builder -> Builder
241cons x bs = Node Null x bs
243-- | Append a `DataBuff` to the end of the `Builder`. *O(1)*
244snoc :: Builder -> DataBuff -> Builder
245snoc bs x = Node bs x Null
247-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
248execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer
249execBuilder bldr = do
250 let buflen = length bldr
251 -- Allocate the final ArrayBuffer
252 buf <- liftEffect $ AB.empty buflen
253 -- Then copy each ArrayBuffer into the final ArrayBuffer.
254 -- To memcpy from one ArrayBuffer to another, apparently we have to first view
255 -- both ArrayBuffers as ArrayView (Typed Array).
256 newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
257 _ <- foldM
258 ( \offset a -> do
259 aview <- liftEffect $ toUint8Array a
260 _ <- liftEffect $ AT.setTyped newview (Just offset) aview
261 pure $ offset + AT.byteLength aview
262 ) 0 bldr
263 pure buf
264 where
265 toUint8Array :: DataBuff -> Effect Uint8Array
266 toUint8Array (Buff ab) = AT.whole ab
267 toUint8Array (View dv) =
268 AT.part (DV.buffer dv) (DV.byteOffset dv) (DV.byteLength dv)
270-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
271encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
272encodeUint8 x = do
273 buf <- liftEffect $ AB.empty 1
274 _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
275 pure buf
277-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
278encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
279encodeInt8 x = do
280 buf <- liftEffect $ AB.empty 1
281 _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
282 pure buf
284-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
285encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
286encodeUint16be x = do
287 buf <- liftEffect $ AB.empty 2
288 _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
289 pure buf
291-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
292encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
293encodeUint16le x = do
294 buf <- liftEffect $ AB.empty 2
295 _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
296 pure buf
298-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
299encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
300encodeInt16be x = do
301 buf <- liftEffect $ AB.empty 2
302 _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
303 pure buf
305-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
306encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
307encodeInt16le x = do
308 buf <- liftEffect $ AB.empty 2
309 _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
310 pure buf
312-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
313encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
314encodeUint32be x = do
315 buf <- liftEffect $ AB.empty 4
316 _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
317 pure buf
319-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
320encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
321encodeUint32le x = do
322 buf <- liftEffect $ AB.empty 4
323 _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
324 pure buf
326-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
327encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
328encodeInt32be x = do
329 buf <- liftEffect $ AB.empty 4
330 _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
331 pure buf
333-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
334encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
335encodeInt32le x = do
336 buf <- liftEffect $ AB.empty 4
337 _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
338 pure buf
340-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
341encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
342encodeFloat32be x = do
343 buf <- liftEffect $ AB.empty 4
344 _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
345 pure buf
347-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
348encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
349encodeFloat32le x = do
350 buf <- liftEffect $ AB.empty 4
351 _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
352 pure buf
354-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
355encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
356encodeFloat64be x = do
357 buf <- liftEffect $ AB.empty 8
358 _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
359 pure buf
361-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
362encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
363encodeFloat64le x = do
364 buf <- liftEffect $ AB.empty 8
365 _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
366 pure buf