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.md+37
@@ -1,3 +1,40 @@
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+
1## v1.1.0 2020-09-10
38## v1.1.0 2020-09-10
2
39
3Add and export
40Add and export
DEVELOPMENT.mddeleted−42
@@ -1,42 +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:]$ pulp publish
38−```
39−
40−## Bower
41−
42−The `bower.json` is generated by running `spago bump-version`, do not edit it.
README.md+71−33
@@ -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,30 +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
99−
100−* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
101−
102## Alternative packages for serializing to an `ArrayBuffer`
130## Alternative packages for serializing to an `ArrayBuffer`
103
131
104* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
132* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
105* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
133* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
106* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
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.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−22
@@ -1,22 +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 = "1ec689df0adf8e8ada7fcfcb513876307ea34226";
8− sha256 = "12hk2zbjkrq2i5fs6xb3x254lnhm9fzkcxph0a7ngxyzfykvf4hi";
9− }) {
10− inherit pkgs;
11− };
12−in
13−pkgs.mkShell {
14− buildInputs = [
15− easy-ps.purs-0_13_8
16− easy-ps.spago
17− easy-ps.pulp
18− pkgs.nodejs-13_x
19− pkgs.nodePackages.bower
20− ];
21− LC_ALL = "C.UTF-8"; # https://github.com/purescript/spago/issues/507
22−}
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+73−360
@@ -5,67 +5,47 @@
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+ , subBuilder
18−, putArrayBuffer
18+ , putArrayBuffer
19+ , putDataView
20+ , putDataBuff
19−, putUint8
21+ , putUint8
20−, putInt8
22+ , putInt8
21−, putUint16be
23+ , putUint16be
22−, putUint16le
24+ , putUint16le
23−, putInt16be
25+ , putInt16be
24−, putInt16le
26+ , putInt16le
25−, putUint32be
27+ , putUint32be
26−, putUint32le
28+ , putUint32le
27−, putInt32be
29+ , putInt32be
28−, putInt32le
30+ , putInt32le
29−, putFloat32be
31+ , putFloat32be
30−, putFloat32le
32+ , putFloat32le
31−, putFloat64be
33+ , putFloat64be
32−, putFloat64le
34+ , putFloat64le
33−, Builder
35+ , module Data.ArrayBuffer.Builder.Internal
34−, (<>>)
35−, execBuilder
36−, length
37−, singleton
38−, cons
39−, snoc
40−, encodeUint8
41−, encodeInt8
42−, encodeUint16be
43−, encodeUint16le
44−, encodeInt16be
45−, encodeInt16le
46−, encodeUint32be
47−, encodeUint32le
48−, encodeInt32be
49−, encodeInt32le
50−, encodeFloat32be
51−, encodeFloat32le
52−, encodeFloat64be
53−, encodeFloat64le
54−)
55−where
36+ ) where
56
37
57import Prelude
38import Prelude
58
39
40+import Control.Monad.Rec.Class (class MonadRec)
59import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
41import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
60−import Data.ArrayBuffer.ArrayBuffer as AB
42+import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
61−import Data.ArrayBuffer.DataView as DV
62−import Data.ArrayBuffer.Typed as AT
43+import Data.ArrayBuffer.Builder.Internal as Internal
63−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
44+import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
64import Data.Float32 (Float32)
45import Data.Float32 (Float32)
65−import Data.Maybe (Maybe(..))
66import Data.UInt (UInt)
46import Data.UInt (UInt)
67import Effect (Effect)
47import Effect (Effect)
68−import Effect.Class (class MonadEffect, liftEffect)
48+import Effect.Class (class MonadEffect)
69
49
70-- | The `PutM` monad is a `WriterT Builder` transformer monad which
50-- | The `PutM` monad is a `WriterT Builder` transformer monad which
71-- | 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
@@ -78,111 +58,11 @@ type PutM = WriterT Builder
78-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
58-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
79type Put = PutM Effect
59type Put = PutM Effect
80
60
81−-- | Monoidal builder for `ArrayBuffer`s.
61+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
82−-- |
62+execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
83−-- | ### Left-associative `<>>` append operator
63+execPutM = Internal.execBuilder <=< execWriterT
84−-- |
85−-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
86−-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
87−-- |
88−-- | The `Builder` monoid in this library is efficient when we `snoc` single
89−-- | items onto the end of it, or when we only `cons` single items to the
90−-- | beginning, but it can be less efficient when we are mixing `cons` and
91−-- | `snoc`.
92−-- | This matters when we're appending three or more `Builder`s
93−-- | in one associative expression, because the
94−-- | `Semigroup` append operator `<>` is right-associative.
95−-- |
96−-- | To solve this, we provide an operator `<>>` for appending `Builders`.
97−-- | `<>>` is exactly the same as `<>`, but left-associative.
98−-- | This only matters when we're chaining together three
99−-- | or more `Builder`s in a single associative expression.
100−-- | Instead of
101−-- | ```
102−-- | builder₁ <> builder₂ <> builder₃
103−-- | ```
104−-- | we should always prefer to
105−-- | write
106−-- | ```
107−-- | builder₁ <>> builder₂ <>> builder₃
108−-- | ```
109−-- | so that we get the efficient
110−-- | `snoc`ing of `Builder`s.
111−-- |
112−-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
113−-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
114−-- | `snoc` case.
115−-- |
116−data Builder
117− = Node Builder ArrayBuffer Builder
118− | Null
119−
120−instance semigroupBuilder :: Semigroup Builder where
121− append Null Null = Null
122− append l Null = l
123− append Null r = r
124− append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
125− append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
126− -- of the left tree
127− append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
128− -- side of the left tree
129− -- to find the rightmost
130− -- Null
131−
132−infixl 5 append as <>>
133−
134−instance monoidBuilder :: Monoid Builder where
135− mempty = Null
136−
137−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
138−foldl :: forall b. (b -> ArrayBuffer -> b) -> b -> Builder -> b
139−foldl f a Null = a
140−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
141−
142−-- | Monomorphic foldM copied from
143−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
144−foldM :: forall b m. (Monad m) => (b -> ArrayBuffer -> m b) -> b -> Builder -> m b
145−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
146−
147−-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
148−singleton :: ArrayBuffer -> Builder
149−singleton buf = Node Null buf Null
150−
151−-- | Prepend an `ArrayBuffer` to the beginning of the `Builder`. *O(1)*
152−cons :: ArrayBuffer -> Builder -> Builder
153−cons x bs = Node Null x bs
154−
155−-- | Append an `ArrayBuffer` to the end of the `Builder`. *O(1)*
156−snoc :: Builder -> ArrayBuffer -> Builder
157−snoc bs x = Node bs x Null
158−
159−-- | Calculate the total byte length of the `Builder`. *O(n)*
160−length :: Builder -> Int
161−length bldr = foldl (\b a -> b + AB.byteLength a) 0 bldr
162−
163−-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
164−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
165−execBuilder bldr = do
166− let buflen = foldl (\b a -> b + AB.byteLength a) 0 bldr
167− -- Allocate the final ArrayBuffer
168− buf <- liftEffect $ AB.empty buflen
169− -- Then copy each ArrayBuffer into the final ArrayBuffer.
170− -- To memcpy from one ArrayBuffer to another, apparently we have to first view
171− -- both ArrayBuffers as ArrayView (Typed Array).
172− newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
173− _ <- foldM
174− ( \offset a -> do
175− aview <- liftEffect (AT.whole a :: Effect Uint8Array)
176− _ <- liftEffect $ AT.setTyped newview (Just offset) aview
177− pure $ offset + AB.byteLength a
178− ) 0 bldr
179− pure buf
180
64
181−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
65+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
182−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
183−execPutM = execBuilder <=< execWriterT
184−
185−-- | Build an `ArrayBuffer` with do-notation. *O(n)*
186execPut :: Put Unit -> Effect ArrayBuffer
66execPut :: Put Unit -> Effect ArrayBuffer
187execPut = execPutM
67execPut = execPutM
188
68
@@ -195,7 +75,6 @@ execPut = execPutM
195-- |
75-- |
196-- | In a `PutM` monad do-block, we can
76-- | In a `PutM` monad do-block, we can
197-- |
77-- |
198−-- |
199-- | ```
78-- | ```
200-- | do
79-- | do
201-- | messageBuilder <- subBuilder $ do
80-- | messageBuilder <- subBuilder $ do
@@ -205,239 +84,73 @@ execPut = execPutM
205-- | putInt32be $ length messageBuilder
84-- | putInt32be $ length messageBuilder
206-- | tell messageBuilder
85-- | tell messageBuilder
207-- | ```
86-- | ```
208−subBuilder :: forall m. (MonadEffect m) => PutM m Unit -> PutM m Builder
87+subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
209subBuilder = lift <<< execWriterT
88subBuilder = lift <<< execWriterT
210
89
211-- | Append an `ArrayBuffer` to the builder.
90-- | Append an `ArrayBuffer` to the builder.
212−putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
91+putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
213−putArrayBuffer = tell <<< singleton
92+putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
214
93
215−-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
94+-- | Append a `DataView` to the builder.
216−encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
95+putDataView :: forall m. Monad m => DataView -> PutM m Unit
217−encodeUint8 x = do
96+putDataView = tell <<< Internal.singleton <<< Internal.View
218− buf <- liftEffect $ AB.empty 1
219− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
220− pure buf
221
97
222−-- | Append an 8-bit unsigned integer (byte) to the builder.
98+-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
223−putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
99+putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
224−putUint8 = putArrayBuffer <=< encodeUint8
100+putDataBuff = tell <<< Internal.singleton
225
101
226−-- | 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.
227−encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
103+putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
228−encodeInt8 x = do
104+putUint8 = putArrayBuffer <=< Internal.encodeUint8
229− buf <- liftEffect $ AB.empty 1
230− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
231− pure buf
232
105
233-- | 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.
234−putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
107+putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
235−putInt8 = putArrayBuffer <=< encodeInt8
108+putInt8 = putArrayBuffer <=< Internal.encodeInt8
236−
237−-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
238−encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
239−encodeUint16be x = do
240− buf <- liftEffect $ AB.empty 2
241− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
242− pure buf
243
109
244-- | Append a 16-bit big-endian unsigned integer to the builder.
110-- | Append a 16-bit big-endian unsigned integer to the builder.
245−putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
111+putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
246−putUint16be = putArrayBuffer <=< encodeUint16be
112+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
247−
248−-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
249−encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
250−encodeUint16le x = do
251− buf <- liftEffect $ AB.empty 2
252− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
253− pure buf
254
113
255-- | Append a 16-bit little-endian unsigned integer to the builder.
114-- | Append a 16-bit little-endian unsigned integer to the builder.
256−putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
115+putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
257−putUint16le = putArrayBuffer <=< encodeUint16le
116+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
258−
259−-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
260−encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
261−encodeInt16be x = do
262− buf <- liftEffect $ AB.empty 2
263− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
264− pure buf
265
117
266-- | 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.
267−putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
119+putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
268−putInt16be = putArrayBuffer <=< encodeInt16be
120+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
269−
270−-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
271−encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
272−encodeInt16le x = do
273− buf <- liftEffect $ AB.empty 2
274− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
275− pure buf
276
121
277-- | 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.
278−putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
123+putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
279−putInt16le = putArrayBuffer <=< encodeInt16le
124+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
280−
281−-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
282−encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
283−encodeUint32be x = do
284− buf <- liftEffect $ AB.empty 4
285− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
286− pure buf
287
125
288-- | Append a 32-bit big-endian unsigned integer to the builder.
126-- | Append a 32-bit big-endian unsigned integer to the builder.
289−putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
127+putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
290−putUint32be = putArrayBuffer <=< encodeUint32be
128+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
291−
292−-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
293−encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
294−encodeUint32le x = do
295− buf <- liftEffect $ AB.empty 4
296− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
297− pure buf
298
129
299-- | Append a 32-bit little-endian unsigned integer to the builder.
130-- | Append a 32-bit little-endian unsigned integer to the builder.
300−putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
131+putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
301−putUint32le = putArrayBuffer <=< encodeUint32le
132+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
302−
303−-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
304−encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
305−encodeInt32be x = do
306− buf <- liftEffect $ AB.empty 4
307− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
308− pure buf
309
133
310-- | 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.
311−putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
135+putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
312−putInt32be = putArrayBuffer <=< encodeInt32be
136+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
313−
314−-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
315−encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
316−encodeInt32le x = do
317− buf <- liftEffect $ AB.empty 4
318− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
319− pure buf
320
137
321-- | 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.
322−putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
139+putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
323−putInt32le = putArrayBuffer <=< encodeInt32le
140+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
324−
325−-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
326−encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
327−encodeFloat32be x = do
328− buf <- liftEffect $ AB.empty 4
329− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
330− pure buf
331
141
332-- | 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.
333−putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
143+putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
334−putFloat32be = putArrayBuffer <=< encodeFloat32be
144+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
335−
336−-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
337−encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
338−encodeFloat32le x = do
339− buf <- liftEffect $ AB.empty 4
340− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
341− pure buf
342
145
343-- | 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.
344−putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
147+putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
345−putFloat32le = putArrayBuffer <=< encodeFloat32le
148+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
346−
347−-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
348−encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
349−encodeFloat64be x = do
350− buf <- liftEffect $ AB.empty 8
351− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
352− pure buf
353
149
354-- | 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.
355−putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
151+putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
356−putFloat64be = putArrayBuffer <=< encodeFloat64be
152+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
357−
358−-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
359−encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
360−encodeFloat64le x = do
361− buf <- liftEffect $ AB.empty 8
362− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
363− pure buf
364
153
365-- | 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.
366−putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
155+putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
367−putFloat64le = putArrayBuffer <=< encodeFloat64le
156+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
368−
369−
370−-- ## Implementation Details
371−--
372−-- We want our `Builder` to be a data structure with
373−-- * *O(1)* monoid append
374−-- * *O(n)* fold
375−--
376−-- Our `Builder` implementation is an unbalanced binary tree.
377−--
378−-- For monoid `append`, what we actually get is *O(1)* when either the
379−-- left or right tree is a singleton. If that's not true, then in the
380−-- unlikely worst case `append` might be *O(n)*.
381−--
382−-- `Builder` is optimized what we consider to be normal usage, that is,
383−-- `snoc`ing singleton elements to the end of the `Builder`.
384−--
385−-- If a Builder is built entirely by `snoc`ing, it will look like a
386−-- left-only binary tree, a.k.a. a linked list.
387−--
388−-- ```
389−-- ④
390−-- ╱
391−-- ③
392−-- ╱
393−-- ②
394−-- ╱
395−-- ①
396−-- ```
397−--
398−-- If two of these `snoc`-built trees are `append`ed, then the new tree
399−-- will look like
400−--
401−-- ```
402−-- ④
403−-- ╱ ╲
404−-- ③ ⑧
405−-- ╱ ╱
406−-- ② ⑦
407−-- ╱ ╱
408−-- ① ⑥
409−-- ╱
410−-- ⑤
411−-- ```
412−--
413−-- This is all similar to
414−-- [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
415−-- , except that the
416−-- [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
417−-- structure in __bytestring-tree-builder__ only carries values in its
418−-- leaves, which is how it achieves *O(1)* appending, at the cost of
419−-- a higher coefficient time factor on the fold.
420−--
421−-- We hope that this implementation is fairly fast, but we
422−-- haven't chosen this implementation because it's fast, we've chosen
423−-- this implementation because it's simple.
424−-- If someone wants to create a fast Purescript ArrayBuffer serialization
425−-- library, then they can benchmark against this one to prove that the new
426−-- one is fast.
427−--
428−-- One relatively cheap and simple performance improvement for this library would be to
429−-- remove the Null constructor of `Builder` and instead use Javascript nulls.
430−--
431−-- In the longer term, it might make sense to try to change the Builder so
432−-- that it works like the
433−-- https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
434−--
435−-- Here are some benchmarks of different Haskell ByteString builders
436−-- https://github.com/haskell-perf/strict-bytestring-builders
437−--
438−-- We've tried to design the API for this library with minimal assumptions,
439−-- so that if we want to change the Builder implementation later then we can.
440−--
441−-- Another way this could go:
442−-- https://kodimensional.dev/posts/2019-03-25-comonadic-builders
443−
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+98−52
@@ -1,13 +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)
10−import Control.Monad.Writer.Trans (tell)
21+import Web.Encoding.TextEncoder as TextEncoder
11
22
12asBytes :: ArrayBuffer -> Effect (Array Int)
23asBytes :: ArrayBuffer -> Effect (Array Int)
13asBytes x = do
24asBytes x = do
@@ -17,80 +28,82 @@ asBytes x = do
17putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
28putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
18putTest label expected put = do
29putTest label expected put = do
19 actual <- asBytes =<< execPut put
30 actual <- asBytes =<< execPut put
20− assertEqual' label {actual,expected}
31+ assertEqual' label { actual, expected }
21
32
22buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
33buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
23buildTest label expected bldr = do
34buildTest label expected bldr = do
24 actual <- asBytes =<< execBuilder =<< bldr
35 actual <- asBytes =<< execBuilder =<< bldr
25− assertEqual' label {actual,expected}
36+ assertEqual' label { actual, expected }
26
37
27main :: Effect Unit
38main :: Effect Unit
28main = do
39main = do
29− putTest "Test 0" [6,7,8] $ do
40+ putTest "Test 0" [ 6, 7, 8 ] do
30 putInt8 6
41 putInt8 6
31 putInt8 7
42 putInt8 7
32 putInt8 8
43 putInt8 8
33
44
34− putTest "Test 1" [255,254] $ do
45+ putTest "Test 1" [ 255, 254 ] do
35 putInt16be (-2)
46 putInt16be (-2)
36
47
37− putTest "Test 3" [3,0,0,0] $ do
48+ putTest "Test 3" [ 3, 0, 0, 0 ] do
38 putInt32le 3
49 putInt32le 3
39
50
40− buildTest "Test 4" [1,2,3,4] $ do
51+ buildTest "Test 4" [ 1, 2, 3, 4 ] do
41− b1 <- encodeInt8 1
52+ b1 <- Buff <$> encodeInt8 1
42− b2 <- encodeInt8 2
53+ b2 <- Buff <$> encodeInt8 2
43− b3 <- encodeInt8 3
54+ b3 <- Buff <$> encodeInt8 3
44− b4 <- encodeInt8 4
55+ b4 <- Buff <$> encodeInt8 4
45 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
56 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
46
57
47− buildTest "Test 5" [1,2,3,4] $ do
58+ buildTest "Test 5" [ 1, 2, 3, 4 ] do
48− b1 <- encodeInt8 1
59+ b1 <- Buff <$> encodeInt8 1
49− b2 <- encodeInt8 2
60+ b2 <- Buff <$> encodeInt8 2
50− b3 <- encodeInt8 3
61+ b3 <- Buff <$> encodeInt8 3
51− b4 <- encodeInt8 4
62+ b4 <- Buff <$> encodeInt8 4
52 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
63 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
53
64
54− buildTest "Test 6" [1,2,3,4] $ do
65+ buildTest "Test 6" [ 1, 2, 3, 4 ] do
55− b1 <- encodeInt8 1
66+ b1 <- Buff <$> encodeInt8 1
56− b2 <- encodeInt8 2
67+ b2 <- Buff <$> encodeInt8 2
57− b3 <- encodeInt8 3
68+ b3 <- Buff <$> encodeInt8 3
58− b4 <- encodeInt8 4
69+ b4 <- Buff <$> encodeInt8 4
59 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
60
71
61− 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
62− b1 <- encodeInt8 1
73+ b1 <- Buff <$> encodeInt8 1
63− b2 <- encodeInt8 2
74+ b2 <- Buff <$> encodeInt8 2
64− b3 <- encodeInt8 3
75+ b3 <- Buff <$> encodeInt8 3
65− b4 <- encodeInt8 4
76+ b4 <- Buff <$> encodeInt8 4
66− b5 <- encodeInt8 5
77+ b5 <- Buff <$> encodeInt8 5
67− b6 <- encodeInt8 6
78+ b6 <- Buff <$> encodeInt8 6
68− b7 <- encodeInt8 7
79+ b7 <- Buff <$> encodeInt8 7
69− b8 <- encodeInt8 8
80+ b8 <- Buff <$> encodeInt8 8
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
81 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
82+ <> singleton b5
71− <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
83+ <> (singleton b6 <> singleton b7)
72−
84+ <> singleton b8
85+
73− 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
74− b1 <- encodeInt8 1
87+ b1 <- Buff <$> encodeInt8 1
75− b2 <- encodeInt8 2
88+ b2 <- Buff <$> encodeInt8 2
76− b3 <- encodeInt8 3
89+ b3 <- Buff <$> encodeInt8 3
77− b4 <- encodeInt8 4
90+ b4 <- Buff <$> encodeInt8 4
78− b5 <- encodeInt8 5
91+ b5 <- Buff <$> encodeInt8 5
79− b6 <- encodeInt8 6
92+ b6 <- Buff <$> encodeInt8 6
80− b7 <- encodeInt8 7
93+ b7 <- Buff <$> encodeInt8 7
81− b8 <- encodeInt8 8
94+ b8 <- Buff <$> encodeInt8 8
82 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
95 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
83− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
96+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
84
97
85− buildTest "Test 8" [1,2,3,4] $ do
98+ buildTest "Test 8" [ 1, 2, 3, 4 ] do
86− b1 <- encodeInt8 1
99+ b1 <- Buff <$> encodeInt8 1
87− b2 <- encodeInt8 2
100+ b2 <- Buff <$> encodeInt8 2
88− b3 <- encodeInt8 3
101+ b3 <- Buff <$> encodeInt8 3
89− b4 <- encodeInt8 4
102+ b4 <- Buff <$> encodeInt8 4
90 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
91
104
92− putTest "Test 9" [1,2,2,3,4] $ do
105+ putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
93− x <- subBuilder $ do
106+ x <- subBuilder do
94 putInt8 3
107 putInt8 3
95 putInt8 4
108 putInt8 4
96 putInt8 1
109 putInt8 1
@@ -98,3 +111,36 @@ main = do
98 putInt8 $ length x
111 putInt8 $ length x
99 tell x
112 tell x
100
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+ }