git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on 37eeab5 help sign in
.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+42
@@ -0,0 +1,42 @@
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+1−14
@@ -1,21 +1,8 @@
1# Changelog
1# Changelog
2
2
3−## v3.1.0 2022-12-10
4−
5−- Transfer to __rowtype-yoga__.
6−- Docs.
7−
8−## v3.0.1 2022-05-04
3+## v3.0.0 2022-04-13
9−
10−CI repair. Change `test.dhall` to `spago-dev.dhall`.
11−
12−## v3.0.0 2022-05-04
13
4
14Build for PureScript v0.15.
5Build 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
6## v2.1.0 2021-07-22
20
7
21Renamed `Data.ArrayBuffer.Internal.Bytes` and exported
8Renamed `Data.ArrayBuffer.Internal.Bytes` and exported
DEVELOPMENT.mdnew file+43
@@ -0,0 +1,43 @@
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+32−56
@@ -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`.
@@ -39,7 +45,7 @@ IEEE-754 double-precision floats.
39import Data.ArrayBuffer.Builder (execPut, putFloat64be)
45import Data.ArrayBuffer.Builder (execPut, putFloat64be)
40
46
41do
47do
42− arraybuffer :: ArrayBuffer <- execPut do
48+ arraybuffer :: ArrayBuffer <- execPut $ do
43 putFloat64be 1.0
49 putFloat64be 1.0
44 putFloat64be 2.0
50 putFloat64be 2.0
45 putFloat64be 3.0
51 putFloat64be 3.0
@@ -51,26 +57,23 @@ Encode a `String` as UTF8 with a length prefix into our `Builder`.
51
57
52We give this as an example, rather than supporting it in the library, because
58We give this as an example, rather than supporting it in the library, because
53it depends on
59it depends on
54−[`Web.Encoding.TextEncoder`](https://pursuit.purescript.org/packages/purescript-web-encoding/docs/Web.Encoding.TextEncoder).
60+[`Data.TextEncoding.encodeUtf8`](https://pursuit.purescript.org/packages/purescript-text-encoding/docs/Data.TextEncoding#v:encodeUtf8).
55
61
56```purescript
62```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)
63+import Data.ArrayBuffer.Builder (PutM, putArrayBuffer, execPut)
61import Data.ArrayBuffer.Typed (buffer)
64import Data.ArrayBuffer.Typed (buffer)
65+import Data.TextEncoding (encodeUtf8)
62import Data.ArrayBuffer.ArrayBuffer (byteLength)
66import Data.ArrayBuffer.ArrayBuffer (byteLength)
63−import Web.Encoding.TextEncoder (new, TextEncoder, encode)
64
67
65−putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
68+putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit
66putStringUtf8 s = do
69putStringUtf8 s = do
67− textEncoder <- liftEffect new
68− let stringbuf = buffer $ encode s textEncoder
70+ let stringbuf = buffer $ encodeUtf8 s
69− -- Put a 32-bit big-endian length for the utf8 string, in bytes.
71+ -- Put a 32-bit big-endian length prefix for the length of the utf8 string, in bytes.
70− putUint32be $ fromInt $ byteLength stringbuf
72+ putInt32be $ byteLength stringbuf
71 putArrayBuffer stringbuf
73 putArrayBuffer stringbuf
72
74
75+do
73−arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
76+ arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "BLM"
74```
77```
75
78
76### Serialize an `Array Int`
79### Serialize an `Array Int`
@@ -87,9 +90,9 @@ import Data.ArrayBuffer.Builder (execPut, putInt32be)
87import Data.Foldable (traverse_)
90import Data.Foldable (traverse_)
88import Data.Array (length)
91import Data.Array (length)
89
92
90−putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit
93+putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit
91putArrayInt32 xs = do
94putArrayInt32 xs = do
92− -- Put a 64-bit big-endian length prefix for the array.
95+ -- Put a 64-bit big-endian length prefix for the length of the array.
93 putInt32be 0
96 putInt32be 0
94 putInt32be $ length xs
97 putInt32be $ length xs
95 traverse_ putInt32be xs
98 traverse_ putInt32be xs
@@ -98,47 +101,20 @@ do
98 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
101 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
99```
102```
100
103
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
104## Deserialization
124
105
125This package is only for writing `ArrayBuffer`s, not reading them.
106This package is only for writing `ArrayBuffer`s, not reading them.
126See
107See
127−[__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
108+[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
128for a way to deserialize from `ArrayBuffer` back to Purescript data.
109for a way to deserialize from `ArrayBuffer` back to Purescript data.
129
110
111+## References
112+
113+* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
114+
130## Alternative packages for serializing to an `ArrayBuffer`
115## Alternative packages for serializing to an `ArrayBuffer`
131
116
132* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
117* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
133* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
118* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
134* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
119* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
135−* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)
120+* [__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+8−12
@@ -14,17 +14,13 @@
14 "output"
14 "output"
15 ],
15 ],
16 "dependencies": {
16 "dependencies": {
17− "purescript-arraybuffer": "^v13.1.1",
17+ "purescript-arraybuffer": "^v11.0.1",
18− "purescript-arraybuffer-types": "^v3.0.2",
18+ "purescript-arraybuffer-types": "^v3.0.0",
19− "purescript-effect": "^v4.0.0",
19+ "purescript-effect": "^v3.0.0",
20− "purescript-float32": "^v2.0.0",
20+ "purescript-float32": "^v1.0.0",
21− "purescript-identity": "^v6.0.0",
22− "purescript-lists": "^v7.0.0",
23− "purescript-maybe": "^v6.0.0",
21+ "purescript-maybe": "^v5.0.0",
24− "purescript-newtype": "^v5.0.0",
25− "purescript-prelude": "^v6.0.1",
22+ "purescript-prelude": "^v5.0.1",
26− "purescript-tailrec": "^v6.1.0",
27− "purescript-transformers": "^v6.0.0",
23+ "purescript-transformers": "^v5.1.0",
28− "purescript-uint": "^v7.0.0"
24+ "purescript-uint": "^v6.0.3"
29 }
25 }
30}
26}
packages.dhall+2−2
@@ -116,9 +116,9 @@ let additions =
116 }
116 }
117-------------------------------
117-------------------------------
118-}
118-}
119+
119let upstream =
120let upstream =
120− https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.4-20221209/src/packages.dhall
121+ https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall
121− sha256:b55c24bf585df4041ae6e87124cab7b35d474a9a77c9c3862ee6bf1dae618d72
122
122
123let overrides = {=}
123let overrides = {=}
124
124
psc-package.jsonnew file+16
@@ -0,0 +1,16 @@
1+{
2+ "name": "purescript-arraybuffer-builder",
3+ "set": "psc-0.14.1-20210429",
4+ "source": "https://github.com/purescript/package-sets.git",
5+ "depends": [
6+ "prelude",
7+ "effect",
8+ "float32",
9+ "maybe",
10+ "prelude",
11+ "transformers",
12+ "uint",
13+ "arraybuffer-types",
14+ "arraybuffer"
15+ ]
16+}
shell.nixnew file+30
@@ -0,0 +1,30 @@
1+# Universal shell for PureScript repos
2+# { pkgs ? import <nixpkgs> { }
3+{ pkgs ? import (builtins.fetchGit {
4+ # https://github.com/NixOS/nixpkgs/releases/tag/20.09
5+ url = "https://github.com/nixos/nixpkgs/";
6+ ref = "refs/tags/20.09";
7+ rev = "cd63096d6d887d689543a0b97743d28995bc9bc3";
8+ }) {}
9+}:
10+let
11+ easy-ps = import (builtins.fetchGit {
12+ url = "https://github.com/justinwoo/easy-purescript-nix.git";
13+ rev = "bbef4245cd6810ea84e97a47c801947bfec9fadc";
14+ }) { inherit pkgs; };
15+in
16+pkgs.mkShell {
17+ nativeBuildInputs = [
18+ easy-ps.purs-0_14_3
19+ easy-ps.spago
20+ easy-ps.pulp
21+ easy-ps.psc-package
22+ pkgs.nodejs-14_x
23+ pkgs.nodePackages.bower
24+ ];
25+ LC_ALL = "C.UTF-8"; # https://github.com/purescript/spago/issues/507
26+ # https://github.com/purescript/spago#install-autocompletions-for-bash
27+ shellHook = ''
28+ source <(spago --bash-completion-script `which spago`)
29+ '';
30+}
spago.dhall−4
@@ -4,16 +4,12 @@
4, dependencies =
4, dependencies =
5 [ "effect"
5 [ "effect"
6 , "float32"
6 , "float32"
7− , "identity"
8− , "lists"
9 , "maybe"
7 , "maybe"
10− , "newtype"
11 , "prelude"
8 , "prelude"
12 , "transformers"
9 , "transformers"
13 , "uint"
10 , "uint"
14 , "arraybuffer-types"
11 , "arraybuffer-types"
15 , "arraybuffer"
12 , "arraybuffer"
16− , "tailrec"
17 ]
13 ]
18, packages = ./packages.dhall
14, packages = ./packages.dhall
19, sources = [ "src/**/*.purs" ]
15, sources = [ "src/**/*.purs" ]
src/Data/ArrayBuffer/Builder.purs+30−30
@@ -5,39 +5,39 @@
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
19+, putDataView
20− , putDataBuff
20+, putDataBuff
21− , putUint8
21+, putUint8
22− , putInt8
22+, putInt8
23− , putUint16be
23+, putUint16be
24− , putUint16le
24+, putUint16le
25− , putInt16be
25+, putInt16be
26− , putInt16le
26+, putInt16le
27− , putUint32be
27+, putUint32be
28− , putUint32le
28+, putUint32le
29− , putInt32be
29+, putInt32be
30− , putInt32le
30+, putInt32le
31− , putFloat32be
31+, putFloat32be
32− , putFloat32le
32+, putFloat32le
33− , putFloat64be
33+, putFloat64be
34− , putFloat64le
34+, putFloat64le
35− , module Data.ArrayBuffer.Builder.Internal
35+, module Data.ArrayBuffer.Builder.Internal
36+)
36− ) where
37+where
37
38
38import Prelude
39import Prelude
39
40
40−import Control.Monad.Rec.Class (class MonadRec)
41import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
41import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
42import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
42import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
43import Data.ArrayBuffer.Builder.Internal as Internal
43import Data.ArrayBuffer.Builder.Internal as Internal
@@ -58,11 +58,11 @@ type PutM = WriterT Builder
58-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
58-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
59type Put = PutM Effect
59type Put = PutM Effect
60
60
61−-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)* Stack-safe.
61+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
62−execPutM :: forall m. MonadEffect m => MonadRec m => PutM m Unit -> m ArrayBuffer
62+execPutM :: forall m. MonadEffect m => PutM m Unit -> m ArrayBuffer
63execPutM = Internal.execBuilder <=< execWriterT
63execPutM = Internal.execBuilder <=< execWriterT
64
64
65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
65+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)*
66execPut :: Put Unit -> Effect ArrayBuffer
66execPut :: Put Unit -> Effect ArrayBuffer
67execPut = execPutM
67execPut = execPutM
68
68
src/Data/ArrayBuffer/Internal.purs+45−63
@@ -79,45 +79,42 @@
79-- | so that if we want to change the `Builder` implementation later then we can.
79-- | so that if we want to change the `Builder` implementation later then we can.
80-- |
80-- |
81module Data.ArrayBuffer.Builder.Internal
81module Data.ArrayBuffer.Builder.Internal
82− ( Builder(..)
82+( Builder(..)
83− , (<>>)
83+, (<>>)
84− , DataBuff(..)
84+, DataBuff(..)
85− , toView
85+, toView
86− , execBuilder
86+, execBuilder
87− , length
87+, length
88− , foldl
88+, foldl
89− , foldM
89+, foldM
90− , singleton
90+, singleton
91− , cons
91+, cons
92− , snoc
92+, snoc
93− , encodeUint8
93+, encodeUint8
94− , encodeInt8
94+, encodeInt8
95− , encodeUint16be
95+, encodeUint16be
96− , encodeUint16le
96+, encodeUint16le
97− , encodeInt16be
97+, encodeInt16be
98− , encodeInt16le
98+, encodeInt16le
99− , encodeUint32be
99+, encodeUint32be
100− , encodeUint32le
100+, encodeUint32le
101− , encodeInt32be
101+, encodeInt32be
102− , encodeInt32le
102+, encodeInt32le
103− , encodeFloat32be
103+, encodeFloat32be
104− , encodeFloat32le
104+, encodeFloat32le
105− , encodeFloat64be
105+, encodeFloat64be
106− , encodeFloat64le
106+, encodeFloat64le
107+)
107− ) where
108+where
108
109
109import Prelude
110import Prelude
110
111
111−import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
112import Data.ArrayBuffer.ArrayBuffer as AB
112import Data.ArrayBuffer.ArrayBuffer as AB
113import Data.ArrayBuffer.DataView as DV
113import Data.ArrayBuffer.DataView as DV
114import Data.ArrayBuffer.Typed as AT
114import Data.ArrayBuffer.Typed as AT
115import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
115import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
116import Data.Float32 (Float32)
116import Data.Float32 (Float32)
117−import Data.Identity (Identity)
118−import Data.List (List(..), uncons, (:))
119import Data.Maybe (Maybe(..))
117import Data.Maybe (Maybe(..))
120−import Data.Newtype (unwrap)
121import Data.UInt (UInt)
118import Data.UInt (UInt)
122import Effect (Effect)
119import Effect (Effect)
123import Effect.Class (class MonadEffect, liftEffect)
120import Effect.Class (class MonadEffect, liftEffect)
@@ -130,7 +127,7 @@ data DataBuff
130-- Concerning DataViews.
127-- Concerning DataViews.
131-- https://v8.dev/blog/dataview
128-- https://v8.dev/blog/dataview
132
129
133−-- | View the contents of `DataBuff` as a `DataView`.
130+ -- | View the contents of `DataBuff` as a `DataView`.
134toView :: DataBuff -> DataView
131toView :: DataBuff -> DataView
135toView (Buff ab) = DV.whole ab
132toView (Buff ab) = DV.whole ab
136toView (View dv) = dv
133toView (View dv) = dv
@@ -190,39 +187,26 @@ instance semigroupBuilder :: Semigroup Builder where
190 append Null r = r
187 append Null r = r
191 append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
188 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
189 append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
193− -- of the left tree
190+ -- of the left tree
194 append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
191 append (Node ll lx lr) r = Node ll lx $ append lr r -- search down the right
195−
196−-- side of the left tree
192+ -- side of the left tree
197−-- to find the rightmost
193+ -- to find the rightmost
198−-- Null
194+ -- Null
199
195
200infixl 5 append as <>>
196infixl 5 append as <>>
201
197
202instance monoidBuilder :: Monoid Builder where
198instance monoidBuilder :: Monoid Builder where
203 mempty = Null
199 mempty = Null
204
200
205−-- | Stack-safe `foldl` over a `Builder`. *O(n)*
201+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
206−foldl :: forall a. (a -> DataBuff -> a) -> a -> Builder -> a
202+foldl :: forall b. (b -> DataBuff -> b) -> b -> Builder -> b
207−foldl f a0 b = (unwrap :: Identity a -> a) $ foldM (\a' b' -> pure (f a' b')) a0 b
203+foldl _ a Null = a
204+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
208
205
209−-- | Stack-safe `foldM` over a `Builder`. *O(n)*.
206+-- | Monomorphic foldM copied from
207+-- | [`Data.Foldable.foldM`](https://pursuit.purescript.org/packages/purescript-foldable-traversable/4.1.1/docs/Data.Foldable#v:foldM)
210−foldM :: forall m a. MonadRec m => (a -> DataBuff -> m a) -> a -> Builder -> m a
208+foldM :: forall b m. (Monad m) => (b -> DataBuff -> m b) -> b -> Builder -> m b
211−-- The Art of Computer Programming 2.3.1
209+foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
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
210
227-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
211-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
228singleton :: DataBuff -> Builder
212singleton :: DataBuff -> Builder
@@ -233,8 +217,8 @@ singleton buf = Node Null buf Null
233length :: Builder -> ByteLength
217length :: Builder -> ByteLength
234length bldr = foldl (\b a -> b + len a) 0 bldr
218length bldr = foldl (\b a -> b + len a) 0 bldr
235 where
219 where
236− len (Buff ab) = AB.byteLength ab
220+ len (Buff ab) = AB.byteLength ab
237− len (View dv) = DV.byteLength dv
221+ len (View dv) = DV.byteLength dv
238
222
239-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
223-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
240cons :: DataBuff -> Builder -> Builder
224cons :: DataBuff -> Builder -> Builder
@@ -245,7 +229,7 @@ snoc :: Builder -> DataBuff -> Builder
245snoc bs x = Node bs x Null
229snoc bs x = Node bs x Null
246
230
247-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
231-- | Build a single `ArrayBuffer` from a `Builder`. *O(n)*
248−execBuilder :: forall m. MonadEffect m => MonadRec m => Builder -> m ArrayBuffer
232+execBuilder :: forall m. (MonadEffect m) => Builder -> m ArrayBuffer
249execBuilder bldr = do
233execBuilder bldr = do
250 let buflen = length bldr
234 let buflen = length bldr
251 -- Allocate the final ArrayBuffer
235 -- Allocate the final ArrayBuffer
@@ -259,11 +243,9 @@ execBuilder bldr = do
259 aview <- liftEffect $ toUint8Array a
243 aview <- liftEffect $ toUint8Array a
260 _ <- liftEffect $ AT.setTyped newview (Just offset) aview
244 _ <- liftEffect $ AT.setTyped newview (Just offset) aview
261 pure $ offset + AT.byteLength aview
245 pure $ offset + AT.byteLength aview
262− )
263− 0
264− bldr
246+ ) 0 bldr
265 pure buf
247 pure buf
266− where
248+ where
267 toUint8Array :: DataBuff -> Effect Uint8Array
249 toUint8Array :: DataBuff -> Effect Uint8Array
268 toUint8Array (Buff ab) = AT.whole ab
250 toUint8Array (Buff ab) = AT.whole ab
269 toUint8Array (View dv) =
251 toUint8Array (View dv) =
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+21−52
@@ -1,24 +1,16 @@
1module Test.Main where
1module Test.Main where
2
2
3−import Prelude
3+import Data.ArrayBuffer.Builder
4
4
5import Control.Monad.Writer.Trans (tell)
5import 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)
10import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
6import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
11import Data.ArrayBuffer.DataView as DV
7import Data.ArrayBuffer.DataView as DV
12−import Data.ArrayBuffer.Typed (buffer)
13import Data.ArrayBuffer.Typed as AT
8import Data.ArrayBuffer.Typed as AT
14−import Data.ArrayBuffer.Typed as AV
9+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
15−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
16import Data.UInt as UInt
10import Data.UInt as UInt
17import Effect (Effect)
11import Effect (Effect)
18−import Effect.Class (class MonadEffect, liftEffect)
12+import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
19import Test.Assert (assertEqual')
13import Test.Assert (assertEqual')
20−import Web.Encoding.TextEncoder (encode)
21−import Web.Encoding.TextEncoder as TextEncoder
22
14
23asBytes :: ArrayBuffer -> Effect (Array Int)
15asBytes :: ArrayBuffer -> Effect (Array Int)
24asBytes x = do
16asBytes x = do
@@ -28,48 +20,48 @@ asBytes x = do
28putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
20putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
29putTest label expected put = do
21putTest label expected put = do
30 actual <- asBytes =<< execPut put
22 actual <- asBytes =<< execPut put
31− assertEqual' label { actual, expected }
23+ assertEqual' label {actual,expected}
32
24
33buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
25buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
34buildTest label expected bldr = do
26buildTest label expected bldr = do
35 actual <- asBytes =<< execBuilder =<< bldr
27 actual <- asBytes =<< execBuilder =<< bldr
36− assertEqual' label { actual, expected }
28+ assertEqual' label {actual,expected}
37
29
38main :: Effect Unit
30main :: Effect Unit
39main = do
31main = do
40− putTest "Test 0" [ 6, 7, 8 ] do
32+ putTest "Test 0" [6,7,8] $ do
41 putInt8 6
33 putInt8 6
42 putInt8 7
34 putInt8 7
43 putInt8 8
35 putInt8 8
44
36
45− putTest "Test 1" [ 255, 254 ] do
37+ putTest "Test 1" [255,254] $ do
46 putInt16be (-2)
38 putInt16be (-2)
47
39
48− putTest "Test 3" [ 3, 0, 0, 0 ] do
40+ putTest "Test 3" [3,0,0,0] $ do
49 putInt32le 3
41 putInt32le 3
50
42
51− buildTest "Test 4" [ 1, 2, 3, 4 ] do
43+ buildTest "Test 4" [1,2,3,4] $ do
52 b1 <- Buff <$> encodeInt8 1
44 b1 <- Buff <$> encodeInt8 1
53 b2 <- Buff <$> encodeInt8 2
45 b2 <- Buff <$> encodeInt8 2
54 b3 <- Buff <$> encodeInt8 3
46 b3 <- Buff <$> encodeInt8 3
55 b4 <- Buff <$> encodeInt8 4
47 b4 <- Buff <$> encodeInt8 4
56 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
48 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
57
49
58− buildTest "Test 5" [ 1, 2, 3, 4 ] do
50+ buildTest "Test 5" [1,2,3,4] $ do
59 b1 <- Buff <$> encodeInt8 1
51 b1 <- Buff <$> encodeInt8 1
60 b2 <- Buff <$> encodeInt8 2
52 b2 <- Buff <$> encodeInt8 2
61 b3 <- Buff <$> encodeInt8 3
53 b3 <- Buff <$> encodeInt8 3
62 b4 <- Buff <$> encodeInt8 4
54 b4 <- Buff <$> encodeInt8 4
63 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
55 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
64
56
65− buildTest "Test 6" [ 1, 2, 3, 4 ] do
57+ buildTest "Test 6" [1,2,3,4] $ do
66 b1 <- Buff <$> encodeInt8 1
58 b1 <- Buff <$> encodeInt8 1
67 b2 <- Buff <$> encodeInt8 2
59 b2 <- Buff <$> encodeInt8 2
68 b3 <- Buff <$> encodeInt8 3
60 b3 <- Buff <$> encodeInt8 3
69 b4 <- Buff <$> encodeInt8 4
61 b4 <- Buff <$> encodeInt8 4
70 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
62 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
71
63
72− buildTest "Test 6" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
64+ buildTest "Test 6" [1,2,3,4,5,6,7,8] $ do
73 b1 <- Buff <$> encodeInt8 1
65 b1 <- Buff <$> encodeInt8 1
74 b2 <- Buff <$> encodeInt8 2
66 b2 <- Buff <$> encodeInt8 2
75 b3 <- Buff <$> encodeInt8 3
67 b3 <- Buff <$> encodeInt8 3
@@ -79,11 +71,9 @@ main = do
79 b7 <- Buff <$> encodeInt8 7
71 b7 <- Buff <$> encodeInt8 7
80 b8 <- Buff <$> encodeInt8 8
72 b8 <- Buff <$> encodeInt8 8
81 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
73 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
82− <> singleton b5
83− <> (singleton b6 <> singleton b7)
74+ <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
84− <> singleton b8
85
75
86− buildTest "Test 7" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
76+ buildTest "Test 7" [1,2,3,4,5,6,7,8] $ do
87 b1 <- Buff <$> encodeInt8 1
77 b1 <- Buff <$> encodeInt8 1
88 b2 <- Buff <$> encodeInt8 2
78 b2 <- Buff <$> encodeInt8 2
89 b3 <- Buff <$> encodeInt8 3
79 b3 <- Buff <$> encodeInt8 3
@@ -93,17 +83,17 @@ main = do
93 b7 <- Buff <$> encodeInt8 7
83 b7 <- Buff <$> encodeInt8 7
94 b8 <- Buff <$> encodeInt8 8
84 b8 <- Buff <$> encodeInt8 8
95 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
85 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
96− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
86+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
97
87
98− buildTest "Test 8" [ 1, 2, 3, 4 ] do
88+ buildTest "Test 8" [1,2,3,4] $ do
99 b1 <- Buff <$> encodeInt8 1
89 b1 <- Buff <$> encodeInt8 1
100 b2 <- Buff <$> encodeInt8 2
90 b2 <- Buff <$> encodeInt8 2
101 b3 <- Buff <$> encodeInt8 3
91 b3 <- Buff <$> encodeInt8 3
102 b4 <- Buff <$> encodeInt8 4
92 b4 <- Buff <$> encodeInt8 4
103 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
93 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
104
94
105− putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
95+ putTest "Test 9" [1,2,2,3,4] $ do
106− x <- subBuilder do
96+ x <- subBuilder $ do
107 putInt8 3
97 putInt8 3
108 putInt8 4
98 putInt8 4
109 putInt8 1
99 putInt8 1
@@ -111,7 +101,7 @@ main = do
111 putInt8 $ length x
101 putInt8 $ length x
112 tell x
102 tell x
113
103
114− buildTest "Test 10" [ 1, 2, 3, 4, 5, 6, 7, 8 ] do
104+ buildTest "Test 10" [1,2,3,4,5,6,7,8] $ do
115 b1 <- View <$> DV.whole <$> encodeInt8 1
105 b1 <- View <$> DV.whole <$> encodeInt8 1
116 b2 <- View <$> DV.whole <$> encodeInt8 2
106 b2 <- View <$> DV.whole <$> encodeInt8 2
117 b3 <- View <$> DV.whole <$> encodeInt8 3
107 b3 <- View <$> DV.whole <$> encodeInt8 3
@@ -121,26 +111,5 @@ main = do
121 b7 <- View <$> DV.whole <$> encodeInt8 7
111 b7 <- View <$> DV.whole <$> encodeInt8 7
122 b8 <- View <$> DV.whole <$> encodeInt8 8
112 b8 <- View <$> DV.whole <$> encodeInt8 8
123 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
113 pure $ ((singleton b1 <> singleton b2) <> (singleton b3 <> singleton b4))
124− <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
114+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
125−
115+
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− }