git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on master help sign in
.github/workflows/ci.ymlnew file+46
since splitsnapshots
unifiedsplit
@@ -0,0 +1,46 @@
1+name: CI
2+
3+on:
4+ push:
5+ pull_request:
6+
7+jobs:
8+ build:
9+ runs-on: ubuntu-latest
10+
11+ steps:
12+ - uses: actions/checkout@v2
13+
14+ - name: Set up a PureScript toolchain
15+ uses: purescript-contrib/setup-purescript@main
16+ with:
17+ purescript: "unstable"
18+ purs-tidy: "latest"
19+
20+ - name: Cache PureScript dependencies
21+ uses: actions/cache@v2
22+ with:
23+ key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}-2
24+ path: |
25+ .spago
26+ output
27+ - name: Install dependencies
28+ run: spago install
29+
30+ - name: Build source
31+ run: spago build --no-install --purs-args '--censor-lib --strict --censor-codes='UserDefinedWarning''
32+
33+ - name: Install dev dependencies
34+ run: spago -x spago-dev.dhall install
35+
36+ - name: Run tests
37+ run: spago -x spago-dev.dhall test --no-install
38+
39+ - name: Check formatting
40+ run: purs-tidy check src test bench
41+
42+ - name: Verify Bower & Pulp
43+ run: |
44+ npm install bower pulp@16.0.0-0
45+ npx bower install
46+ npx pulp build -- --censor-lib --strict
.gitignore+3
@@ -4,3 +4,6 @@ output
4.psc-ide-port
4.psc-ide-port
5.purs-repl
5.purs-repl
6generated-docs
6generated-docs
7+bower_components
8+node_modules
9+package-lock.json
CHANGELOG.mdnew file+44
@@ -0,0 +1,44 @@
1+# Changelog
2+
3+## v3.1.0 2022-12-10
4+
5+- Transfer to __rowtype-yoga__.
6+- Docs.
7+
8+## v3.0.1 2022-05-04
9+
10+CI repair. Change `test.dhall` to `spago-dev.dhall`.
11+
12+## v3.0.0 2022-05-04
13+
14+Build for PureScript v0.15.
15+
16+Added `MonadRec` constraint to `execPut`, `execPutM`, `foldl`, `foldM`,
17+they are now stack-safe.
18+
19+## v2.1.0 2021-07-22
20+
21+Renamed `Data.ArrayBuffer.Internal.Bytes` and exported
22+it as `Data.ArrayBuffer.DataBuff`.
23+
24+## v2.0.0 2021-07-19
25+
26+Build for PureScript v0.14.
27+
28+### Breaking Changes
29+
30+Previously we could only add `ArrayBuffer`s to the `Builder`,
31+and now we can add either `ArrayBuffer` or `DataView` to the `Builder`,
32+because we have added a `Bytes` type which distinguishes between `ArrayBuffer`
33+and `DataView`. Because of this, we can avoid making an
34+intermediate `ArrayBuffer` copy when adding a slice of an existing `ArrayBuffer`.
35+
36+Factored out the `Internal` module and added documentation.
37+
38+## v1.1.0 2020-09-10
39+
40+Add and export
41+
42+* `cons :: ArrayBuffer -> Builder -> Builder`
43+* `subBuilder :: forall m. (MonadEffect m) => PutM m Unit -> PutM m Builder`
44+* `length :: Builder -> Int`
LICENSE.txtnew file+19
@@ -0,0 +1,19 @@
1+Copyright (c) 2020 James Dawson Brock
2+
3+Permission is hereby granted, free of charge, to any person obtaining a copy
4+of this software and associated documentation files (the "Software"), to deal
5+in the Software without restriction, including without limitation the rights
6+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
7+copies of the Software, and to permit persons to whom the Software is
8+furnished to do so, subject to the following conditions:
9+
10+The above copyright notice and this permission notice shall be included in all
11+copies or substantial portions of the Software.
12+
13+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
14+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
15+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
16+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
17+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
18+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
19+SOFTWARE.
README.md+142−1
@@ -1,3 +1,144 @@
1# purescript-arraybuffer-builder
1# purescript-arraybuffer-builder
2
2
3−run `nix-shell` and run `psc-package build`
3+[![CI](https://github.com/rowtype-yoga/purescript-arraybuffer-builder/workflows/CI/badge.svg?branch=master)](https://github.com/rowtype-yoga/purescript-arraybuffer-builder/actions)
4+[![Pursuit](http://pursuit.purescript.org/packages/purescript-arraybuffer-builder/badge)](http://pursuit.purescript.org/packages/purescript-arraybuffer-builder/)
5+[![Maintainer: jamesdbrock](https://img.shields.io/badge/maintainer-jamesdbrock-teal.svg)](https://github.com/jamesdbrock)
6+
7+
8+[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
9+serialization in the “builder monoid” and “builder monad” style.
10+In this style, we build up serialized data structures by `tell`ing to
11+a `Writer` monad with `do`-notation. This style of serialization
12+has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).
13+
14+This package provides a `Builder` monoid and a `PutM` monad which are roughly
15+equivalent to types of the same name in the Haskell
16+[__Data.Binary.Put__](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
17+module.
18+
19+## Usage Examples
20+
21+All `ArrayBuffer` building must occur in `Effect`.
22+
23+### Serialize an integer
24+
25+Create a two-byte `arraybuffer :: ArrayBuffer` which contains the number *-10* encoded as big-endian 16-bit two’s-complement.
26+```purescript
27+import Data.ArrayBuffer.Builder (execPut, putInt16be)
28+
29+do
30+ arraybuffer :: ArrayBuffer <- execPut $ putInt16be (-10)
31+```
32+
33+### Serialize three floats
34+
35+Create a 24-byte `arraybuffer :: ArrayBuffer` which contains three big-endian
36+IEEE-754 double-precision floats.
37+
38+```purescript
39+import Data.ArrayBuffer.Builder (execPut, putFloat64be)
40+
41+do
42+ arraybuffer :: ArrayBuffer <- execPut do
43+ putFloat64be 1.0
44+ putFloat64be 2.0
45+ putFloat64be 3.0
46+```
47+
48+### Serialize a `String` as UTF8
49+
50+Encode a `String` as UTF8 with a length prefix into our `Builder`.
51+
52+We give this as an example, rather than supporting it in the library, because
53+it depends on
54+[`Web.Encoding.TextEncoder`](https://pursuit.purescript.org/packages/purescript-web-encoding/docs/Web.Encoding.TextEncoder).
55+
56+```purescript
57+import Effect.Class (class MonadEffect, liftEffect)
58+import Data.UInt (fromInt)
59+import Data.ArrayBuffer.Types (ArrayBuffer(..))
60+import Data.ArrayBuffer.Builder (PutM, putArrayBuffer, execPut, putUint32be)
61+import Data.ArrayBuffer.Typed (buffer)
62+import Data.ArrayBuffer.ArrayBuffer (byteLength)
63+import Web.Encoding.TextEncoder (new, TextEncoder, encode)
64+
65+putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
66+putStringUtf8 s = do
67+ textEncoder <- liftEffect new
68+ let stringbuf = buffer $ encode s textEncoder
69+ -- Put a 32-bit big-endian length for the utf8 string, in bytes.
70+ putUint32be $ fromInt $ byteLength stringbuf
71+ putArrayBuffer stringbuf
72+
73+arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
74+```
75+
76+### Serialize an `Array Int`
77+
78+Encode an `Array Int` with a length prefix in a
79+way that's compatible with the
80+[`Binary` instance for `[Int32]`](https://hackage.haskell.org/package/binary/docs/Data-Binary.html#t:Binary)
81+from the Haskell
82+[__binary__](https://hackage.haskell.org/package/binary)
83+library.
84+
85+```purescript
86+import Data.ArrayBuffer.Builder (execPut, putInt32be)
87+import Data.Foldable (traverse_)
88+import Data.Array (length)
89+
90+putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit
91+putArrayInt32 xs = do
92+ -- Put a 64-bit big-endian length prefix for the array.
93+ putInt32be 0
94+ putInt32be $ length xs
95+ traverse_ putInt32be xs
96+
97+do
98+ arraybuffer <- execPut $ putArrayInt32 [1,2,3]
99+```
100+
101+### Serialize an `Array Int` stack-safe
102+
103+Stack-safe version of the `putArrayInt32` function above. For stack-safety
104+we use `foldRecM` instead of `traverse_` because `foldRecM` has a `MonadRec`
105+constraint which makes it stack-safe.
106+
107+```purescript
108+import Data.Array (foldRecM)
109+
110+putArrayInt32 :: forall m. MonadEffect m => MonadRec m => Array Int -> PutM m Unit
111+putArrayInt32 xs = do
112+ -- Put a 64-bit big-endian length prefix for the array.
113+ putInt32be 0
114+ putInt32be $ length xs
115+ foldRecM (\_ x -> putInt32be x) unit xs
116+```
117+
118+## Stack-safety
119+
120+This package will always be stack-safe if all of the functions called inside
121+of the `PutM` builder expression are stack-safe.
122+
123+## Deserialization
124+
125+This package is only for writing `ArrayBuffer`s, not reading them.
126+See
127+[__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
128+for a way to deserialize from `ArrayBuffer` back to Purescript data.
129+
130+## Alternative packages for serializing to an `ArrayBuffer`
131+
132+* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
133+* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
134+* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
135+* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)
136+* [__array-builder__](https://pursuit.purescript.org/packages/purescript-array-builder)
137+
138+## Development
139+
140+To run the tests,
141+
142+```shell
143+spago -x spago-dev.dhall test
144+```
bower.jsonnew file+30
@@ -0,0 +1,30 @@
1+{
2+ "name": "purescript-arraybuffer-builder",
3+ "license": [
4+ "MIT"
5+ ],
6+ "repository": {
7+ "type": "git",
8+ "url": "https://github.com/jamesdbrock/purescript-arraybuffer-builder"
9+ },
10+ "ignore": [
11+ "**/.*",
12+ "node_modules",
13+ "bower_components",
14+ "output"
15+ ],
16+ "dependencies": {
17+ "purescript-arraybuffer": "^v13.1.1",
18+ "purescript-arraybuffer-types": "^v3.0.2",
19+ "purescript-effect": "^v4.0.0",
20+ "purescript-float32": "^v2.0.0",
21+ "purescript-identity": "^v6.0.0",
22+ "purescript-lists": "^v7.0.0",
23+ "purescript-maybe": "^v6.0.0",
24+ "purescript-newtype": "^v5.0.0",
25+ "purescript-prelude": "^v6.0.1",
26+ "purescript-tailrec": "^v6.1.0",
27+ "purescript-transformers": "^v6.0.0",
28+ "purescript-uint": "^v7.0.0"
29+ }
30+}
packages.dhall+2−3
@@ -116,10 +116,9 @@ let additions =
116 }
116 }
117-------------------------------
117-------------------------------
118-}
118-}
119−
120−
121let upstream =
119let upstream =
122− https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20200708/packages.dhall sha256:df5b0f1ae92d4401404344f4fb2a7a3089612c9f30066dcddf9eaea4fe780e29
120+ https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.4-20221209/src/packages.dhall
121+ sha256:b55c24bf585df4041ae6e87124cab7b35d474a9a77c9c3862ee6bf1dae618d72
123
122
124let overrides = {=}
123let overrides = {=}
125
124
psc-package.jsondeleted−9
@@ -1,9 +0,0 @@
1−{
2− "name": "purescript-arraybuffer-builder",
3− "set": "psc-0.13.8",
4− "source": "https://github.com/purescript/package-sets.git",
5− "depends": [
6− "arraybuffer-types",
7− "arraybuffer"
8− ]
9−}
shell.nixdeleted−19
@@ -1,19 +0,0 @@
1−{ pkgs ? import <nixpkgs> { } }:
2−let
3− easy-ps = import
4− (pkgs.fetchFromGitHub {
5− owner = "justinwoo";
6− repo = "easy-purescript-nix";
7− rev = "0ba91d9aa9f7421f6bfe4895677159a8a999bf20";
8− sha256 = "1baq7mmd3vjas87f0gzlq83n2l1h3dlqajjqr7fgaazpa9xgzs7q";
9− }) {
10− inherit pkgs;
11− };
12−in
13−pkgs.mkShell {
14− buildInputs = [
15− easy-ps.purs-0_13_8
16− easy-ps.psc-package
17− easy-ps.spago
18− ];
19−}
spago-dev.dhallnew file+20
@@ -0,0 +1,20 @@
1+-- Spago configuration for running the tests
2+--
3+-- See:
4+-- https://github.com/purescript/spago#devdependencies-testdependencies-or-in-general-a-situation-with-many-configurations
5+--
6+-- Usage:
7+--
8+-- spago -x test.dhall test
9+--
10+
11+let conf = ./spago.dhall
12+
13+in conf //
14+ { sources = conf.sources # [ "test/**/*.purs" ]
15+ , dependencies = conf.dependencies #
16+ [ "assert"
17+ , "arrays"
18+ , "web-encoding"
19+ ]
20+ }
spago.dhall+15−5
@@ -1,12 +1,22 @@
1{-
1{-
2−Welcome to a Spago project!
3−You can edit this file as you like.
4-}
2-}
5−{ name = "purescript-arraybuffer-builder"
3+{ name = "arraybuffer-builder"
6, dependencies =
4, dependencies =
5+ [ "effect"
6+ , "float32"
7+ , "identity"
8+ , "lists"
9+ , "maybe"
10+ , "newtype"
11+ , "prelude"
12+ , "transformers"
13+ , "uint"
7− [ "arraybuffer-types"
14+ , "arraybuffer-types"
8 , "arraybuffer"
15 , "arraybuffer"
16+ , "tailrec"
9 ]
17 ]
10, packages = ./packages.dhall
18, packages = ./packages.dhall
11−, sources = [ "src/**/*.purs", "test/**/*.purs" ]
19+, sources = [ "src/**/*.purs" ]
20+, license = "MIT"
21+, repository = "https://github.com/jamesdbrock/purescript-arraybuffer-builder"
12}
22}
src/Data/ArrayBuffer/Builder.purs+106−413
@@ -1,463 +1,156 @@
1−-- | `ArrayBuffer` serialization in the “builder monoid” style.
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.
2-- |
4-- |
3−-- | This module provides a `Builder` monoid and a `PutM` monad which are roughly
5+-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
4−-- | equivalent to types of the same name in the Haskell
6+-- | functions in this module must be run in a `MonadEffect` context.
5−-- | [`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
6−-- | module.
7-- |
7-- |
8−-- | This library defines no typeclasses.
8+-- | For other operations for working with `ArrayBuffer`, see
9−-- |
9+-- | module
10−-- | ## Deserialization
10+-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
11−-- |
11+-- | in package __arraybuffer__.
12−-- | See
13−-- | [__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
14−-- | for a way to deserialize from `ArrayBuffer` back to Purescript data.
15−-- |
16−-- | ## Usage Examples
17−-- |
18−-- | All `ArrayBuffer` building must occur in `Effect`.
19−-- |
20−-- | ### Serialize an integer
21−-- |
22−-- | Create a two-byte `arraybuffer :: ArrayBuffer` which contains the number *-2* encoded as big-endian 16-bit two’s-complement.
23−-- | ```purescript
24−-- | do
25−-- | arraybuffer <- execPut $ putInt16be (-2)
26−-- | ```
27−-- |
28−-- | ### Serialize a `String` as UTF8
29−-- |
30−-- | A function which encodes a `String` as UTF8 with a length prefix in a
31−-- | way that's compatible with the
32−-- | [`Binary.Put.putStringUtf8`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html#v:putStringUtf8)
33−-- | function from the Haskell
34−-- | [__binary__](https://hackage.haskell.org/package/binary)
35−-- | library.
36−-- | Uses [`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).
37−-- | ```purescript
38−-- | putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit
39−-- | putStringUtf8 s = do
40−-- | let stringbuf = Data.ArrayBuffer.Typed.buffer $
41−-- | Data.TextEncoding.encodeUtf8 s
42−-- | -- Put a 64-bit big-endian length prefix for the length of the utf8
43−-- | -- string, in bytes.
44−-- | putUint32be 0
45−-- | putUint32be $ Data.Uint.fromInt $ Data.ArrayBuffer.byteLength stringbuf
46−-- | putArrayBuffer stringbuf
47−-- | ```
48−-- |
49−-- | ### Serialize an `Array Int`
50−-- |
51−-- | A function which encodes an `Array Int` with a length prefix in a
52−-- | way that's compatible with the
53−-- | [`Binary` instance for `[Int32]`](https://hackage.haskell.org/package/binary/docs/Data-Binary.html#t:Binary)
54−-- | from the Haskell
55−-- | [__binary__](https://hackage.haskell.org/package/binary)
56−-- | library.
57−-- | ```purescript
58−-- | putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit
59−-- | putArrayInt32 xs = do
60−-- | -- Put a 64-bit big-endian length prefix for the length of the
61−-- | -- array, in bytes.
62−-- | putUint32be 0
63−-- | putUint32be $ Data.Uint.fromInt $ Data.Array.length xs
64−-- | traverse_ putInt32be xs
65−-- | ```
66module Data.ArrayBuffer.Builder
12module Data.ArrayBuffer.Builder
67−( PutM
13+ ( PutM
68−, Put
14+ , Put
69−, execPutM
15+ , execPutM
70−, execPut
16+ , execPut
17+ , subBuilder
71−, putArrayBuffer
18+ , putArrayBuffer
19+ , putDataView
20+ , putDataBuff
72−, putUint8
21+ , putUint8
73−, putInt8
22+ , putInt8
74−, putUint16be
23+ , putUint16be
75−, putUint16le
24+ , putUint16le
76−, putInt16be
25+ , putInt16be
77−, putInt16le
26+ , putInt16le
78−, putUint32be
27+ , putUint32be
79−, putUint32le
28+ , putUint32le
80−, putInt32be
29+ , putInt32be
81−, putInt32le
30+ , putInt32le
82−, putFloat32be
31+ , putFloat32be
83−, putFloat32le
32+ , putFloat32le
84−, putFloat64be
33+ , putFloat64be
85−, putFloat64le
34+ , putFloat64le
86−, Builder
35+ , module Data.ArrayBuffer.Builder.Internal
87−, (<>>)
88−, execBuilder
89−, singleton
90−, snoc
91−, encodeUint8
92−, encodeInt8
93−, encodeUint16be
94−, encodeUint16le
95−, encodeInt16be
96−, encodeInt16le
97−, encodeUint32be
98−, encodeUint32le
99−, encodeInt32be
100−, encodeInt32le
101−, encodeFloat32be
102−, encodeFloat32le
103−, encodeFloat64be
104−, encodeFloat64le
105−)
106−where
36+ ) where
107
37
108import Prelude
38import Prelude
109
39
40+import Control.Monad.Rec.Class (class MonadRec)
110−import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)
41+import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
111−import Data.ArrayBuffer.ArrayBuffer as AB
42+import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
112−import Data.ArrayBuffer.DataView as DV
113−import Data.ArrayBuffer.Typed as AT
43+import Data.ArrayBuffer.Builder.Internal as Internal
114−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
44+import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
115import Data.Float32 (Float32)
45import Data.Float32 (Float32)
116−import Data.Maybe (Maybe(..))
117import Data.UInt (UInt)
46import Data.UInt (UInt)
118import Effect (Effect)
47import Effect (Effect)
119−import Effect.Class (class MonadEffect, liftEffect)
48+import Effect.Class (class MonadEffect)
120
49
121−-- | The `PutM` monad is a Writer transformer monad which
50+-- | The `PutM` monad is a `WriterT Builder` transformer monad which
122−-- | [gives us access to do-notation](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design)
51+-- | gives us do-notation for the `Builder` monoid. The base monad must be
123−-- | for building `ArrayBuffer`s.
52+-- | a `MonadEffect`.
53+-- |
54+-- | To append `Builder`s in this monad call `tell`, or any of the `put*`
55+-- | functions in this module.
124type PutM = WriterT Builder
56type PutM = WriterT Builder
125
57
126−-- | `Put` monad is the non-transformer version of `PutM`.
58+-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
127type Put = PutM Effect
59type Put = PutM Effect
128
60
129−-- | Monoidal builder for `ArrayBuffer`s.
61+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
130−-- |
62+execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
131−-- | ### Left-associative `<>>` append operator
63+execPutM = Internal.execBuilder <=< execWriterT
64+
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.
132-- |
70-- |
133−-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
71+-- | One case where we might want to call a `subBuilder` is when
134−-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
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.
135-- |
75-- |
136−-- | The `Builder` monoid in this library is efficient when we `snoc` single
76+-- | In a `PutM` monad do-block, we can
137−-- | items onto the end of it, or when we only `cons` single items to the
138−-- | beginning, but it can be less efficient when we are mixing `cons` and
139−-- | `snoc`.
140−-- | This matters when we're appending three or more `Builder`s
141−-- | in one associative expression, because the
142−-- | `Semigroup` append operator `<>` is right-associative.
143-- |
77-- |
144−-- | To solve this, we provide an operator `<>>` for appending `Builders`.
145−-- | `<>>` is exactly the same as `<>`, but left-associative.
146−-- | This only matters when we're chaining together three
147−-- | or more `Builder`s in a single associative expression.
148−-- | Instead of
149−-- | ```
150−-- | builder₁ <> builder₂ <> builder₃
151−-- | ```
152−-- | we should always prefer to
153−-- | write
154−-- | ```
155−-- | builder₁ <>> builder₂ <>> builder₃
156-- | ```
78-- | ```
157−-- | so that we get the efficient
79+-- | do
158−-- | `snoc`ing of `Builder`s.
80+-- | messageBuilder <- subBuilder $ do
159−-- |
81+-- | putField1
160−-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
82+-- | putField2
161−-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
162−-- | `snoc` case.
163-- |
83-- |
164−data Builder
84+-- | putInt32be $ length messageBuilder
165− = Node Builder ArrayBuffer Builder
85+-- | tell messageBuilder
166− | Null
86+-- | ```
167−
87+subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
168−instance semigroupBuilder :: Semigroup Builder where
169− append Null Null = Null
170− append l Null = l
171− append Null r = r
172− append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
173− append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
174− -- of the left tree
175− append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
176− -- side of the left tree
177− -- to find the rightmost
178− -- Null
179−
180−infixl 5 append as <>>
181−
182−instance monoidBuilder :: Monoid Builder where
183− mempty = Null
184−
185−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
186−foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
187−foldl f a Null = a
188−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
189−
190−-- | Monomorphic foldM copied from
191−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
192−foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
193−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
194−
195−-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
196−singleton :: ArrayBuffer -> Builder
197−singleton buf = Node Null buf Null
198−
199−-- | Add an `ArrayBuffer` to the end of the `Builder`. *O(1)*
200−snoc :: Builder -> ArrayBuffer -> Builder
201−snoc bs x = Node bs x Null
202−
203−-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
204−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
205−execBuilder bldr = do
206− let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
207− -- Allocate the final ArrayBuffer
208− buf <- liftEffect $ AB.empty buflen
209− -- Then copy each ArrayBuffer into the final ArrayBuffer.
210− -- To memcpy from one ArrayBuffer to another, apparently we have to first view
211− -- both ArrayBuffers as ArrayView (Typed Array).
212− newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
213− _ <- foldM
214− ( \offset a -> do
215− let offset' = offset + AB.byteLength a
216− aview <- liftEffect (AT.whole a :: Effect Uint8Array)
217− _ <- liftEffect $ AT.setTyped newview (Just offset') aview
218− pure offset'
219− ) 0 bldr
220− pure buf
221−
222−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
223−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
224−execPutM = execBuilder <=< execWriterT
88+subBuilder = lift <<< execWriterT
225−
226−-- | Build an `ArrayBuffer` with do-notation. *O(n)*
227−execPut :: Put Unit -> Effect ArrayBuffer
228−execPut = execPutM
229
89
230-- | Append an `ArrayBuffer` to the builder.
90-- | Append an `ArrayBuffer` to the builder.
231−putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
91+putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
232−putArrayBuffer = tell <<< singleton
92+putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
233
93
234−-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
94+-- | Append a `DataView` to the builder.
235−encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
95+putDataView :: forall m. Monad m => DataView -> PutM m Unit
236−encodeUint8 x = do
96+putDataView = tell <<< Internal.singleton <<< Internal.View
237− buf <- liftEffect $ AB.empty 1
238− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
239− pure buf
240
97
241−-- | Append an 8-bit unsigned integer (byte) to the builder.
98+-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
242−putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
99+putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
243−putUint8 = putArrayBuffer <=< encodeUint8
100+putDataBuff = tell <<< Internal.singleton
244
101
245−-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
102+-- | Append an 8-bit unsigned integer (byte) to the builder.
246−encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
103+putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
247−encodeInt8 x = do
104+putUint8 = putArrayBuffer <=< Internal.encodeUint8
248− buf <- liftEffect $ AB.empty 1
249− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
250− pure buf
251
105
252-- | 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.
253−putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
107+putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
254−putInt8 = putArrayBuffer <=< encodeInt8
108+putInt8 = putArrayBuffer <=< Internal.encodeInt8
255−
256−-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
257−encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
258−encodeUint16be x = do
259− buf <- liftEffect $ AB.empty 2
260− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
261− pure buf
262
109
263-- | Append a 16-bit big-endian unsigned integer to the builder.
110-- | Append a 16-bit big-endian unsigned integer to the builder.
264−putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
111+putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
265−putUint16be = putArrayBuffer <=< encodeUint16be
112+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
266−
267−-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
268−encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
269−encodeUint16le x = do
270− buf <- liftEffect $ AB.empty 2
271− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
272− pure buf
273
113
274-- | Append a 16-bit little-endian unsigned integer to the builder.
114-- | Append a 16-bit little-endian unsigned integer to the builder.
275−putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
115+putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
276−putUint16le = putArrayBuffer <=< encodeUint16le
116+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
277−
278−-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
279−encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
280−encodeInt16be x = do
281− buf <- liftEffect $ AB.empty 2
282− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
283− pure buf
284
117
285-- | 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.
286−putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
119+putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
287−putInt16be = putArrayBuffer <=< encodeInt16be
120+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
288−
289−-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
290−encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
291−encodeInt16le x = do
292− buf <- liftEffect $ AB.empty 2
293− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
294− pure buf
295
121
296-- | 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.
297−putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
123+putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
298−putInt16le = putArrayBuffer <=< encodeInt16le
124+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
299−
300−-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
301−encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
302−encodeUint32be x = do
303− buf <- liftEffect $ AB.empty 4
304− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
305− pure buf
306
125
307-- | Append a 32-bit big-endian unsigned integer to the builder.
126-- | Append a 32-bit big-endian unsigned integer to the builder.
308−putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
127+putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
309−putUint32be = putArrayBuffer <=< encodeUint32be
128+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
310−
311−-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
312−encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
313−encodeUint32le x = do
314− buf <- liftEffect $ AB.empty 4
315− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
316− pure buf
317
129
318-- | Append a 32-bit little-endian unsigned integer to the builder.
130-- | Append a 32-bit little-endian unsigned integer to the builder.
319−putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
131+putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
320−putUint32le = putArrayBuffer <=< encodeUint32le
132+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
321−
322−-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
323−encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
324−encodeInt32be x = do
325− buf <- liftEffect $ AB.empty 4
326− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
327− pure buf
328
133
329-- | 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.
330−putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
135+putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
331−putInt32be = putArrayBuffer <=< encodeInt32be
136+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
332−
333−-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
334−encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
335−encodeInt32le x = do
336− buf <- liftEffect $ AB.empty 4
337− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
338− pure buf
339
137
340-- | 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.
341−putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
139+putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
342−putInt32le = putArrayBuffer <=< encodeInt32le
140+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
343−
344−-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
345−encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
346−encodeFloat32be x = do
347− buf <- liftEffect $ AB.empty 4
348− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
349− pure buf
350
141
351-- | 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.
352−putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
143+putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
353−putFloat32be = putArrayBuffer <=< encodeFloat32be
144+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
354−
355−-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
356−encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
357−encodeFloat32le x = do
358− buf <- liftEffect $ AB.empty 4
359− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
360− pure buf
361
145
362-- | 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.
363−putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
147+putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
364−putFloat32le = putArrayBuffer <=< encodeFloat32le
148+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
365−
366−-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
367−encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
368−encodeFloat64be x = do
369− buf <- liftEffect $ AB.empty 8
370− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
371− pure buf
372
149
373-- | 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.
374−putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
151+putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
375−putFloat64be = putArrayBuffer <=< encodeFloat64be
152+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
376−
377−-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
378−encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
379−encodeFloat64le x = do
380− buf <- liftEffect $ AB.empty 8
381− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
382− pure buf
383
153
384-- | 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.
385−putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
155+putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
386−putFloat64le = putArrayBuffer <=< encodeFloat64le
156+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
387−
388−
389−-- | ## Implementation Details
390−-- |
391−-- | We want our `Builder` to be a data structure with
392−-- | * *O(1)* monoid append
393−-- | * *O(n)* fold
394−-- |
395−-- | Our `Builder` implementation is an unbalanced binary tree.
396−-- |
397−-- | For monoid `append`, what we actually get is *O(1)* when either the
398−-- | left or right tree is a singleton. If that's not true, then in the
399−-- | unlikely worst case `append` might be *O(n)*.
400−-- |
401−-- | `Builder` is optimized what we consider to be normal usage, that is,
402−-- | `snoc`ing singleton elements to the end of the `Builder`.
403−-- |
404−-- | If a Builder is built entirely by `snoc`ing, it will look like a
405−-- | left-only binary tree, a.k.a. a linked list.
406−-- |
407−-- | ```
408−-- | ④
409−-- | ╱
410−-- | ③
411−-- | ╱
412−-- | ②
413−-- | ╱
414−-- | ①
415−-- | ```
416−-- |
417−-- | If two of these `snoc`-built trees are `append`ed, then the new tree
418−-- | will look like
419−-- |
420−-- | ```
421−-- | ④
422−-- | ╱ ╲
423−-- | ③ ⑧
424−-- | ╱ ╱
425−-- | ② ⑦
426−-- | ╱ ╱
427−-- | ① ⑥
428−-- | ╱
429−-- | ⑤
430−-- | ```
431−-- |
432−-- | This is all similar to
433−-- | [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
434−-- | , except that the
435−-- | [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
436−-- | structure in __bytestring-tree-builder__ only carries values in its
437−-- | leaves, which is how it achieves *O(1)* appending, at the cost of
438−-- | a higher coefficient time factor on the fold.
439−-- |
440−-- | We hope that this implementation is fairly fast, but we
441−-- | haven't chosen this implementation because it's fast, we've chosen
442−-- | this implementation because it's simple.
443−-- | The only currently existing Purescript libary which does ArrayBuffer
444−-- | serialization is
445−-- | https://pursuit.purescript.org/packages/purescript-arraybuffer-class
446−-- | , and that library is heavily typeclass-based and designed
447−-- | for compatibility with the Haskell cereal library.
448−-- | If someone wants to create a fast Purescript ArrayBuffer serialization
449−-- | library, then they can benchmark against this one to prove that the new
450−-- | one is fast.
451−-- |
452−-- | One relatively cheap and simple performance improvement for this library would be to
453−-- | remove the Null constructor of `Builder` and instead use Javascript nulls.
454−-- |
455−-- | In the longer term, it might make sense to try to change the Builder so
456−-- | that it works like the
457−-- | https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
458−-- |
459−-- | Here are some benchmarks of different Haskell ByteString builders
460−-- | https://github.com/haskell-perf/strict-bytestring-builders
461−-- |
462−-- | We've tried to design the API for this library with minimal assumptions,
463−-- | so that if we want to change the Builder implementation later then we can.
src/Data/ArrayBuffer/Internal.pursnew file+368
@@ -0,0 +1,368 @@
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+-- |
81+module 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
107+ ) where
108+
109+import Prelude
110+
111+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
112+import Data.ArrayBuffer.ArrayBuffer as AB
113+import Data.ArrayBuffer.DataView as DV
114+import Data.ArrayBuffer.Typed as AT
115+import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
116+import Data.Float32 (Float32)
117+import Data.Identity (Identity)
118+import Data.List (List(..), uncons, (:))
119+import Data.Maybe (Maybe(..))
120+import Data.Newtype (unwrap)
121+import Data.UInt (UInt)
122+import Effect (Effect)
123+import Effect.Class (class MonadEffect, liftEffect)
124+
125+-- | For distinguishing between `ArrayBuffer` and `DataView`.
126+data DataBuff
127+ = Buff ArrayBuffer
128+ | View DataView
129+
130+-- Concerning DataViews.
131+-- https://v8.dev/blog/dataview
132+
133+-- | View the contents of `DataBuff` as a `DataView`.
134+toView :: DataBuff -> DataView
135+toView (Buff ab) = DV.whole ab
136+toView (View dv) = dv
137+
138+-- | Monoidal builder for `ArrayBuffer`s.
139+-- |
140+-- | We can add two types of things to the `Builder`:
141+-- | 1. `ArrayBuffer`
142+-- | 2. `DataView`
143+-- |
144+-- | We might prefer
145+-- | to add a `DataView` to a `Builder` when we’re adding a large slice of data
146+-- | from some other `ArrayBuffer`, so that we don’t
147+-- | need an extra intermediate copy of the slice.
148+data Builder
149+ = Node Builder DataBuff Builder
150+ | Null
151+
152+-- | ### Left-associative `<>>` append operator
153+-- |
154+-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
155+-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
156+-- |
157+-- | The `Builder` monoid in this library is efficient when we `snoc` single
158+-- | items onto the end of it, or when we only `cons` single items to the
159+-- | beginning, but it can be less efficient when we are mixing `cons` and
160+-- | `snoc`.
161+-- | Most of the time we want to `snoc`, but the `Semigroup` append
162+-- | operator `<>` is right-associative,
163+-- | which means it chains like `cons`.
164+-- |
165+-- | To solve this, we provide an operator `<>>` for appending `Builders`.
166+-- | `<>>` is exactly the same as `<>`, but left-associative,
167+-- | which means it chains like `snoc`.
168+-- |
169+-- | This __only matters__ when we're chaining together three
170+-- | or more `Builder`s in a single associative expression.
171+-- | Instead of
172+-- | ```
173+-- | builder₁ <> builder₂ <> builder₃
174+-- | ```
175+-- | we should always prefer to
176+-- | write
177+-- | ```
178+-- | builder₁ <>> builder₂ <>> builder₃
179+-- | ```
180+-- | so that we get the efficient
181+-- | `snoc`ing of `Builder`s.
182+-- |
183+-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
184+-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
185+-- | `snoc` case.
186+-- |
187+instance semigroupBuilder :: Semigroup Builder where
188+ append Null Null = Null
189+ append l Null = l
190+ append Null r = r
191+ append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
192+ append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
193+ -- of the left tree
194+ append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
195+
196+-- side of the left tree
197+-- to find the rightmost
198+-- Null
199+
200+infixl 5 append as <>>
201+
202+instance monoidBuilder :: Monoid Builder where
203+ mempty = Null
204+
205+-- | Stack-safe `foldl` over a `Builder`. *O(n)*
206+foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a
207+foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b
208+
209+-- | Stack-safe `foldM` over a `Builder`. *O(n)*.
210+foldM :: 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/
214+foldM 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_ }
226+
227+-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
228+singleton :: DataBuff -> Builder
229+singleton buf = Node Null buf Null
230+
231+-- | Calculate the total byte length of the `Builder`, without actually
232+-- | building it yet. *O(n)*
233+length :: Builder -> ByteLength
234+length 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
238+
239+-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
240+cons :: DataBuff -> Builder -> Builder
241+cons x bs = Node Null x bs
242+
243+-- | Append a `DataBuff` to the end of the `Builder`. *O(1)*
244+snoc :: Builder -> DataBuff -> Builder
245+snoc bs x = Node bs x Null
246+
247+-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
248+execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer
249+execBuilder 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+ )
263+ 0
264+ bldr
265+ pure buf
266+ where
267+ toUint8Array :: DataBuff -> Effect Uint8Array
268+ toUint8Array (Buff ab) = AT.whole ab
269+ toUint8Array (View dv) =
270+ AT.part (DV.buffer dv) (DV.byteOffset dv) (DV.byteLength dv)
271+
272+-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
273+encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
274+encodeUint8 x = do
275+ buf <- liftEffect $ AB.empty 1
276+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
277+ pure buf
278+
279+-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
280+encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
281+encodeInt8 x = do
282+ buf <- liftEffect $ AB.empty 1
283+ _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
284+ pure buf
285+
286+-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
287+encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
288+encodeUint16be x = do
289+ buf <- liftEffect $ AB.empty 2
290+ _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
291+ pure buf
292+
293+-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
294+encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
295+encodeUint16le x = do
296+ buf <- liftEffect $ AB.empty 2
297+ _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
298+ pure buf
299+
300+-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
301+encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
302+encodeInt16be x = do
303+ buf <- liftEffect $ AB.empty 2
304+ _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
305+ pure buf
306+
307+-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
308+encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
309+encodeInt16le x = do
310+ buf <- liftEffect $ AB.empty 2
311+ _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
312+ pure buf
313+
314+-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
315+encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
316+encodeUint32be x = do
317+ buf <- liftEffect $ AB.empty 4
318+ _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
319+ pure buf
320+
321+-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
322+encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
323+encodeUint32le x = do
324+ buf <- liftEffect $ AB.empty 4
325+ _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
326+ pure buf
327+
328+-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
329+encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
330+encodeInt32be x = do
331+ buf <- liftEffect $ AB.empty 4
332+ _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
333+ pure buf
334+
335+-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
336+encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
337+encodeInt32le x = do
338+ buf <- liftEffect $ AB.empty 4
339+ _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
340+ pure buf
341+
342+-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
343+encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
344+encodeFloat32be x = do
345+ buf <- liftEffect $ AB.empty 4
346+ _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
347+ pure buf
348+
349+-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
350+encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
351+encodeFloat32le x = do
352+ buf <- liftEffect $ AB.empty 4
353+ _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
354+ pure buf
355+
356+-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
357+encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
358+encodeFloat64be x = do
359+ buf <- liftEffect $ AB.empty 8
360+ _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
361+ pure buf
362+
363+-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
364+encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
365+encodeFloat64le x = do
366+ buf <- liftEffect $ AB.empty 8
367+ _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
368+ pure buf
test/Main.purs+138−3
@@ -2,10 +2,145 @@ module Test.Main where
2
2
3import Prelude
3import Prelude
4
4
5+import Control.Monad.Writer.Trans (tell)
6+import Data.Array (foldRecM)
7+import Data.Array as Array
8+import Data.ArrayBuffer.ArrayBuffer (byteLength)
9+import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putArrayBuffer, putInt16be, putInt32be, putInt32le, putInt8, subBuilder)
10+import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
11+import Data.ArrayBuffer.DataView as DV
12+import Data.ArrayBuffer.Typed (buffer)
13+import Data.ArrayBuffer.Typed as AT
14+import Data.ArrayBuffer.Typed as AV
15+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
16+import Data.UInt as UInt
5import Effect (Effect)
17import Effect (Effect)
6−import Effect.Class.Console (log)
18+import Effect.Class (class MonadEffect, liftEffect)
19+import Test.Assert (assertEqual')
20+import Web.Encoding.TextEncoder (encode)
21+import Web.Encoding.TextEncoder as TextEncoder
22+
23+asBytes :: ArrayBuffer -> Effect (Array Int)
24+asBytes x = do
25+ x' :: Uint8Array <- AT.whole x
26+ map UInt.toInt <$> AT.toArray x'
27+
28+putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
29+putTest label expected put = do
30+ actual <- asBytes =<< execPut put
31+ assertEqual' label { actual, expected }
32+
33+buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
34+buildTest label expected bldr = do
35+ actual <- asBytes =<< execBuilder =<< bldr
36+ assertEqual' label { actual, expected }
7
37
8main :: Effect Unit
38main :: Effect Unit
9main = do
39main = do
10− log "🍝"
40+ putTest "Test 0" [ 6, 7, 8 ] do
11− log "You should add some tests."
41+ putInt8 6
42+ putInt8 7
43+ putInt8 8
44+
45+ putTest "Test 1" [ 255, 254 ] do
46+ putInt16be (-2)
47+
48+ putTest "Test 3" [ 3, 0, 0, 0 ] do
49+ putInt32le 3
50+
51+ buildTest "Test 4" [ 1, 2, 3, 4 ] do
52+ b1 <- Buff <$> encodeInt8 1
53+ b2 <- Buff <$> encodeInt8 2
54+ b3 <- Buff <$> encodeInt8 3
55+ b4 <- Buff <$> encodeInt8 4
56+ pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
57+
58+ buildTest "Test 5" [ 1, 2, 3, 4 ] do
59+ b1 <- Buff <$> encodeInt8 1
60+ b2 <- Buff <$> encodeInt8 2
61+ b3 <- Buff <$> encodeInt8 3
62+ b4 <- Buff <$> encodeInt8 4
63+ pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
64+
65+ buildTest "Test 6" [ 1, 2, 3, 4 ] do
66+ b1 <- Buff <$> encodeInt8 1
67+ b2 <- Buff <$> encodeInt8 2
68+ b3 <- Buff <$> encodeInt8 3
69+ b4 <- Buff <$> encodeInt8 4
70+ pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
71+
72+ buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
73+ b1 <- Buff <$> encodeInt8 1
74+ b2 <- Buff <$> encodeInt8 2
75+ b3 <- Buff <$> encodeInt8 3
76+ b4 <- Buff <$> encodeInt8 4
77+ b5 <- Buff <$> encodeInt8 5
78+ b6 <- Buff <$> encodeInt8 6
79+ b7 <- Buff <$> encodeInt8 7
80+ b8 <- Buff <$> encodeInt8 8
81+ pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
82+ <> singleton b5
83+ <> (singleton b6 <> singleton b7)
84+ <> singleton b8
85+
86+ buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
87+ b1 <- Buff <$> encodeInt8 1
88+ b2 <- Buff <$> encodeInt8 2
89+ b3 <- Buff <$> encodeInt8 3
90+ b4 <- Buff <$> encodeInt8 4
91+ b5 <- Buff <$> encodeInt8 5
92+ b6 <- Buff <$> encodeInt8 6
93+ b7 <- Buff <$> encodeInt8 7
94+ b8 <- Buff <$> encodeInt8 8
95+ pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
96+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
97+
98+ buildTest "Test 8" [ 1, 2, 3, 4 ] do
99+ b1 <- Buff <$> encodeInt8 1
100+ b2 <- Buff <$> encodeInt8 2
101+ b3 <- Buff <$> encodeInt8 3
102+ b4 <- Buff <$> encodeInt8 4
103+ pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
104+
105+ putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
106+ x <- subBuilder do
107+ putInt8 3
108+ putInt8 4
109+ putInt8 1
110+ putInt8 2
111+ putInt8 $ length x
112+ tell x
113+
114+ buildTest "Test 10" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
115+ b1 <- View <$> DV.whole <$> encodeInt8 1
116+ b2 <- View <$> DV.whole <$> encodeInt8 2
117+ b3 <- View <$> DV.whole <$> encodeInt8 3
118+ b4 <- View <$> DV.whole <$> encodeInt8 4
119+ b5 <- View <$> DV.whole <$> encodeInt8 5
120+ b6 <- View <$> DV.whole <$> encodeInt8 6
121+ b7 <- View <$> DV.whole <$> encodeInt8 7
122+ b8 <- View <$> DV.whole <$> encodeInt8 8
123+ pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
124+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
125+
126+ let stackblower = Array.replicate 20000 2
127+ putTest "Stack test" stackblower do
128+ foldRecM (\_ x -> putInt8 x) unit stackblower
129+
130+ do
131+ let
132+ putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
133+ putStringUtf8 s = do
134+ textEncoder <- liftEffect TextEncoder.new
135+ let stringbuf = buffer $ encode s textEncoder
136+ -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.
137+ putInt32be $ byteLength stringbuf
138+ putArrayBuffer stringbuf
139+
140+ arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
141+ view :: Int8Array <- AV.whole arraybuffer
142+ viewarray <- AV.toArray view
143+ assertEqual' "utf-8 test"
144+ { actual: viewarray
145+ , expected: [ 0, 0, 0, 4, -16, -97, -90, -99 ]
146+ }