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
.github/workflows/push-build.ymldeleted−17
@@ -1,17 +0,0 @@
1−name: CI
2−
3−on: [push]
4−
5−jobs:
6− build:
7−
8− runs-on: ubuntu-latest
9−
10− steps:
11− - uses: actions/checkout@v2
12− - uses: actions/setup-node@v1
13− - run: npm install -g purescript
14− - run: npm install -g spago
15− - name: build
16− run: |
17− spago -x test.dhall test
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`
DEVELOPMENT.mddeleted−43
@@ -1,43 +0,0 @@
1−# Development Notes
2−
3−All of the commands needed for development are in the `shell.nix` environment.
4−
5−```
6−$ nix-shell
7−```
8−
9−## Edit
10−
11−The `psc-ide` command is available for the [VS Code Purescript IDE extension](https://github.com/nwolverson/vscode-ide-purescript.git).
12−
13−```
14−[nix-shell:]$ code .
15−```
16−
17−## Build
18−
19−```
20−[nix-shell:]$ spago build
21−```
22−
23−## Test
24−
25−The test dependencies are specified seperately in `test.dhall`.
26−
27−```
28−[nix-shell:]$ spago -x test.dhall test
29−```
30−
31−## Publishing to Pursuit with `spago`
32−
33−[Publishing with `spago`](https://github.com/purescript/spago#publish-my-library).
34−
35−```
36−[nix-shell:]$ spago bump-version --no-dry-run major
37−[nix-shell:]$ npm install pulp
38−[nix-shell:]$ node node_modules/pulp/index.js publish
39−```
40−
41−## Bower
42−
43−The `bower.json` is generated by running `spago bump-version`, do not edit it.
README.md+73−34
@@ -1,27 +1,21 @@
1# purescript-arraybuffer-builder
1# purescript-arraybuffer-builder
2
2
3−[![CI](https://github.com/jamesdbrock/purescript-arraybuffer-builder/workflows/CI/badge.svg?branch=master)](https://github.com/jamesdbrock/purescript-arraybuffer-builder/actions)
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/)
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)
5
6
7+
8+[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
6−`ArrayBuffer` serialization in the “builder monoid” and “builder monad” style.
9+serialization in the “builder monoid” and “builder monad” style.
7−In this style, we build up serialized data structures by `append`ing to
10+In this style, we build up serialized data structures by `tell`ing to
8−a monoid in a Writer monad with do-notation. This style of serialization
11+a `Writer` monad with `do`-notation. This style of serialization
9has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).
12has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).
10
13
11This package provides a `Builder` monoid and a `PutM` monad which are roughly
14This package provides a `Builder` monoid and a `PutM` monad which are roughly
12equivalent to types of the same name in the Haskell
15equivalent to types of the same name in the Haskell
13−[`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
16+[__Data.Binary.Put__](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
14module.
17module.
15
18
16−This package defines
17−[no typeclasses](http://code.slipthrough.net/2018/03/13/thoughts-on-typeclass-codecs/).
18−Typeclass-based
19−serialization/deserialization generally assumes that we are round-tripping
20−some data structures out to storage and then back into our program.
21−This package is designed for the case in which we are serializing some data
22−to be sent to another program which expects a serialization format
23−that we don't control.
24−
25## Usage Examples
19## Usage Examples
26
20
27All `ArrayBuffer` building must occur in `Effect`.
21All `ArrayBuffer` building must occur in `Effect`.
@@ -30,8 +24,10 @@ All `ArrayBuffer` building must occur in `Effect`.
30
24
31Create a two-byte `arraybuffer :: ArrayBuffer` which contains the number *-10* encoded as big-endian 16-bit two’s-complement.
25Create a two-byte `arraybuffer :: ArrayBuffer` which contains the number *-10* encoded as big-endian 16-bit two’s-complement.
32```purescript
26```purescript
27+import Data.ArrayBuffer.Builder (execPut, putInt16be)
28+
33do
29do
34− arraybuffer <- execPut $ putInt16be (-10)
30+ arraybuffer :: ArrayBuffer <- execPut $ putInt16be (-10)
35```
31```
36
32
37### Serialize three floats
33### Serialize three floats
@@ -40,8 +36,10 @@ Create a 24-byte `arraybuffer :: ArrayBuffer` which contains three big-endian
40IEEE-754 double-precision floats.
36IEEE-754 double-precision floats.
41
37
42```purescript
38```purescript
39+import Data.ArrayBuffer.Builder (execPut, putFloat64be)
40+
43do
41do
44− arraybuffer <- execPut $ do
42+ arraybuffer :: ArrayBuffer <- execPut do
45 putFloat64be 1.0
43 putFloat64be 1.0
46 putFloat64be 2.0
44 putFloat64be 2.0
47 putFloat64be 3.0
45 putFloat64be 3.0
@@ -49,22 +47,30 @@ do
49
47
50### Serialize a `String` as UTF8
48### Serialize a `String` as UTF8
51
49
52−Encode a `String` as UTF8 with a length prefix.
50+Encode a `String` as UTF8 with a length prefix into our `Builder`.
53
51
54We give this as an example, rather than supporting it in the library, because
52We give this as an example, rather than supporting it in the library, because
55it depends on
53it depends on
56−[`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).
54+[`Web.Encoding.TextEncoder`](https://pursuit.purescript.org/packages/purescript-web-encoding/docs/Web.Encoding.TextEncoder).
57
55
58```purescript
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+
59−putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit
65+putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
60putStringUtf8 s = do
66putStringUtf8 s = do
61− let stringbuf = Data.ArrayBuffer.Typed.buffer $ Data.TextEncoding.encodeUtf8 s
67+ textEncoder <- liftEffect new
68+ let stringbuf = buffer $ encode s textEncoder
62− -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.
69+ -- Put a 32-bit big-endian length for the utf8 string, in bytes.
63− putUint32be $ Data.Uint.fromInt $ Data.ArrayBuffer.byteLength stringbuf
70+ putUint32be $ fromInt $ byteLength stringbuf
64 putArrayBuffer stringbuf
71 putArrayBuffer stringbuf
65
72
66−do
67− arraybuffer <- execPut $ putStringUtf8 "BLM"
73+arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
68```
74```
69
75
70### Serialize an `Array Int`
76### Serialize an `Array Int`
@@ -77,29 +83,62 @@ from the Haskell
77library.
83library.
78
84
79```purescript
85```purescript
86+import Data.ArrayBuffer.Builder (execPut, putInt32be)
87+import Data.Foldable (traverse_)
88+import Data.Array (length)
89+
80−putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit
90+putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit
81putArrayInt32 xs = do
91putArrayInt32 xs = do
82− -- Put a 64-bit big-endian length prefix for the length of the array.
92+ -- Put a 64-bit big-endian length prefix for the array.
83− putUint32be 0
93+ putInt32be 0
84− putUint32be $ Data.Uint.fromInt $ Data.Array.length xs
94+ putInt32be $ length xs
85 traverse_ putInt32be xs
95 traverse_ putInt32be xs
86
96
87do
97do
88 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
98 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
89```
99```
90
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+
91## Deserialization
123## Deserialization
92
124
93This package is only for writing `ArrayBuffer`s, not reading them.
125This package is only for writing `ArrayBuffer`s, not reading them.
94See
126See
95−[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
127+[__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
96for a way to deserialize from `ArrayBuffer` back to Purescript data.
128for a way to deserialize from `ArrayBuffer` back to Purescript data.
97
129
98−## References
130+## Alternative packages for serializing to an `ArrayBuffer`
99
131
100−* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
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)
101
137
102−## Alternative packages for serializing to an `ArrayBuffer`
138+## Development
103
139
104−* [__purescript-node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
140+To run the tests,
105−* [__purescript-arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
141+
142+```shell
143+spago -x spago-dev.dhall test
144+```
bower.json+12−2
@@ -14,7 +14,17 @@
14 "output"
14 "output"
15 ],
15 ],
16 "dependencies": {
16 "dependencies": {
17− "purescript-arraybuffer": "^v10.0.2",
17+ "purescript-arraybuffer": "^v13.1.1",
18+ "purescript-arraybuffer-types": "^v3.0.2",
18− "purescript-arraybuffer-types": "^v2.0.0"
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"
19 }
29 }
20}
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
shell.nixdeleted−26
@@ -1,26 +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.spago
17− pkgs.nodejs-13_x
18− pkgs.nodePackages.bower
19− # pkgs.nodePackages.pulp
20− #
21− # The pulp nix derivation doesn't work, so to run pulp:
22− # $ npm install pulp
23− # $ node node_modules/pulp/index.js
24− ];
25− LC_ALL = "C.UTF-8"; # https://github.com/purescript/spago/issues/507
26−}
test.dhall → spago-dev.dhallrenamed+6−2
@@ -12,5 +12,9 @@ let conf = ./spago.dhall
12
12
13in conf //
13in conf //
14 { sources = conf.sources # [ "test/**/*.purs" ]
14 { sources = conf.sources # [ "test/**/*.purs" ]
15− , dependencies = conf.dependencies # [ "assert" ]
15+ , dependencies = conf.dependencies #
16+ [ "assert"
17+ , "arrays"
18+ , "web-encoding"
19+ ]
16− }
20+ }
spago.dhall+11−1
@@ -2,8 +2,18 @@
2-}
2-}
3{ name = "arraybuffer-builder"
3{ name = "arraybuffer-builder"
4, dependencies =
4, dependencies =
5+ [ "effect"
6+ , "float32"
7+ , "identity"
8+ , "lists"
9+ , "maybe"
10+ , "newtype"
11+ , "prelude"
12+ , "transformers"
13+ , "uint"
5− [ "arraybuffer-types"
14+ , "arraybuffer-types"
6 , "arraybuffer"
15 , "arraybuffer"
16+ , "tailrec"
7 ]
17 ]
8, packages = ./packages.dhall
18, packages = ./packages.dhall
9, sources = [ "src/**/*.purs" ]
19, sources = [ "src/**/*.purs" ]
src/Data/ArrayBuffer/Builder.purs+96−347
@@ -5,403 +5,152 @@
5-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
5-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
6-- | functions in this module must be run in a `MonadEffect` context.
6-- | functions in this module must be run in a `MonadEffect` context.
7-- |
7-- |
8−-- | For operations for working with `ArrayBuffer`, see
8+-- | For other operations for working with `ArrayBuffer`, see
9-- | module
9-- | module
10-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
10-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
11−-- | in package __purescript-arraybuffer__.
11+-- | in package __arraybuffer__.
12module Data.ArrayBuffer.Builder
12module Data.ArrayBuffer.Builder
13−( PutM
13+ ( PutM
14−, Put
14+ , Put
15−, execPutM
15+ , execPutM
16−, execPut
16+ , execPut
17+ , subBuilder
17−, putArrayBuffer
18+ , putArrayBuffer
19+ , putDataView
20+ , putDataBuff
18−, putUint8
21+ , putUint8
19−, putInt8
22+ , putInt8
20−, putUint16be
23+ , putUint16be
21−, putUint16le
24+ , putUint16le
22−, putInt16be
25+ , putInt16be
23−, putInt16le
26+ , putInt16le
24−, putUint32be
27+ , putUint32be
25−, putUint32le
28+ , putUint32le
26−, putInt32be
29+ , putInt32be
27−, putInt32le
30+ , putInt32le
28−, putFloat32be
31+ , putFloat32be
29−, putFloat32le
32+ , putFloat32le
30−, putFloat64be
33+ , putFloat64be
31−, putFloat64le
34+ , putFloat64le
32−, Builder
35+ , module Data.ArrayBuffer.Builder.Internal
33−, (<>>)
34−, execBuilder
35−, singleton
36−, snoc
37−, encodeUint8
38−, encodeInt8
39−, encodeUint16be
40−, encodeUint16le
41−, encodeInt16be
42−, encodeInt16le
43−, encodeUint32be
44−, encodeUint32le
45−, encodeInt32be
46−, encodeInt32le
47−, encodeFloat32be
48−, encodeFloat32le
49−, encodeFloat64be
50−, encodeFloat64le
51−)
52−where
36+ ) where
53
37
54import Prelude
38import Prelude
55
39
40+import Control.Monad.Rec.Class (class MonadRec)
56−import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)
41+import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
57−import Data.ArrayBuffer.ArrayBuffer as AB
42+import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
58−import Data.ArrayBuffer.DataView as DV
59−import Data.ArrayBuffer.Typed as AT
43+import Data.ArrayBuffer.Builder.Internal as Internal
60−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
44+import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
61import Data.Float32 (Float32)
45import Data.Float32 (Float32)
62−import Data.Maybe (Maybe(..))
63import Data.UInt (UInt)
46import Data.UInt (UInt)
64import Effect (Effect)
47import Effect (Effect)
65−import Effect.Class (class MonadEffect, liftEffect)
48+import Effect.Class (class MonadEffect)
66
49
67-- | The `PutM` monad is a `WriterT Builder` transformer monad which
50-- | The `PutM` monad is a `WriterT Builder` transformer monad which
68-- | gives us do-notation for the `Builder` monoid. The base monad must be
51-- | gives us do-notation for the `Builder` monoid. The base monad must be
69-- | a `MonadEffect`.
52-- | a `MonadEffect`.
53+-- |
54+-- | To append `Builder`s in this monad call `tell`, or any of the `put*`
55+-- | functions in this module.
70type PutM = WriterT Builder
56type PutM = WriterT Builder
71
57
72−-- | The `Put` monad is a `WriterT Builder Effect` monad which
58+-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
73−-- | gives us do-notation for the `Builder` monoid.
74type Put = PutM Effect
59type Put = PutM Effect
75
60
76−-- | Monoidal builder for `ArrayBuffer`s.
61+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
77−-- |
62+execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
78−-- | ### 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.
79-- |
70-- |
80−-- | __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
81−-- | 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.
82-- |
75-- |
83−-- | The `Builder` monoid in this library is efficient when we `snoc` single
76+-- | In a `PutM` monad do-block, we can
84−-- | items onto the end of it, or when we only `cons` single items to the
85−-- | beginning, but it can be less efficient when we are mixing `cons` and
86−-- | `snoc`.
87−-- | This matters when we're appending three or more `Builder`s
88−-- | in one associative expression, because the
89−-- | `Semigroup` append operator `<>` is right-associative.
90-- |
77-- |
91−-- | To solve this, we provide an operator `<>>` for appending `Builders`.
92−-- | `<>>` is exactly the same as `<>`, but left-associative.
93−-- | This only matters when we're chaining together three
94−-- | or more `Builder`s in a single associative expression.
95−-- | Instead of
96−-- | ```
97−-- | builder₁ <> builder₂ <> builder₃
98−-- | ```
99−-- | we should always prefer to
100−-- | write
101-- | ```
78-- | ```
102−-- | builder₁ <>> builder₂ <>> builder₃
79+-- | do
103−-- | ```
80+-- | messageBuilder <- subBuilder $ do
104−-- | so that we get the efficient
81+-- | putField1
105−-- | `snoc`ing of `Builder`s.
106−-- |
82+-- | putField2
107−-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
108−-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
109−-- | `snoc` case.
110-- |
83-- |
111−data Builder
84+-- | putInt32be $ length messageBuilder
112− = Node Builder ArrayBuffer Builder
85+-- | tell messageBuilder
113− | Null
86+-- | ```
114−
87+subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
115−instance semigroupBuilder :: Semigroup Builder where
116− append Null Null = Null
117− append l Null = l
118− append Null r = r
119− append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
120− append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
121− -- of the left tree
122− append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
123− -- side of the left tree
124− -- to find the rightmost
125− -- Null
126−
127−infixl 5 append as <>>
128−
129−instance monoidBuilder :: Monoid Builder where
130− mempty = Null
131−
132−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
133−foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
134−foldl f a Null = a
135−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
136−
137−-- | Monomorphic foldM copied from
138−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
139−foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
140−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
141−
142−-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
143−singleton :: ArrayBuffer -> Builder
144−singleton buf = Node Null buf Null
145−
146−-- | Add an `ArrayBuffer` to the end of the `Builder`. *O(1)*
147−snoc :: Builder -> ArrayBuffer -> Builder
148−snoc bs x = Node bs x Null
149−
150−-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
151−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
152−execBuilder bldr = do
153− let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
154− -- Allocate the final ArrayBuffer
155− buf <- liftEffect $ AB.empty buflen
156− -- Then copy each ArrayBuffer into the final ArrayBuffer.
157− -- To memcpy from one ArrayBuffer to another, apparently we have to first view
158− -- both ArrayBuffers as ArrayView (Typed Array).
159− newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
160− _ <- foldM
161− ( \offset a -> do
162− aview <- liftEffect (AT.whole a :: Effect Uint8Array)
163− _ <- liftEffect $ AT.setTyped newview (Just offset) aview
164− pure $ offset + AB.byteLength a
165− ) 0 bldr
166− pure buf
167−
168−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
169−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
170−execPutM = execBuilder <=< execWriterT
88+subBuilder = lift <<< execWriterT
171−
172−-- | Build an `ArrayBuffer` with do-notation. *O(n)*
173−execPut :: Put Unit -> Effect ArrayBuffer
174−execPut = execPutM
175
89
176-- | Append an `ArrayBuffer` to the builder.
90-- | Append an `ArrayBuffer` to the builder.
177−putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
91+putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
178−putArrayBuffer = tell <<< singleton
92+putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
179
93
180−-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
94+-- | Append a `DataView` to the builder.
181−encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
95+putDataView :: forall m. Monad m => DataView -> PutM m Unit
182−encodeUint8 x = do
96+putDataView = tell <<< Internal.singleton <<< Internal.View
183− buf <- liftEffect $ AB.empty 1
184− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
185− pure buf
186
97
187−-- | Append an 8-bit unsigned integer (byte) to the builder.
98+-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
188−putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
99+putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
189−putUint8 = putArrayBuffer <=< encodeUint8
100+putDataBuff = tell <<< Internal.singleton
190
101
191−-- | 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.
192−encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
103+putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
193−encodeInt8 x = do
104+putUint8 = putArrayBuffer <=< Internal.encodeUint8
194− buf <- liftEffect $ AB.empty 1
195− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
196− pure buf
197
105
198-- | 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.
199−putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
107+putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
200−putInt8 = putArrayBuffer <=< encodeInt8
108+putInt8 = putArrayBuffer <=< Internal.encodeInt8
201−
202−-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
203−encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
204−encodeUint16be x = do
205− buf <- liftEffect $ AB.empty 2
206− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
207− pure buf
208
109
209-- | Append a 16-bit big-endian unsigned integer to the builder.
110-- | Append a 16-bit big-endian unsigned integer to the builder.
210−putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
111+putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
211−putUint16be = putArrayBuffer <=< encodeUint16be
112+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
212−
213−-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
214−encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
215−encodeUint16le x = do
216− buf <- liftEffect $ AB.empty 2
217− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
218− pure buf
219
113
220-- | Append a 16-bit little-endian unsigned integer to the builder.
114-- | Append a 16-bit little-endian unsigned integer to the builder.
221−putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
115+putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
222−putUint16le = putArrayBuffer <=< encodeUint16le
116+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
223−
224−-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
225−encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
226−encodeInt16be x = do
227− buf <- liftEffect $ AB.empty 2
228− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
229− pure buf
230
117
231-- | 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.
232−putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
119+putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
233−putInt16be = putArrayBuffer <=< encodeInt16be
120+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
234−
235−-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
236−encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
237−encodeInt16le x = do
238− buf <- liftEffect $ AB.empty 2
239− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
240− pure buf
241
121
242-- | 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.
243−putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
123+putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
244−putInt16le = putArrayBuffer <=< encodeInt16le
124+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
245−
246−-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
247−encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
248−encodeUint32be x = do
249− buf <- liftEffect $ AB.empty 4
250− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
251− pure buf
252
125
253-- | Append a 32-bit big-endian unsigned integer to the builder.
126-- | Append a 32-bit big-endian unsigned integer to the builder.
254−putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
127+putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
255−putUint32be = putArrayBuffer <=< encodeUint32be
128+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
256−
257−-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
258−encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
259−encodeUint32le x = do
260− buf <- liftEffect $ AB.empty 4
261− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
262− pure buf
263
129
264-- | Append a 32-bit little-endian unsigned integer to the builder.
130-- | Append a 32-bit little-endian unsigned integer to the builder.
265−putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
131+putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
266−putUint32le = putArrayBuffer <=< encodeUint32le
132+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
267−
268−-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
269−encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
270−encodeInt32be x = do
271− buf <- liftEffect $ AB.empty 4
272− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
273− pure buf
274
133
275-- | 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.
276−putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
135+putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
277−putInt32be = putArrayBuffer <=< encodeInt32be
136+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
278−
279−-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
280−encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
281−encodeInt32le x = do
282− buf <- liftEffect $ AB.empty 4
283− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
284− pure buf
285
137
286-- | 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.
287−putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
139+putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
288−putInt32le = putArrayBuffer <=< encodeInt32le
140+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
289−
290−-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
291−encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
292−encodeFloat32be x = do
293− buf <- liftEffect $ AB.empty 4
294− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
295− pure buf
296
141
297-- | 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.
298−putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
143+putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
299−putFloat32be = putArrayBuffer <=< encodeFloat32be
144+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
300−
301−-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
302−encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
303−encodeFloat32le x = do
304− buf <- liftEffect $ AB.empty 4
305− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
306− pure buf
307
145
308-- | 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.
309−putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
147+putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
310−putFloat32le = putArrayBuffer <=< encodeFloat32le
148+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
311−
312−-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
313−encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
314−encodeFloat64be x = do
315− buf <- liftEffect $ AB.empty 8
316− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
317− pure buf
318
149
319-- | 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.
320−putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
151+putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
321−putFloat64be = putArrayBuffer <=< encodeFloat64be
152+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
322−
323−-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
324−encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
325−encodeFloat64le x = do
326− buf <- liftEffect $ AB.empty 8
327− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
328− pure buf
329
153
330-- | 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.
331−putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
155+putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
332−putFloat64le = putArrayBuffer <=< encodeFloat64le
156+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
333−
334−
335−-- ## Implementation Details
336−--
337−-- We want our `Builder` to be a data structure with
338−-- * *O(1)* monoid append
339−-- * *O(n)* fold
340−--
341−-- Our `Builder` implementation is an unbalanced binary tree.
342−--
343−-- For monoid `append`, what we actually get is *O(1)* when either the
344−-- left or right tree is a singleton. If that's not true, then in the
345−-- unlikely worst case `append` might be *O(n)*.
346−--
347−-- `Builder` is optimized what we consider to be normal usage, that is,
348−-- `snoc`ing singleton elements to the end of the `Builder`.
349−--
350−-- If a Builder is built entirely by `snoc`ing, it will look like a
351−-- left-only binary tree, a.k.a. a linked list.
352−--
353−-- ```
354−-- ④
355−-- ╱
356−-- ③
357−-- ╱
358−-- ②
359−-- ╱
360−-- ①
361−-- ```
362−--
363−-- If two of these `snoc`-built trees are `append`ed, then the new tree
364−-- will look like
365−--
366−-- ```
367−-- ④
368−-- ╱ ╲
369−-- ③ ⑧
370−-- ╱ ╱
371−-- ② ⑦
372−-- ╱ ╱
373−-- ① ⑥
374−-- ╱
375−-- ⑤
376−-- ```
377−--
378−-- This is all similar to
379−-- [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
380−-- , except that the
381−-- [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
382−-- structure in __bytestring-tree-builder__ only carries values in its
383−-- leaves, which is how it achieves *O(1)* appending, at the cost of
384−-- a higher coefficient time factor on the fold.
385−--
386−-- We hope that this implementation is fairly fast, but we
387−-- haven't chosen this implementation because it's fast, we've chosen
388−-- this implementation because it's simple.
389−-- If someone wants to create a fast Purescript ArrayBuffer serialization
390−-- library, then they can benchmark against this one to prove that the new
391−-- one is fast.
392−--
393−-- One relatively cheap and simple performance improvement for this library would be to
394−-- remove the Null constructor of `Builder` and instead use Javascript nulls.
395−--
396−-- In the longer term, it might make sense to try to change the Builder so
397−-- that it works like the
398−-- https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
399−--
400−-- Here are some benchmarks of different Haskell ByteString builders
401−-- https://github.com/haskell-perf/strict-bytestring-builders
402−--
403−-- We've tried to design the API for this library with minimal assumptions,
404−-- so that if we want to change the Builder implementation later then we can.
405−--
406−-- Another way this could go:
407−-- https://kodimensional.dev/posts/2019-03-25-comonadic-builders
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+108−44
@@ -1,12 +1,24 @@
1module Test.Main where
1module Test.Main where
2
2
3−import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
3+import Prelude
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, (<>>))
4−import Data.ArrayBuffer.Types (ArrayBuffer,Uint8Array)
11+import Data.ArrayBuffer.DataView as DV
12+import Data.ArrayBuffer.Typed (buffer)
5import Data.ArrayBuffer.Typed as AT
13import Data.ArrayBuffer.Typed as AT
14+import Data.ArrayBuffer.Typed as AV
15+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
6import Data.UInt as UInt
16import Data.UInt as UInt
7import Effect (Effect)
17import Effect (Effect)
18+import Effect.Class (class MonadEffect, liftEffect)
8import Test.Assert (assertEqual')
19import Test.Assert (assertEqual')
9−import Data.ArrayBuffer.Builder
20+import Web.Encoding.TextEncoder (encode)
21+import Web.Encoding.TextEncoder as TextEncoder
10
22
11asBytes :: ArrayBuffer -> Effect (Array Int)
23asBytes :: ArrayBuffer -> Effect (Array Int)
12asBytes x = do
24asBytes x = do
@@ -16,67 +28,119 @@ asBytes x = do
16putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
28putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
17putTest label expected put = do
29putTest label expected put = do
18 actual <- asBytes =<< execPut put
30 actual <- asBytes =<< execPut put
19− assertEqual' label {actual,expected}
31+ assertEqual' label { actual, expected }
20
32
21buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
33buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
22buildTest label expected bldr = do
34buildTest label expected bldr = do
23 actual <- asBytes =<< execBuilder =<< bldr
35 actual <- asBytes =<< execBuilder =<< bldr
24− assertEqual' label {actual,expected}
36+ assertEqual' label { actual, expected }
25
37
26main :: Effect Unit
38main :: Effect Unit
27main = do
39main = do
28− putTest "Test 0" [6,7,8] $ do
40+ putTest "Test 0" [ 6, 7, 8 ] do
29 putInt8 6
41 putInt8 6
30 putInt8 7
42 putInt8 7
31 putInt8 8
43 putInt8 8
32
44
33− putTest "Test 1" [255,254] $ do
45+ putTest "Test 1" [ 255, 254 ] do
34 putInt16be (-2)
46 putInt16be (-2)
35
47
36− putTest "Test 3" [3,0,0,0] $ do
48+ putTest "Test 3" [ 3, 0, 0, 0 ] do
37 putInt32le 3
49 putInt32le 3
38
50
39− buildTest "Test 4" [1,2,3,4] $ do
51+ buildTest "Test 4" [ 1, 2, 3, 4 ] do
40− b1 <- encodeInt8 1
52+ b1 <- Buff <$> encodeInt8 1
41− b2 <- encodeInt8 2
53+ b2 <- Buff <$> encodeInt8 2
42− b3 <- encodeInt8 3
54+ b3 <- Buff <$> encodeInt8 3
43− b4 <- encodeInt8 4
55+ b4 <- Buff <$> encodeInt8 4
44 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
56 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
45
57
46− buildTest "Test 5" [1,2,3,4] $ do
58+ buildTest "Test 5" [ 1, 2, 3, 4 ] do
47− b1 <- encodeInt8 1
59+ b1 <- Buff <$> encodeInt8 1
48− b2 <- encodeInt8 2
60+ b2 <- Buff <$> encodeInt8 2
49− b3 <- encodeInt8 3
61+ b3 <- Buff <$> encodeInt8 3
50− b4 <- encodeInt8 4
62+ b4 <- Buff <$> encodeInt8 4
51 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
63 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
52
64
53− buildTest "Test 6" [1,2,3,4] $ do
65+ buildTest "Test 6" [ 1, 2, 3, 4 ] do
54− b1 <- encodeInt8 1
66+ b1 <- Buff <$> encodeInt8 1
55− b2 <- encodeInt8 2
67+ b2 <- Buff <$> encodeInt8 2
56− b3 <- encodeInt8 3
68+ b3 <- Buff <$> encodeInt8 3
57− b4 <- encodeInt8 4
69+ b4 <- Buff <$> encodeInt8 4
58 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
59
71
60− buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do
72+ buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
61− b1 <- encodeInt8 1
73+ b1 <- Buff <$> encodeInt8 1
62− b2 <- encodeInt8 2
74+ b2 <- Buff <$> encodeInt8 2
63− b3 <- encodeInt8 3
75+ b3 <- Buff <$> encodeInt8 3
64− b4 <- encodeInt8 4
76+ b4 <- Buff <$> encodeInt8 4
65− b5 <- encodeInt8 5
77+ b5 <- Buff <$> encodeInt8 5
66− b6 <- encodeInt8 6
78+ b6 <- Buff <$> encodeInt8 6
67− b7 <- encodeInt8 7
79+ b7 <- Buff <$> encodeInt8 7
68− b8 <- encodeInt8 8
80+ b8 <- Buff <$> encodeInt8 8
69 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
81 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
82+ <> singleton b5
70− <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
83+ <> (singleton b6 <> singleton b7)
71−
84+ <> singleton b8
85+
72− buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do
86+ buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
73− b1 <- encodeInt8 1
87+ b1 <- Buff <$> encodeInt8 1
74− b2 <- encodeInt8 2
88+ b2 <- Buff <$> encodeInt8 2
75− b3 <- encodeInt8 3
89+ b3 <- Buff <$> encodeInt8 3
76− b4 <- encodeInt8 4
90+ b4 <- Buff <$> encodeInt8 4
77− b5 <- encodeInt8 5
91+ b5 <- Buff <$> encodeInt8 5
78− b6 <- encodeInt8 6
92+ b6 <- Buff <$> encodeInt8 6
79− b7 <- encodeInt8 7
93+ b7 <- Buff <$> encodeInt8 7
80− b8 <- encodeInt8 8
94+ b8 <- Buff <$> encodeInt8 8
81 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
95 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
82− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
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+ }