git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on 031e52b help sign in
4b92c08
swap
0 ahead, 43 behind
.github/workflows/ci.ymldeleted−46
since splitsnapshots
unifiedsplit
@@ -1,46 +0,0 @@
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.ymlnew file+17
@@ -0,0 +1,17 @@
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,40 +1,3 @@
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
1## v1.1.0 2020-09-10
39
2
40Add and export
3Add and export
DEVELOPMENT.mdnew file+42
@@ -0,0 +1,42 @@
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+33−71
@@ -1,21 +1,27 @@
1# purescript-arraybuffer-builder
1# purescript-arraybuffer-builder
2
2
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)
3+[![CI](https://github.com/jamesdbrock/purescript-arraybuffer-builder/workflows/CI/badge.svg?branch=master)](https://github.com/jamesdbrock/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)
6
5
7−
8−[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
9−serialization in the “builder monoid” and “builder monad” style.
6+`ArrayBuffer` serialization in the “builder monoid” and “builder monad” style.
10−In this style, we build up serialized data structures by `tell`ing to
7+In this style, we build up serialized data structures by `append`ing to
11−a `Writer` monad with `do`-notation. This style of serialization
8+a monoid in a Writer monad with do-notation. This style of serialization
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).
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).
13
10
14This package provides a `Builder` monoid and a `PutM` monad which are roughly
11This package provides a `Builder` monoid and a `PutM` monad which are roughly
15equivalent to types of the same name in the Haskell
12equivalent to types of the same name in the Haskell
16−[__Data.Binary.Put__](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
13+[`Data.Binary.Put`](https://hackage.haskell.org/package/binary/docs/Data-Binary-Put.html)
17module.
14module.
18
15
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+
19## Usage Examples
25## Usage Examples
20
26
21All `ArrayBuffer` building must occur in `Effect`.
27All `ArrayBuffer` building must occur in `Effect`.
@@ -24,10 +30,8 @@ All `ArrayBuffer` building must occur in `Effect`.
24
30
25Create a two-byte `arraybuffer :: ArrayBuffer` which contains the number *-10* encoded as big-endian 16-bit two’s-complement.
31Create a two-byte `arraybuffer :: ArrayBuffer` which contains the number *-10* encoded as big-endian 16-bit two’s-complement.
26```purescript
32```purescript
27−import Data.ArrayBuffer.Builder (execPut, putInt16be)
28−
29do
33do
30− arraybuffer :: ArrayBuffer <- execPut $ putInt16be (-10)
34+ arraybuffer <- execPut $ putInt16be (-10)
31```
35```
32
36
33### Serialize three floats
37### Serialize three floats
@@ -36,10 +40,8 @@ Create a 24-byte `arraybuffer :: ArrayBuffer` which contains three big-endian
36IEEE-754 double-precision floats.
40IEEE-754 double-precision floats.
37
41
38```purescript
42```purescript
39−import Data.ArrayBuffer.Builder (execPut, putFloat64be)
40−
41do
43do
42− arraybuffer :: ArrayBuffer <- execPut do
44+ arraybuffer <- execPut $ do
43 putFloat64be 1.0
45 putFloat64be 1.0
44 putFloat64be 2.0
46 putFloat64be 2.0
45 putFloat64be 3.0
47 putFloat64be 3.0
@@ -47,30 +49,22 @@ do
47
49
48### Serialize a `String` as UTF8
50### Serialize a `String` as UTF8
49
51
50−Encode a `String` as UTF8 with a length prefix into our `Builder`.
52+Encode a `String` as UTF8 with a length prefix.
51
53
52We give this as an example, rather than supporting it in the library, because
54We give this as an example, rather than supporting it in the library, because
53it depends on
55it depends on
54−[`Web.Encoding.TextEncoder`](https://pursuit.purescript.org/packages/purescript-web-encoding/docs/Web.Encoding.TextEncoder).
56+[`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).
55
57
56```purescript
58```purescript
57−import Effect.Class (class MonadEffect, liftEffect)
58−import Data.UInt (fromInt)
59−import Data.ArrayBuffer.Types (ArrayBuffer(..))
60−import Data.ArrayBuffer.Builder (PutM, putArrayBuffer, execPut, putUint32be)
61−import Data.ArrayBuffer.Typed (buffer)
62−import Data.ArrayBuffer.ArrayBuffer (byteLength)
63−import Web.Encoding.TextEncoder (new, TextEncoder, encode)
64−
65−putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
59+putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit
66putStringUtf8 s = do
60putStringUtf8 s = do
67− textEncoder <- liftEffect new
61+ let stringbuf = Data.ArrayBuffer.Typed.buffer $ Data.TextEncoding.encodeUtf8 s
68− let stringbuf = buffer $ encode s textEncoder
69− -- Put a 32-bit big-endian length for the utf8 string, in bytes.
62+ -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.
70− putUint32be $ fromInt $ byteLength stringbuf
63+ putUint32be $ Data.Uint.fromInt $ Data.ArrayBuffer.byteLength stringbuf
71 putArrayBuffer stringbuf
64 putArrayBuffer stringbuf
72
65
66+do
73−arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
67+ arraybuffer <- execPut $ putStringUtf8 "BLM"
74```
68```
75
69
76### Serialize an `Array Int`
70### Serialize an `Array Int`
@@ -83,62 +77,30 @@ from the Haskell
83library.
77library.
84
78
85```purescript
79```purescript
86−import Data.ArrayBuffer.Builder (execPut, putInt32be)
87−import Data.Foldable (traverse_)
88−import Data.Array (length)
89−
90−putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit
80+putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit
91putArrayInt32 xs = do
81putArrayInt32 xs = do
92− -- Put a 64-bit big-endian length prefix for the array.
82+ -- Put a 64-bit big-endian length prefix for the length of the array.
93− putInt32be 0
83+ putUint32be 0
94− putInt32be $ length xs
84+ putUint32be $ Data.Uint.fromInt $ Data.Array.length xs
95 traverse_ putInt32be xs
85 traverse_ putInt32be xs
96
86
97do
87do
98 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
88 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
99```
89```
100
90
101−### Serialize an `Array Int` stack-safe
102−
103−Stack-safe version of the `putArrayInt32` function above. For stack-safety
104−we use `foldRecM` instead of `traverse_` because `foldRecM` has a `MonadRec`
105−constraint which makes it stack-safe.
106−
107−```purescript
108−import Data.Array (foldRecM)
109−
110−putArrayInt32 :: forall m. MonadEffect m => MonadRec m => Array Int -> PutM m Unit
111−putArrayInt32 xs = do
112− -- Put a 64-bit big-endian length prefix for the array.
113− putInt32be 0
114− putInt32be $ length xs
115− foldRecM (\_ x -> putInt32be x) unit xs
116−```
117−
118−## Stack-safety
119−
120−This package will always be stack-safe if all of the functions called inside
121−of the `PutM` builder expression are stack-safe.
122−
123## Deserialization
91## Deserialization
124
92
125This package is only for writing `ArrayBuffer`s, not reading them.
93This package is only for writing `ArrayBuffer`s, not reading them.
126See
94See
127−[__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
95+[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
128for a way to deserialize from `ArrayBuffer` back to Purescript data.
96for a way to deserialize from `ArrayBuffer` back to Purescript data.
129
97
98+## References
99+
100+* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
101+
130## Alternative packages for serializing to an `ArrayBuffer`
102## Alternative packages for serializing to an `ArrayBuffer`
131
103
132* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
104* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
133* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
105* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
134* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
106* [__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+2−12
@@ -14,17 +14,7 @@
14 "output"
14 "output"
15 ],
15 ],
16 "dependencies": {
16 "dependencies": {
17− "purescript-arraybuffer": "^v13.1.1",
17+ "purescript-arraybuffer": "^v10.0.2",
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"
29 }
19 }
30}
20}
packages.dhall+3−2
@@ -116,9 +116,10 @@ let additions =
116 }
116 }
117-------------------------------
117-------------------------------
118-}
118-}
119+
120+
119let upstream =
121let upstream =
120− https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.4-20221209/src/packages.dhall
122+ https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20200708/packages.dhall sha256:df5b0f1ae92d4401404344f4fb2a7a3089612c9f30066dcddf9eaea4fe780e29
121− sha256:b55c24bf585df4041ae6e87124cab7b35d474a9a77c9c3862ee6bf1dae618d72
122
123
123let overrides = {=}
124let overrides = {=}
124
125
shell.nixnew file+22
@@ -0,0 +1,22 @@
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+}
spago.dhall+1−11
@@ -2,18 +2,8 @@
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"
14− , "arraybuffer-types"
5+ [ "arraybuffer-types"
15 , "arraybuffer"
6 , "arraybuffer"
16− , "tailrec"
17 ]
7 ]
18, packages = ./packages.dhall
8, packages = ./packages.dhall
19, sources = [ "src/**/*.purs" ]
9, sources = [ "src/**/*.purs" ]
src/Data/ArrayBuffer/Builder.purs+360−73
@@ -5,47 +5,67 @@
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 other operations for working with `ArrayBuffer`, see
8+-- | For 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 __arraybuffer__.
11+-- | in package __purescript-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
21− , putUint8
19+, putUint8
22− , putInt8
20+, putInt8
23− , putUint16be
21+, putUint16be
24− , putUint16le
22+, putUint16le
25− , putInt16be
23+, putInt16be
26− , putInt16le
24+, putInt16le
27− , putUint32be
25+, putUint32be
28− , putUint32le
26+, putUint32le
29− , putInt32be
27+, putInt32be
30− , putInt32le
28+, putInt32le
31− , putFloat32be
29+, putFloat32be
32− , putFloat32le
30+, putFloat32le
33− , putFloat64be
31+, putFloat64be
34− , putFloat64le
32+, putFloat64le
35− , module Data.ArrayBuffer.Builder.Internal
33+, Builder
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+)
36− ) where
55+where
37
56
38import Prelude
57import Prelude
39
58
40−import Control.Monad.Rec.Class (class MonadRec)
41import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
59import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
42−import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
60+import Data.ArrayBuffer.ArrayBuffer as AB
43−import Data.ArrayBuffer.Builder.Internal as Internal
44−import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
61+import Data.ArrayBuffer.DataView as DV
62+import Data.ArrayBuffer.Typed as AT
63+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
45import Data.Float32 (Float32)
64import Data.Float32 (Float32)
65+import Data.Maybe (Maybe(..))
46import Data.UInt (UInt)
66import Data.UInt (UInt)
47import Effect (Effect)
67import Effect (Effect)
48−import Effect.Class (class MonadEffect)
68+import Effect.Class (class MonadEffect, liftEffect)
49
69
50-- | The `PutM` monad is a `WriterT Builder` transformer monad which
70-- | The `PutM` monad is a `WriterT Builder` transformer monad which
51-- | gives us do-notation for the `Builder` monoid. The base monad must be
71-- | gives us do-notation for the `Builder` monoid. The base monad must be
@@ -58,11 +78,111 @@ type PutM = WriterT Builder
58-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
78-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
59type Put = PutM Effect
79type Put = PutM Effect
60
80
61−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
81+-- | Monoidal builder for `ArrayBuffer`s.
62−execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
82+-- |
63−execPutM = Internal.execBuilder <=< execWriterT
83+-- | ### Left-associative `<>>` append operator
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
64
180
65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
181+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
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)*
66execPut :: Put Unit -> Effect ArrayBuffer
186execPut :: Put Unit -> Effect ArrayBuffer
67execPut = execPutM
187execPut = execPutM
68
188
@@ -75,6 +195,7 @@ execPut = execPutM
75-- |
195-- |
76-- | In a `PutM` monad do-block, we can
196-- | In a `PutM` monad do-block, we can
77-- |
197-- |
198+-- |
78-- | ```
199-- | ```
79-- | do
200-- | do
80-- | messageBuilder <- subBuilder $ do
201-- | messageBuilder <- subBuilder $ do
@@ -84,73 +205,239 @@ execPut = execPutM
84-- | putInt32be $ length messageBuilder
205-- | putInt32be $ length messageBuilder
85-- | tell messageBuilder
206-- | tell messageBuilder
86-- | ```
207-- | ```
87−subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
208+subBuilder :: forall m. (MonadEffect m) => PutM m Unit -> PutM m Builder
88subBuilder = lift <<< execWriterT
209subBuilder = lift <<< execWriterT
89
210
90-- | Append an `ArrayBuffer` to the builder.
211-- | Append an `ArrayBuffer` to the builder.
91−putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
212+putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
92−putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
213+putArrayBuffer = tell <<< singleton
93−
94−-- | Append a `DataView` to the builder.
95−putDataView :: forall m. Monad m => DataView -> PutM m Unit
96−putDataView = tell <<< Internal.singleton <<< Internal.View
97
214
98−-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
215+-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
99−putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
216+encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
100−putDataBuff = tell <<< Internal.singleton
217+encodeUint8 x = do
218+ buf <- liftEffect $ AB.empty 1
219+ _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
220+ pure buf
101
221
102-- | Append an 8-bit unsigned integer (byte) to the builder.
222-- | Append an 8-bit unsigned integer (byte) to the builder.
103−putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
223+putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
104−putUint8 = putArrayBuffer <=< Internal.encodeUint8
224+putUint8 = putArrayBuffer <=< encodeUint8
225+
226+-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
227+encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
228+encodeInt8 x = do
229+ buf <- liftEffect $ AB.empty 1
230+ _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
231+ pure buf
105
232
106-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
233-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
107−putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
234+putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
108−putInt8 = putArrayBuffer <=< Internal.encodeInt8
235+putInt8 = putArrayBuffer <=< 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
109
243
110-- | Append a 16-bit big-endian unsigned integer to the builder.
244-- | Append a 16-bit big-endian unsigned integer to the builder.
111−putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
245+putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
112−putUint16be = putArrayBuffer <=< Internal.encodeUint16be
246+putUint16be = putArrayBuffer <=< 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
113
254
114-- | Append a 16-bit little-endian unsigned integer to the builder.
255-- | Append a 16-bit little-endian unsigned integer to the builder.
115−putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
256+putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
116−putUint16le = putArrayBuffer <=< Internal.encodeUint16le
257+putUint16le = putArrayBuffer <=< 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
117
265
118-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
266-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
119−putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
267+putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
120−putInt16be = putArrayBuffer <=< Internal.encodeInt16be
268+putInt16be = putArrayBuffer <=< 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
121
276
122-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
277-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
123−putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
278+putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
124−putInt16le = putArrayBuffer <=< Internal.encodeInt16le
279+putInt16le = putArrayBuffer <=< 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
125
287
126-- | Append a 32-bit big-endian unsigned integer to the builder.
288-- | Append a 32-bit big-endian unsigned integer to the builder.
127−putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
289+putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
128−putUint32be = putArrayBuffer <=< Internal.encodeUint32be
290+putUint32be = putArrayBuffer <=< 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
129
298
130-- | Append a 32-bit little-endian unsigned integer to the builder.
299-- | Append a 32-bit little-endian unsigned integer to the builder.
131−putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
300+putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
132−putUint32le = putArrayBuffer <=< Internal.encodeUint32le
301+putUint32le = putArrayBuffer <=< 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
133
309
134-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
310-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
135−putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
311+putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
136−putInt32be = putArrayBuffer <=< Internal.encodeInt32be
312+putInt32be = putArrayBuffer <=< 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
137
320
138-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
321-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
139−putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
322+putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
140−putInt32le = putArrayBuffer <=< Internal.encodeInt32le
323+putInt32le = putArrayBuffer <=< 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
141
331
142-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
332-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
143−putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
333+putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
144−putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
334+putFloat32be = putArrayBuffer <=< 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
145
342
146-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
343-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
147−putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
344+putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
148−putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
345+putFloat32le = putArrayBuffer <=< 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
149
353
150-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
354-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
151−putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
355+putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
152−putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
356+putFloat64be = putArrayBuffer <=< 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
153
364
154-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
365-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
155−putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
366+putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
156−putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
367+putFloat64le = putArrayBuffer <=< 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.pursdeleted−368
@@ -1,368 +0,0 @@
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
spago-dev.dhall → test.dhallrenamed+2−6
@@ -12,9 +12,5 @@ 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 #
15+ , dependencies = conf.dependencies # [ "assert" ]
16− [ "assert"
17− , "arrays"
18− , "web-encoding"
19− ]
20− }
16+ }
test/Main.purs+52−98
@@ -1,24 +1,13 @@
1module Test.Main where
1module Test.Main where
2
2
3−import Prelude
3+import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
4−
5−import Control.Monad.Writer.Trans (tell)
6−import Data.Array (foldRecM)
7−import Data.Array as Array
8−import Data.ArrayBuffer.ArrayBuffer (byteLength)
9−import Data.ArrayBuffer.Builder (Builder, DataBuff(..), PutM, execPut, putArrayBuffer, putInt16be, putInt32be, putInt32le, putInt8, subBuilder)
10−import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
11−import Data.ArrayBuffer.DataView as DV
4+import Data.ArrayBuffer.Types (ArrayBuffer,Uint8Array)
12−import Data.ArrayBuffer.Typed (buffer)
13import Data.ArrayBuffer.Typed as AT
5import Data.ArrayBuffer.Typed as AT
14−import Data.ArrayBuffer.Typed as AV
15−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
16import Data.UInt as UInt
6import Data.UInt as UInt
17import Effect (Effect)
7import Effect (Effect)
18−import Effect.Class (class MonadEffect, liftEffect)
19import Test.Assert (assertEqual')
8import Test.Assert (assertEqual')
20−import Web.Encoding.TextEncoder (encode)
9+import Data.ArrayBuffer.Builder
21−import Web.Encoding.TextEncoder as TextEncoder
10+import Control.Monad.Writer.Trans (tell)
22
11
23asBytes :: ArrayBuffer -> Effect (Array Int)
12asBytes :: ArrayBuffer -> Effect (Array Int)
24asBytes x = do
13asBytes x = do
@@ -28,82 +17,80 @@ asBytes x = do
28putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
17putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
29putTest label expected put = do
18putTest label expected put = do
30 actual <- asBytes =<< execPut put
19 actual <- asBytes =<< execPut put
31− assertEqual' label { actual, expected }
20+ assertEqual' label {actual,expected}
32
21
33buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
22buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
34buildTest label expected bldr = do
23buildTest label expected bldr = do
35 actual <- asBytes =<< execBuilder =<< bldr
24 actual <- asBytes =<< execBuilder =<< bldr
36− assertEqual' label { actual, expected }
25+ assertEqual' label {actual,expected}
37
26
38main :: Effect Unit
27main :: Effect Unit
39main = do
28main = do
40− putTest "Test 0" [ 6, 7, 8 ] do
29+ putTest "Test 0" [6,7,8] $ do
41 putInt8 6
30 putInt8 6
42 putInt8 7
31 putInt8 7
43 putInt8 8
32 putInt8 8
44
33
45− putTest "Test 1" [ 255, 254 ] do
34+ putTest "Test 1" [255,254] $ do
46 putInt16be (-2)
35 putInt16be (-2)
47
36
48− putTest "Test 3" [ 3, 0, 0, 0 ] do
37+ putTest "Test 3" [3,0,0,0] $ do
49 putInt32le 3
38 putInt32le 3
50
39
51− buildTest "Test 4" [ 1, 2, 3, 4 ] do
40+ buildTest "Test 4" [1,2,3,4] $ do
52− b1 <- Buff <$> encodeInt8 1
41+ b1 <- encodeInt8 1
53− b2 <- Buff <$> encodeInt8 2
42+ b2 <- encodeInt8 2
54− b3 <- Buff <$> encodeInt8 3
43+ b3 <- encodeInt8 3
55− b4 <- Buff <$> encodeInt8 4
44+ b4 <- encodeInt8 4
56 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
45 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
57
46
58− buildTest "Test 5" [ 1, 2, 3, 4 ] do
47+ buildTest "Test 5" [1,2,3,4] $ do
59− b1 <- Buff <$> encodeInt8 1
48+ b1 <- encodeInt8 1
60− b2 <- Buff <$> encodeInt8 2
49+ b2 <- encodeInt8 2
61− b3 <- Buff <$> encodeInt8 3
50+ b3 <- encodeInt8 3
62− b4 <- Buff <$> encodeInt8 4
51+ b4 <- encodeInt8 4
63 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
52 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
64
53
65− buildTest "Test 6" [ 1, 2, 3, 4 ] do
54+ buildTest "Test 6" [1,2,3,4] $ do
66− b1 <- Buff <$> encodeInt8 1
55+ b1 <- encodeInt8 1
67− b2 <- Buff <$> encodeInt8 2
56+ b2 <- encodeInt8 2
68− b3 <- Buff <$> encodeInt8 3
57+ b3 <- encodeInt8 3
69− b4 <- Buff <$> encodeInt8 4
58+ b4 <- encodeInt8 4
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
59 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
71
60
72− buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
61+ buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do
73− b1 <- Buff <$> encodeInt8 1
62+ b1 <- encodeInt8 1
74− b2 <- Buff <$> encodeInt8 2
63+ b2 <- encodeInt8 2
75− b3 <- Buff <$> encodeInt8 3
64+ b3 <- encodeInt8 3
76− b4 <- Buff <$> encodeInt8 4
65+ b4 <- encodeInt8 4
77− b5 <- Buff <$> encodeInt8 5
66+ b5 <- encodeInt8 5
78− b6 <- Buff <$> encodeInt8 6
67+ b6 <- encodeInt8 6
79− b7 <- Buff <$> encodeInt8 7
68+ b7 <- encodeInt8 7
80− b8 <- Buff <$> encodeInt8 8
69+ b8 <- encodeInt8 8
81 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
82− <> singleton b5
83− <> (singleton b6 <> singleton b7)
71+ <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
84− <> singleton b8
72+
85−
86− buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
73+ buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do
87− b1 <- Buff <$> encodeInt8 1
74+ b1 <- encodeInt8 1
88− b2 <- Buff <$> encodeInt8 2
75+ b2 <- encodeInt8 2
89− b3 <- Buff <$> encodeInt8 3
76+ b3 <- encodeInt8 3
90− b4 <- Buff <$> encodeInt8 4
77+ b4 <- encodeInt8 4
91− b5 <- Buff <$> encodeInt8 5
78+ b5 <- encodeInt8 5
92− b6 <- Buff <$> encodeInt8 6
79+ b6 <- encodeInt8 6
93− b7 <- Buff <$> encodeInt8 7
80+ b7 <- encodeInt8 7
94− b8 <- Buff <$> encodeInt8 8
81+ b8 <- encodeInt8 8
95 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
82 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
96− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
83+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
97
84
98− buildTest "Test 8" [ 1, 2, 3, 4 ] do
85+ buildTest "Test 8" [1,2,3,4] $ do
99− b1 <- Buff <$> encodeInt8 1
86+ b1 <- encodeInt8 1
100− b2 <- Buff <$> encodeInt8 2
87+ b2 <- encodeInt8 2
101− b3 <- Buff <$> encodeInt8 3
88+ b3 <- encodeInt8 3
102− b4 <- Buff <$> encodeInt8 4
89+ b4 <- encodeInt8 4
103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
90 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
104
91
105− putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
92+ putTest "Test 9" [1,2,2,3,4] $ do
106− x <- subBuilder do
93+ x <- subBuilder $ do
107 putInt8 3
94 putInt8 3
108 putInt8 4
95 putInt8 4
109 putInt8 1
96 putInt8 1
@@ -111,36 +98,3 @@ main = do
111 putInt8 $ length x
98 putInt8 $ length x
112 tell x
99 tell x
113
100
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− }