git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on master help sign in
13 files changed+692−679
since splitsnapshots
unifiedsplit
.github/workflows/ci.yml+46 .github/workflows/push-build.yml−42 CHANGELOG.md+34−3 DEVELOPMENT.md−43 README.md+50−43 bower.json+12−8 packages.dhall+3−47 shell.nix−19 test.dhall → spago-dev.dhall+6−2 spago.dhall+4 src/Data/ArrayBuffer/Builder.purs+71−407 src/Data/ArrayBuffer/Internal.purs+368 test/Main.purs+98−65
.github/workflows/ci.ymlnew file+46
@@ -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−42
@@ -1,42 +0,0 @@
1−name: CI
2−
3−on: [push]
4−
5−jobs:
6− build:
7−
8− runs-on: ubuntu-latest
9−
10− # https://github.com/purescript-contrib/setup-purescript
11−
12− steps:
13− # https://github.com/cachix/install-nix-action
14− - uses: actions/checkout@v2.3.4
15− - uses: cachix/install-nix-action@v13
16− with:
17− nix_path: nixpkgs=channel:nixos-unstable
18− - run: nix-shell --command 'spago --global-cache skip --config test.dhall test'
19−
20− # https://github.com/purescript-contrib/setup-purescript
21−
22− # - uses: actions/checkout@v2
23− # - name: Set up a PureScript toolchain
24− # uses: purescript-contrib/setup-purescript@main
25− # with:
26− # purescript: "0.14.1"
27− # spago: "0.20.1"
28−
29−# - name: Cache PureScript dependencies
30−# uses: actions/cache@v2
31−# # This cache uses the .dhall files to know when it should reinstall
32−# # and rebuild packages. It caches both the installed packages from
33−# # the `.spago` directory and compilation artifacts from the `output`
34−# # directory. When restored the compiler will rebuild any files that
35−# # have changed. If you do not want to cache compiled output, remove
36−# # the `output` path.
37−# with:
38−# key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}
39−# path: |
40−# .spago
41−
42− # - run: spago -x test.dhall test
CHANGELOG.md+34−3
@@ -1,8 +1,39 @@
1−## v2.0.0 2021-04-29
1+# Changelog
22
3−Added the `Bytes` type.
3+## v3.1.0 2022-12-10
44
5−Spago build for PureScript v0.14.1.
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.
637
738## v1.1.0 2020-09-10
839
DEVELOPMENT.mddeleted−43
@@ -1,43 +0,0 @@
1−# Development Notes
2−
3−All of the commands needed for development are in the `shell.nix` environment.
4−
5−```
6−$ nix-shell
7−```
8−
9−## Edit
10−
11−The `psc-ide` command is available for the [VS Code Purescript IDE extension](https://github.com/nwolverson/vscode-ide-purescript.git).
12−
13−```
14−[nix-shell:]$ code .
15−```
16−
17−## Build
18−
19−```
20−[nix-shell:]$ spago build
21−```
22−
23−## Test
24−
25−The test dependencies are specified seperately in `test.dhall`.
26−
27−```
28−[nix-shell:]$ spago -x test.dhall test
29−```
30−
31−## Publishing to Pursuit with `spago`
32−
33−[Publishing with `spago`](https://github.com/purescript/spago#publish-my-library).
34−
35−```
36−[nix-shell:]$ bower install --save
37−[nix-shell:]$ spago bump-version --no-dry-run major
38−[nix-shell:]$ pulp publish --no-push
39−```
40−
41−## Bower
42−
43−The `bower.json` is generated by running `spago bump-version`, do not edit it.
README.md+50−43
@@ -1,27 +1,21 @@
11# purescript-arraybuffer-builder
22
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)
44[![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)
56
6−`ArrayBuffer` serialization in the “builder monoid” and “builder monad” style.
7−In this style, we build up serialized data structures by `append`ing to
8−a monoid in a Writer monad with do-notation. This style of serialization
7+
8+[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
9+serialization in the “builder monoid” and “builder monad” style.
10+In this style, we build up serialized data structures by `tell`ing to
11+a `Writer` monad with `do`-notation. This style of serialization
912has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).
1013
1114This package provides a `Builder` monoid and a `PutM` monad which are roughly
1215equivalent 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)
1417module.
1518
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−
2519## Usage Examples
2620
2721All `ArrayBuffer` building must occur in `Effect`.
@@ -45,7 +39,7 @@ IEEE-754 double-precision floats.
4539import Data.ArrayBuffer.Builder (execPut, putFloat64be)
4640
4741do
48− arraybuffer :: ArrayBuffer <- execPut $ do
42+ arraybuffer :: ArrayBuffer <- execPut do
4943 putFloat64be 1.0
5044 putFloat64be 2.0
5145 putFloat64be 3.0
@@ -57,23 +51,26 @@ Encode a `String` as UTF8 with a length prefix into our `Builder`.
5751
5852We give this as an example, rather than supporting it in the library, because
5953it depends on
60−[`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).
6155
6256```purescript
63−import Data.ArrayBuffer.Builder (PutM, putArrayBuffer, execPut)
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)
6461import Data.ArrayBuffer.Typed (buffer)
65−import Data.TextEncoding (encodeUtf8)
6662import Data.ArrayBuffer.ArrayBuffer (byteLength)
63+import Web.Encoding.TextEncoder (new, TextEncoder, encode)
6764
68−putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit
65+putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
6966putStringUtf8 s = do
70− let stringbuf = buffer $ encodeUtf8 s
71− -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.
72− putInt32be $ byteLength stringbuf
67+ textEncoder <- liftEffect new
68+ let stringbuf = buffer $ encode s textEncoder
69+ -- Put a 32-bit big-endian length for the utf8 string, in bytes.
70+ putUint32be $ fromInt $ byteLength stringbuf
7371 putArrayBuffer stringbuf
7472
75−do
76− arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "BLM"
73+arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
7774```
7875
7976### Serialize an `Array Int`
@@ -90,9 +87,9 @@ import Data.ArrayBuffer.Builder (execPut, putInt32be)
9087import Data.Foldable (traverse_)
9188import Data.Array (length)
9289
93−putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit
90+putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit
9491putArrayInt32 xs = do
95− -- 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.
9693 putInt32be 0
9794 putInt32be $ length xs
9895 traverse_ putInt32be xs
@@ -101,37 +98,47 @@ do
10198 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
10299```
103100
101+### Serialize an `Array Int` stack-safe
104102
105−## `unsafePerformEffect execPut`
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.
106106
107−Dear computer programmer, you can call `execPut` inside `unsafePerformEffect`.
107+```purescript
108+import Data.Array (foldRecM)
108109
109−The reason why this whole library is `Effect`ful is that `ArrayBuffer`s are mutable, so the `ArrayBuffer` library functions do everything in `Effect` to to confirm that any mutations are properly sequenced.
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+```
110117
111−However, all of the `put` functions in this library are actually side-effect free, so we can use `unsafePerformEffect` to tell the compiler to trust us that we don't perform any side-effects while we're building an `ArrayBuffer`.
118+## Stack-safety
112119
113−```purescript
114−let serialized :: ArrayBuffer
115− serialized = unsafePerformEffect $ execPut do
116− putInt32be 3 -- ✅ Good, this has no side-effects
117− putInt32be =<< getCurrentPosixTime -- ❌ No don't do this
118− putArrayBuffer =<< readFileFromMyFilesystem -- ❌ No don’t do this either
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.
120122
121123## Deserialization
122124
123125This package is only for writing `ArrayBuffer`s, not reading them.
124126See
125−[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
127+[__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
126128for a way to deserialize from `ArrayBuffer` back to Purescript data.
127129
128−## References
129−
130−* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
131−
132130## Alternative packages for serializing to an `ArrayBuffer`
133131
134132* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
135133* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
136134* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
137−* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)
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−8
@@ -14,13 +14,17 @@
1414 "output"
1515 ],
1616 "dependencies": {
17− "purescript-arraybuffer": "^v8.0.3",
18− "purescript-arraybuffer-types": "^v3.0.0",
19− "purescript-effect": "^v3.0.0",
20− "purescript-float32": "^v0.2.0",
21− "purescript-maybe": "^v5.0.0",
22− "purescript-prelude": "^v5.0.0",
23− "purescript-transformers": "^v5.0.0",
24− "purescript-uint": "^v5.1.4"
17+ "purescript-arraybuffer": "^v13.1.1",
18+ "purescript-arraybuffer-types": "^v3.0.2",
19+ "purescript-effect": "^v4.0.0",
20+ "purescript-float32": "^v2.0.0",
21+ "purescript-identity": "^v6.0.0",
22+ "purescript-lists": "^v7.0.0",
23+ "purescript-maybe": "^v6.0.0",
24+ "purescript-newtype": "^v5.0.0",
25+ "purescript-prelude": "^v6.0.1",
26+ "purescript-tailrec": "^v6.1.0",
27+ "purescript-transformers": "^v6.0.0",
28+ "purescript-uint": "^v7.0.0"
2529 }
2630}
packages.dhall+3−47
@@ -116,56 +116,12 @@ let additions =
116116 }
117117-------------------------------
118118-}
119−
120119let upstream =
121− https://github.com/purescript/package-sets/releases/download/psc-0.14.1-20210427/packages.dhall sha256:edbb8f70232fb83895c7ce02f5d2b29f6ee1722f1a70fc58d3bc0ab0de18afe4
120+ https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.4-20221209/src/packages.dhall
121+ sha256:b55c24bf585df4041ae6e87124cab7b35d474a9a77c9c3862ee6bf1dae618d72
122122
123123let overrides = {=}
124124
125−-- TODO Remove all of these additions when they are in package-sets for
126−-- Purescript v0.14.
127−let additions =
128− { arraybuffer =
129− { dependencies =
130− [ "effect"
131− , "arraybuffer-types"
132− , "maybe"
133− , "typelevel"
134− , "uint"
135− , "float32"
136− , "partial"
137− , "nullable"
138− , "functions"
139− ]
140− , repo =
141− "https://github.com/jacereda/purescript-arraybuffer.git"
142− , version =
143− "v8.0.3"
144− }
145− , float32 =
146− { dependencies =
147− [ "prelude"
148− ]
149− , repo =
150− "https://github.com/athanclark/purescript-float32.git"
151− , version =
152− "v0.2.0"
153− }
154− , uint =
155− { dependencies =
156− [ "effect"
157− , "quickcheck-laws"
158− , "console"
159− , "maybe"
160− , "math"
161− , "psci-support"
162− , "quickcheck"
163− ]
164− , repo =
165− "https://github.com/zaquest/purescript-uint.git"
166− , version =
167− "v5.1.4"
168− }
169− }
125+let additions = {=}
170126
171127in upstream // overrides // additions
shell.nixdeleted−19
@@ -1,19 +0,0 @@
1−{ pkgs ? import <nixpkgs> { } }:
2−let
3− easy-ps = import (builtins.fetchGit {
4− # url = "git@github.com:justinwoo/easy-purescript-nix.git";
5− url = "https://github.com/justinwoo/easy-purescript-nix.git";
6− ref = "master";
7− rev = "dae91f43317fd5ff207e11ea6bf4b6130e4ba9fc";
8− }) { inherit pkgs; };
9−in
10−pkgs.mkShell {
11− buildInputs = [
12− easy-ps.purs-0_14_1
13− easy-ps.spago
14− easy-ps.pulp
15− pkgs.nodejs-14_x
16− pkgs.nodePackages.bower
17− ];
18− LC_ALL = "C.UTF-8"; # https://github.com/purescript/spago/issues/507
19−}
test.dhall → spago-dev.dhallrenamed+6−2
@@ -12,5 +12,9 @@ let conf = ./spago.dhall
1212
1313in conf //
1414 { sources = conf.sources # [ "test/**/*.purs" ]
15− , dependencies = conf.dependencies # [ "assert" ]
16− }
15+ , dependencies = conf.dependencies #
16+ [ "assert"
17+ , "arrays"
18+ , "web-encoding"
19+ ]
20+ }
spago.dhall+4
@@ -4,12 +4,16 @@
44, dependencies =
55 [ "effect"
66 , "float32"
7+ , "identity"
8+ , "lists"
79 , "maybe"
10+ , "newtype"
811 , "prelude"
912 , "transformers"
1013 , "uint"
1114 , "arraybuffer-types"
1215 , "arraybuffer"
16+ , "tailrec"
1317 ]
1418, packages = ./packages.dhall
1519, sources = [ "src/**/*.purs" ]
src/Data/ArrayBuffer/Builder.purs+71−407
@@ -5,73 +5,47 @@
55-- | Writing to an `ArrayBuffer` is an `Effect`ful activity, so most
66-- | functions in this module must be run in a `MonadEffect` context.
77-- |
8−-- | For operations for working with `ArrayBuffer`, see
8+-- | For other operations for working with `ArrayBuffer`, see
99-- | module
1010-- | [`Data.ArrayBuffer.ArrayBuffer`](https://pursuit.purescript.org/packages/purescript-arraybuffer/docs/Data.ArrayBuffer.ArrayBuffer)
11−-- | in package __purescript-arraybuffer__.
11+-- | in package __arraybuffer__.
1212module Data.ArrayBuffer.Builder
13−( PutM
14−, Put
15−, execPutM
16−, execPut
17−, subBuilder
18−, putArrayBuffer
19−, putDataView
20−, putUint8
21−, putInt8
22−, putUint16be
23−, putUint16le
24−, putInt16be
25−, putInt16le
26−, putUint32be
27−, putUint32le
28−, putInt32be
29−, putInt32le
30−, putFloat32be
31−, putFloat32le
32−, putFloat64be
33−, putFloat64le
34−, Builder
35−, (<>>)
36−, Bytes
37−, toView
38−, execBuilder
39−, length
40−, singleton
41−, singleton_
42−, cons
43−, cons_
44−, snoc
45−, snoc_
46−, encodeUint8
47−, encodeInt8
48−, encodeUint16be
49−, encodeUint16le
50−, encodeInt16be
51−, encodeInt16le
52−, encodeUint32be
53−, encodeUint32le
54−, encodeInt32be
55−, encodeInt32le
56−, encodeFloat32be
57−, encodeFloat32le
58−, encodeFloat64be
59−, encodeFloat64le
60−)
61−where
13+ ( PutM
14+ , Put
15+ , execPutM
16+ , execPut
17+ , subBuilder
18+ , putArrayBuffer
19+ , putDataView
20+ , putDataBuff
21+ , putUint8
22+ , putInt8
23+ , putUint16be
24+ , putUint16le
25+ , putInt16be
26+ , putInt16le
27+ , putUint32be
28+ , putUint32le
29+ , putInt32be
30+ , putInt32le
31+ , putFloat32be
32+ , putFloat32le
33+ , putFloat64be
34+ , putFloat64le
35+ , module Data.ArrayBuffer.Builder.Internal
36+ ) where
6237
6338import Prelude
6439
40+import Control.Monad.Rec.Class (class MonadRec)
6541import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
66−import Data.ArrayBuffer.ArrayBuffer as AB
67−import Data.ArrayBuffer.DataView as DV
68−import Data.ArrayBuffer.Typed as AT
69−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, DataView, ByteLength)
42+import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
43+import Data.ArrayBuffer.Builder.Internal as Internal
44+import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
7045import Data.Float32 (Float32)
71−import Data.Maybe (Maybe(..))
7246import Data.UInt (UInt)
7347import Effect (Effect)
74−import Effect.Class (class MonadEffect, liftEffect)
48+import Effect.Class (class MonadEffect)
7549
7650-- | The `PutM` monad is a `WriterT Builder` transformer monad which
7751-- | gives us do-notation for the `Builder` monoid. The base monad must be
@@ -84,149 +58,11 @@ type PutM = WriterT Builder
8458-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
8559type Put = PutM Effect
8660
87−-- | Monoidal builder for `ArrayBuffer`s.
88−-- |
89−-- | We can add two types of things to the `Builder`: `ArrayBuffer`s and
90−-- | `DataView`s.
91−-- | We might prefer
92−-- | to add a `DataView` to a `Builder` when we’re adding a large slice of data
93−-- | from some other `ArrayBuffer`, so that we don’t
94−-- | need an extra intermediate copy of the slice.
95−-- | Our convention is that functions which add `DataView`s to
96−-- | the `Builder` are suffixed with underscore (`_`).
97−-- |
98−-- | ### Left-associative `<>>` append operator
99−-- |
100−-- | __TL;DR__ You probably don't want to use the `Builder` monoid directly
101−-- | in your code, it’s better to use the `PutM` monad with do-notation instead.
102−-- |
103−-- | The `Builder` monoid in this library is efficient when we `snoc` single
104−-- | items onto the end of it, or when we only `cons` single items to the
105−-- | beginning, but it can be less efficient when we are mixing `cons` and
106−-- | `snoc`.
107−-- | This matters when we're appending three or more `Builder`s
108−-- | in one associative expression, because the
109−-- | `Semigroup` append operator `<>` is right-associative.
110−-- |
111−-- | To solve this, we provide an operator `<>>` for appending `Builders`.
112−-- | `<>>` is exactly the same as `<>`, but left-associative.
113−-- | This only matters when we're chaining together three
114−-- | or more `Builder`s in a single associative expression.
115−-- | Instead of
116−-- | ```
117−-- | builder₁ <> builder₂ <> builder₃
118−-- | ```
119−-- | we should always prefer to
120−-- | write
121−-- | ```
122−-- | builder₁ <>> builder₂ <>> builder₃
123−-- | ```
124−-- | so that we get the efficient
125−-- | `snoc`ing of `Builder`s.
126−-- |
127−-- | If we build our `ArrayBuffer`s with the `PutM` monad instead of appending by
128−-- | using the `Semigroup` instance of `Builder`, then we always get the efficient
129−-- | `snoc` case.
130−-- |
131−data Builder
132− = Node Builder Bytes Builder
133− | Null
134−
135−instance semigroupBuilder :: Semigroup Builder where
136− append Null Null = Null
137− append l Null = l
138− append Null r = r
139− append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
140− append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
141− -- of the left tree
142− append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
143− -- side of the left tree
144− -- to find the rightmost
145− -- Null
146−
147−infixl 5 append as <>>
148−
149−instance monoidBuilder :: Monoid Builder where
150− mempty = Null
151−
152−-- | For distinguishing between `ArrayBuffer` and `DataView`.
153−data Bytes
154− = ByteBuff ArrayBuffer
155− | ByteView DataView
156−
157−toView :: Bytes -> DataView
158−toView (ByteBuff ab) = DV.whole ab
159−toView (ByteView dv) = dv
160−
161−-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
162−foldl :: forall b. (b -> Bytes -> b) -> b -> Builder -> b
163−foldl _ a Null = a
164−foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
165−
166−-- | Monomorphic foldM copied from
167−-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
168−foldM :: forall b m. (Monad m) => (b -> Bytes -> m b) -> b -> Builder -> m b
169−foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
170−
171−-- | Construct a `Builder` with a single `ArrayBuffer`. *O(1)*
172−singleton :: ArrayBuffer -> Builder
173−singleton buf = Node Null (ByteBuff buf) Null
174−
175−-- | Construct a `Builder` with a single `DataView`. *O(1)*
176−singleton_ :: DataView -> Builder
177−singleton_ buf = Node Null (ByteView buf) Null
178−
179−-- | Prepend an `ArrayBuffer` to the beginning of the `Builder`. *O(1)*
180−cons :: ArrayBuffer -> Builder -> Builder
181−cons x bs = Node Null (ByteBuff x) bs
182−
183−-- | Prepend a `DataView` to the beginning of the `Builder`. *O(1)*
184−cons_ :: DataView -> Builder -> Builder
185−cons_ x bs = Node Null (ByteView x) bs
61+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
62+execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
63+execPutM = Internal.execBuilder <=< execWriterT
18664
187−-- | Append an `ArrayBuffer` to the end of the `Builder`. *O(1)*
188−snoc :: Builder -> ArrayBuffer -> Builder
189−snoc bs x = Node bs (ByteBuff x) Null
190−
191−-- | Append a `DataView` to the end of the `Builder`. *O(1)*
192−snoc_ :: Builder -> DataView -> Builder
193−snoc_ bs x = Node bs (ByteView x) Null
194−
195−-- | Calculate the total byte length of the `Builder`. *O(n)*
196−length :: Builder -> ByteLength
197−length bldr = foldl (\b a -> b + len a) 0 bldr
198− where
199− len (ByteBuff ab) = AB.byteLength ab
200− len (ByteView dv) = DV.byteLength dv
201−
202−-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
203−execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
204−execBuilder bldr = do
205− let buflen = length bldr
206− -- Allocate the final ArrayBuffer
207− buf <- liftEffect $ AB.empty buflen
208− -- Then copy each ArrayBuffer into the final ArrayBuffer.
209− -- To memcpy from one ArrayBuffer to another, apparently we have to first view
210− -- both ArrayBuffers as ArrayView (Typed Array).
211− newview <- liftEffect (AT.whole buf :: Effect Uint8Array)
212− _ <- foldM
213− ( \offset a -> do
214− aview <- liftEffect $ toUint8Array a
215− _ <- liftEffect $ AT.setTyped newview (Just offset) aview
216− pure $ offset + AT.byteLength aview
217− ) 0 bldr
218− pure buf
219− where
220− toUint8Array :: Bytes -> Effect Uint8Array
221− toUint8Array (ByteBuff ab) = AT.whole ab
222− toUint8Array (ByteView dv) =
223− AT.part (DV.buffer dv) (DV.byteOffset dv) (DV.byteLength dv)
224−
225−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
226−execPutM :: forall m. (MonadEffect m) => PutM m Unit -> m ArrayBuffer
227−execPutM = execBuilder <=< execWriterT
228−
229−-- | Build an `ArrayBuffer` with do-notation. *O(n)*
65+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
23066execPut :: Put Unit -> Effect ArrayBuffer
23167execPut = execPutM
23268
@@ -239,7 +75,6 @@ execPut = execPutM
23975-- |
24076-- | In a `PutM` monad do-block, we can
24177-- |
242−-- |
24378-- | ```
24479-- | do
24580-- | messageBuilder <- subBuilder $ do
@@ -249,244 +84,73 @@ execPut = execPutM
24984-- | putInt32be $ length messageBuilder
25085-- | tell messageBuilder
25186-- | ```
252−subBuilder :: forall m. (MonadEffect m) => PutM m Unit -> PutM m Builder
87+subBuilder :: forall m. Monad m => PutM m Unit -> PutM m Builder
25388subBuilder = lift <<< execWriterT
25489
25590-- | Append an `ArrayBuffer` to the builder.
256−putArrayBuffer :: forall m. (MonadEffect m) => ArrayBuffer -> PutM m Unit
257−putArrayBuffer = tell <<< singleton
91+putArrayBuffer :: forall m. Monad m => ArrayBuffer -> PutM m Unit
92+putArrayBuffer = tell <<< Internal.singleton <<< Internal.Buff
25893
25994-- | Append a `DataView` to the builder.
260−putDataView :: forall m. (MonadEffect m) => DataView -> PutM m Unit
261−putDataView = tell <<< singleton_
95+putDataView :: forall m. Monad m => DataView -> PutM m Unit
96+putDataView = tell <<< Internal.singleton <<< Internal.View
26297
263−-- | Serialize an 8-bit unsigned integer (byte) into a new `ArrayBuffer`.
264−encodeUint8 :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
265−encodeUint8 x = do
266− buf <- liftEffect $ AB.empty 1
267− _ <- liftEffect $ DV.setUint8 (DV.whole buf) 0 x
268− pure buf
98+-- | Append either an `ArrayBuffer` or a `DataView` to the builder.
99+putDataBuff :: forall m. Monad m => DataBuff -> PutM m Unit
100+putDataBuff = tell <<< Internal.singleton
269101
270102-- | Append an 8-bit unsigned integer (byte) to the builder.
271−putUint8 :: forall m. (MonadEffect m) => UInt -> PutM m Unit
272−putUint8 = putArrayBuffer <=< encodeUint8
273−
274−-- | Serialize an 8-bit two’s-complement signed integer (char) into a new `ArrayBuffer`.
275−encodeInt8 :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
276−encodeInt8 x = do
277− buf <- liftEffect $ AB.empty 1
278− _ <- liftEffect $ DV.setInt8 (DV.whole buf) 0 x
279− pure buf
103+putUint8 :: forall m. MonadEffect m => UInt -> PutM m Unit
104+putUint8 = putArrayBuffer <=< Internal.encodeUint8
280105
281106-- | Append an 8-bit two’s-complement signed integer (char) to the builder.
282−putInt8 :: forall m. (MonadEffect m) => Int -> PutM m Unit
283−putInt8 = putArrayBuffer <=< encodeInt8
284−
285−-- | Serialize a 16-bit big-endian unsigned integer into a new `ArrayBuffer`.
286−encodeUint16be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
287−encodeUint16be x = do
288− buf <- liftEffect $ AB.empty 2
289− _ <- liftEffect $ DV.setUint16be (DV.whole buf) 0 x
290− pure buf
107+putInt8 :: forall m. MonadEffect m => Int -> PutM m Unit
108+putInt8 = putArrayBuffer <=< Internal.encodeInt8
291109
292110-- | Append a 16-bit big-endian unsigned integer to the builder.
293−putUint16be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
294−putUint16be = putArrayBuffer <=< encodeUint16be
295−
296−-- | Serialize a 16-bit little-endian unsigned integer into a new `ArrayBuffer`.
297−encodeUint16le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
298−encodeUint16le x = do
299− buf <- liftEffect $ AB.empty 2
300− _ <- liftEffect $ DV.setUint16le (DV.whole buf) 0 x
301− pure buf
111+putUint16be :: forall m. MonadEffect m => UInt -> PutM m Unit
112+putUint16be = putArrayBuffer <=< Internal.encodeUint16be
302113
303114-- | Append a 16-bit little-endian unsigned integer to the builder.
304−putUint16le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
305−putUint16le = putArrayBuffer <=< encodeUint16le
306−
307−-- | Serialize a 16-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
308−encodeInt16be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
309−encodeInt16be x = do
310− buf <- liftEffect $ AB.empty 2
311− _ <- liftEffect $ DV.setInt16be (DV.whole buf) 0 x
312− pure buf
115+putUint16le :: forall m. MonadEffect m => UInt -> PutM m Unit
116+putUint16le = putArrayBuffer <=< Internal.encodeUint16le
313117
314118-- | Append a 16-bit big-endian two’s-complement signed integer to the builder.
315−putInt16be :: forall m. (MonadEffect m) => Int -> PutM m Unit
316−putInt16be = putArrayBuffer <=< encodeInt16be
317−
318−-- | Serialize a 16-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
319−encodeInt16le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
320−encodeInt16le x = do
321− buf <- liftEffect $ AB.empty 2
322− _ <- liftEffect $ DV.setInt16le (DV.whole buf) 0 x
323− pure buf
119+putInt16be :: forall m. MonadEffect m => Int -> PutM m Unit
120+putInt16be = putArrayBuffer <=< Internal.encodeInt16be
324121
325122-- | Append a 16-bit little-endian two’s-complement signed integer to the builder.
326−putInt16le :: forall m. (MonadEffect m) => Int -> PutM m Unit
327−putInt16le = putArrayBuffer <=< encodeInt16le
328−
329−-- | Serialize a 32-bit big-endian unsigned integer into a new `ArrayBuffer`.
330−encodeUint32be :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
331−encodeUint32be x = do
332− buf <- liftEffect $ AB.empty 4
333− _ <- liftEffect $ DV.setUint32be (DV.whole buf) 0 x
334− pure buf
123+putInt16le :: forall m. MonadEffect m => Int -> PutM m Unit
124+putInt16le = putArrayBuffer <=< Internal.encodeInt16le
335125
336126-- | Append a 32-bit big-endian unsigned integer to the builder.
337−putUint32be :: forall m. (MonadEffect m) => UInt -> PutM m Unit
338−putUint32be = putArrayBuffer <=< encodeUint32be
339−
340−-- | Serialize a 32-bit little-endian unsigned integer into a new `ArrayBuffer`.
341−encodeUint32le :: forall m. (MonadEffect m) => UInt -> m ArrayBuffer
342−encodeUint32le x = do
343− buf <- liftEffect $ AB.empty 4
344− _ <- liftEffect $ DV.setUint32le (DV.whole buf) 0 x
345− pure buf
127+putUint32be :: forall m. MonadEffect m => UInt -> PutM m Unit
128+putUint32be = putArrayBuffer <=< Internal.encodeUint32be
346129
347130-- | Append a 32-bit little-endian unsigned integer to the builder.
348−putUint32le :: forall m. (MonadEffect m) => UInt -> PutM m Unit
349−putUint32le = putArrayBuffer <=< encodeUint32le
350−
351−-- | Serialize a 32-bit big-endian two’s-complement signed integer into a new `ArrayBuffer`.
352−encodeInt32be :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
353−encodeInt32be x = do
354− buf <- liftEffect $ AB.empty 4
355− _ <- liftEffect $ DV.setInt32be (DV.whole buf) 0 x
356− pure buf
131+putUint32le :: forall m. MonadEffect m => UInt -> PutM m Unit
132+putUint32le = putArrayBuffer <=< Internal.encodeUint32le
357133
358134-- | Append a 32-bit big-endian two’s-complement signed integer to the builder.
359−putInt32be :: forall m. (MonadEffect m) => Int -> PutM m Unit
360−putInt32be = putArrayBuffer <=< encodeInt32be
361−
362−-- | Serialize a 32-bit little-endian two’s-complement signed integer into a new `ArrayBuffer`.
363−encodeInt32le :: forall m. (MonadEffect m) => Int -> m ArrayBuffer
364−encodeInt32le x = do
365− buf <- liftEffect $ AB.empty 4
366− _ <- liftEffect $ DV.setInt32le (DV.whole buf) 0 x
367− pure buf
135+putInt32be :: forall m. MonadEffect m => Int -> PutM m Unit
136+putInt32be = putArrayBuffer <=< Internal.encodeInt32be
368137
369138-- | Append a 32-bit little-endian two’s-complement signed integer to the builder.
370−putInt32le :: forall m. (MonadEffect m) => Int -> PutM m Unit
371−putInt32le = putArrayBuffer <=< encodeInt32le
372−
373−-- | Serialize a 32-bit big-endian IEEE single-precision float into a new `ArrayBuffer`.
374−encodeFloat32be :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
375−encodeFloat32be x = do
376− buf <- liftEffect $ AB.empty 4
377− _ <- liftEffect $ DV.setFloat32be (DV.whole buf) 0 x
378− pure buf
139+putInt32le :: forall m. MonadEffect m => Int -> PutM m Unit
140+putInt32le = putArrayBuffer <=< Internal.encodeInt32le
379141
380142-- | Append a 32-bit big-endian IEEE single-precision float to the builder.
381−putFloat32be :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
382−putFloat32be = putArrayBuffer <=< encodeFloat32be
383−
384−-- | Serialize a 32-bit little-endian IEEE single-precision float into a new `ArrayBuffer`.
385−encodeFloat32le :: forall m. (MonadEffect m) => Float32 -> m ArrayBuffer
386−encodeFloat32le x = do
387− buf <- liftEffect $ AB.empty 4
388− _ <- liftEffect $ DV.setFloat32le (DV.whole buf) 0 x
389− pure buf
143+putFloat32be :: forall m. MonadEffect m => Float32 -> PutM m Unit
144+putFloat32be = putArrayBuffer <=< Internal.encodeFloat32be
390145
391146-- | Append a 32-bit little-endian IEEE single-precision float to the builder.
392−putFloat32le :: forall m. (MonadEffect m) => Float32 -> PutM m Unit
393−putFloat32le = putArrayBuffer <=< encodeFloat32le
394−
395−-- | Serialize a 64-bit big-endian IEEE double-precision float into a new `ArrayBuffer`.
396−encodeFloat64be :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
397−encodeFloat64be x = do
398− buf <- liftEffect $ AB.empty 8
399− _ <- liftEffect $ DV.setFloat64be (DV.whole buf) 0 x
400− pure buf
147+putFloat32le :: forall m. MonadEffect m => Float32 -> PutM m Unit
148+putFloat32le = putArrayBuffer <=< Internal.encodeFloat32le
401149
402150-- | Append a 64-bit big-endian IEEE double-precision float to the builder.
403−putFloat64be :: forall m. (MonadEffect m) => Number -> PutM m Unit
404−putFloat64be = putArrayBuffer <=< encodeFloat64be
405−
406−-- | Serialize a 64-bit little-endian IEEE double-precision float into a new `ArrayBuffer`.
407−encodeFloat64le :: forall m. (MonadEffect m) => Number -> m ArrayBuffer
408−encodeFloat64le x = do
409− buf <- liftEffect $ AB.empty 8
410− _ <- liftEffect $ DV.setFloat64le (DV.whole buf) 0 x
411− pure buf
151+putFloat64be :: forall m. MonadEffect m => Number -> PutM m Unit
152+putFloat64be = putArrayBuffer <=< Internal.encodeFloat64be
412153
413154-- | Append a 64-bit little-endian IEEE double-precision float to the builder.
414−putFloat64le :: forall m. (MonadEffect m) => Number -> PutM m Unit
415−putFloat64le = putArrayBuffer <=< encodeFloat64le
416−
417−
418−-- ## Implementation Details
419−--
420−-- We want our `Builder` to be a data structure with
421−-- * *O(1)* monoid append
422−-- * *O(n)* fold
423−--
424−-- Our `Builder` implementation is an unbalanced binary tree.
425−--
426−-- For monoid `append`, what we actually get is *O(1)* when either the
427−-- left or right tree is a singleton. If that's not true, then in the
428−-- unlikely worst case `append` might be *O(n)*.
429−--
430−-- `Builder` is optimized for what we consider to be normal usage, that is,
431−-- `snoc`ing singleton elements to the end of the `Builder`.
432−--
433−-- If a Builder is built entirely by `snoc`ing, it will look like a
434−-- left-only binary tree, a.k.a. a linked list.
435−--
436−-- ```
437−-- ④
438−-- ╱
439−-- ③
440−-- ╱
441−-- ②
442−-- ╱
443−-- ①
444−-- ```
445−--
446−-- If two of these `snoc`-built trees are `append`ed, then the new tree
447−-- will look like
448−--
449−-- ```
450−-- ④
451−-- ╱ ╲
452−-- ③ ⑧
453−-- ╱ ╱
454−-- ② ⑦
455−-- ╱ ╱
456−-- ① ⑥
457−-- ╱
458−-- ⑤
459−-- ```
460−--
461−-- This is all similar to
462−-- [__bytestring-tree-builder__](https://hackage.haskell.org/package/bytestring-tree-builder)
463−-- , except that the
464−-- [`Tree`](https://hackage.haskell.org/package/bytestring-tree-builder-0.2.7.3/docs/src/ByteString.TreeBuilder.Tree.html#Tree)
465−-- structure in __bytestring-tree-builder__ only carries values in its
466−-- leaves, which is how it achieves *O(1)* appending, at the cost of
467−-- a higher coefficient time factor on the fold.
468−--
469−-- We hope that this implementation is fairly fast, but we
470−-- haven't chosen this implementation because it's fast, we've chosen
471−-- this implementation because it's simple.
472−-- If someone wants to create a fast Purescript ArrayBuffer serialization
473−-- library, then they can benchmark against this one to prove that the new
474−-- one is fast.
475−--
476−-- One relatively cheap and simple performance improvement for this library would be to
477−-- remove the Null constructor of `Builder` and instead use Javascript nulls.
478−-- UPDATE Actually no, we need the Null constructor for the Monoid instance.
479−--
480−-- In the longer term, it might make sense to try to change the Builder so
481−-- that it works like the
482−-- https://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Builder.html
483−--
484−-- Here are some benchmarks of different Haskell ByteString builders
485−-- https://github.com/haskell-perf/strict-bytestring-builders
486−--
487−-- We've tried to design the API for this library with minimal assumptions,
488−-- so that if we want to change the Builder implementation later then we can.
489−--
490−-- Another way this could go:
491−-- https://kodimensional.dev/posts/2019-03-25-comonadic-builders
492−
155+putFloat64le :: forall m. MonadEffect m => Number -> PutM m Unit
156+putFloat64le = putArrayBuffer <=< Internal.encodeFloat64le
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−65
@@ -1,14 +1,24 @@
11module Test.Main where
22
3−import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
4−import Data.ArrayBuffer.Types (ArrayBuffer,Uint8Array)
5−import Data.ArrayBuffer.Typed as AT
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, (<>>))
611import Data.ArrayBuffer.DataView as DV
12+import Data.ArrayBuffer.Typed (buffer)
13+import Data.ArrayBuffer.Typed as AT
14+import Data.ArrayBuffer.Typed as AV
15+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
716import Data.UInt as UInt
817import Effect (Effect)
18+import Effect.Class (class MonadEffect, liftEffect)
919import Test.Assert (assertEqual')
10−import Data.ArrayBuffer.Builder
11−import Control.Monad.Writer.Trans (tell)
20+import Web.Encoding.TextEncoder (encode)
21+import Web.Encoding.TextEncoder as TextEncoder
1222
1323asBytes :: ArrayBuffer -> Effect (Array Int)
1424asBytes x = do
@@ -18,80 +28,82 @@ asBytes x = do
1828putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
1929putTest label expected put = do
2030 actual <- asBytes =<< execPut put
21− assertEqual' label {actual,expected}
31+ assertEqual' label { actual, expected }
2232
2333buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
2434buildTest label expected bldr = do
2535 actual <- asBytes =<< execBuilder =<< bldr
26− assertEqual' label {actual,expected}
36+ assertEqual' label { actual, expected }
2737
2838main :: Effect Unit
2939main = do
30− putTest "Test 0" [6,7,8] $ do
40+ putTest "Test 0" [ 6, 7, 8 ] do
3141 putInt8 6
3242 putInt8 7
3343 putInt8 8
3444
35− putTest "Test 1" [255,254] $ do
45+ putTest "Test 1" [ 255, 254 ] do
3646 putInt16be (-2)
3747
38− putTest "Test 3" [3,0,0,0] $ do
48+ putTest "Test 3" [ 3, 0, 0, 0 ] do
3949 putInt32le 3
4050
41− buildTest "Test 4" [1,2,3,4] $ do
42− b1 <- encodeInt8 1
43− b2 <- encodeInt8 2
44− b3 <- encodeInt8 3
45− b4 <- encodeInt8 4
51+ buildTest "Test 4" [ 1, 2, 3, 4 ] do
52+ b1 <- Buff <$> encodeInt8 1
53+ b2 <- Buff <$> encodeInt8 2
54+ b3 <- Buff <$> encodeInt8 3
55+ b4 <- Buff <$> encodeInt8 4
4656 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
4757
48− buildTest "Test 5" [1,2,3,4] $ do
49− b1 <- encodeInt8 1
50− b2 <- encodeInt8 2
51− b3 <- encodeInt8 3
52− b4 <- encodeInt8 4
58+ buildTest "Test 5" [ 1, 2, 3, 4 ] do
59+ b1 <- Buff <$> encodeInt8 1
60+ b2 <- Buff <$> encodeInt8 2
61+ b3 <- Buff <$> encodeInt8 3
62+ b4 <- Buff <$> encodeInt8 4
5363 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
5464
55− buildTest "Test 6" [1,2,3,4] $ do
56− b1 <- encodeInt8 1
57− b2 <- encodeInt8 2
58− b3 <- encodeInt8 3
59− b4 <- encodeInt8 4
65+ buildTest "Test 6" [ 1, 2, 3, 4 ] do
66+ b1 <- Buff <$> encodeInt8 1
67+ b2 <- Buff <$> encodeInt8 2
68+ b3 <- Buff <$> encodeInt8 3
69+ b4 <- Buff <$> encodeInt8 4
6070 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
6171
62− buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do
63− b1 <- encodeInt8 1
64− b2 <- encodeInt8 2
65− b3 <- encodeInt8 3
66− b4 <- encodeInt8 4
67− b5 <- encodeInt8 5
68− b6 <- encodeInt8 6
69− b7 <- encodeInt8 7
70− b8 <- encodeInt8 8
72+ buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
73+ b1 <- Buff <$> encodeInt8 1
74+ b2 <- Buff <$> encodeInt8 2
75+ b3 <- Buff <$> encodeInt8 3
76+ b4 <- Buff <$> encodeInt8 4
77+ b5 <- Buff <$> encodeInt8 5
78+ b6 <- Buff <$> encodeInt8 6
79+ b7 <- Buff <$> encodeInt8 7
80+ b8 <- Buff <$> encodeInt8 8
7181 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
72− <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
73−
74− buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do
75− b1 <- encodeInt8 1
76− b2 <- encodeInt8 2
77− b3 <- encodeInt8 3
78− b4 <- encodeInt8 4
79− b5 <- encodeInt8 5
80− b6 <- encodeInt8 6
81− b7 <- encodeInt8 7
82− b8 <- encodeInt8 8
82+ <> singleton b5
83+ <> (singleton b6 <> singleton b7)
84+ <> singleton b8
85+
86+ buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
87+ b1 <- Buff <$> encodeInt8 1
88+ b2 <- Buff <$> encodeInt8 2
89+ b3 <- Buff <$> encodeInt8 3
90+ b4 <- Buff <$> encodeInt8 4
91+ b5 <- Buff <$> encodeInt8 5
92+ b6 <- Buff <$> encodeInt8 6
93+ b7 <- Buff <$> encodeInt8 7
94+ b8 <- Buff <$> encodeInt8 8
8395 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
84− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
96+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
8597
86− buildTest "Test 8" [1,2,3,4] $ do
87− b1 <- encodeInt8 1
88− b2 <- encodeInt8 2
89− b3 <- encodeInt8 3
90− b4 <- encodeInt8 4
98+ buildTest "Test 8" [ 1, 2, 3, 4 ] do
99+ b1 <- Buff <$> encodeInt8 1
100+ b2 <- Buff <$> encodeInt8 2
101+ b3 <- Buff <$> encodeInt8 3
102+ b4 <- Buff <$> encodeInt8 4
91103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
92104
93− putTest "Test 9" [1,2,2,3,4] $ do
94− x <- subBuilder $ do
105+ putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
106+ x <- subBuilder do
95107 putInt8 3
96108 putInt8 4
97109 putInt8 1
@@ -99,15 +111,36 @@ main = do
99111 putInt8 $ length x
100112 tell x
101113
102− buildTest "Test 10" [1,2,3,4,5,6,7,8] $ do
103− b1 <- DV.whole <$> encodeInt8 1
104− b2 <- DV.whole <$> encodeInt8 2
105− b3 <- DV.whole <$> encodeInt8 3
106− b4 <- DV.whole <$> encodeInt8 4
107− b5 <- DV.whole <$> encodeInt8 5
108− b6 <- DV.whole <$> encodeInt8 6
109− b7 <- DV.whole <$> encodeInt8 7
110− b8 <- DV.whole <$> encodeInt8 8
111− pure $ ((singleton_ b1 <> singleton_ b2) <> (singleton_ b3 <> singleton_ b4))
112− <> ((singleton_ b5 <> singleton_ b6) <> (singleton_ b7 <> singleton_ b8))
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+ }