git.iko.soy/rowtype-yoga/purescript-arraybuffer-builder
on 37eeab5 help sign in
14 files changed+272−285
since splitsnapshots
unifiedsplit
.github/workflows/ci.yml−46 .github/workflows/push-build.yml+42 CHANGELOG.md+1−14 DEVELOPMENT.md+43 README.md+32−56 bower.json+8−12 packages.dhall+2−2 psc-package.json+16 shell.nix+30 spago.dhall−4 src/Data/ArrayBuffer/Builder.purs+30−30 src/Data/ArrayBuffer/Internal.purs+45−63 spago-dev.dhall → test.dhall+2−6 test/Main.purs+21−52
.github/workflows/ci.ymldeleted−46
@@ -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 @@
11# Changelog
22
3−## v3.1.0 2022-12-10
4−
5−- Transfer to __rowtype-yoga__.
6−- Docs.
7−
8−## v3.0.1 2022-05-04
9−
10−CI repair. Change `test.dhall` to `spago-dev.dhall`.
11−
12−## v3.0.0 2022-05-04
3+## v3.0.0 2022-04-13
134
145Build for PureScript v0.15.
15−
16−Added `MonadRec` constraint to `execPut`, `execPutM`, `foldl`, `foldM`,
17−they are now stack-safe.
18−
196## v2.1.0 2021-07-22
207
218Renamed `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 @@
11# purescript-arraybuffer-builder
22
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)
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)
65
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
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
129has been used for a long time and we [insist that it works really well](https://wiki.haskell.org/Do_notation_considered_harmful#Library_design).
1310
1411This package provides a `Builder` monoid and a `PutM` monad which are roughly
1512equivalent 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)
1714module.
1815
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+
1925## Usage Examples
2026
2127All `ArrayBuffer` building must occur in `Effect`.
@@ -39,7 +45,7 @@ IEEE-754 double-precision floats.
3945import Data.ArrayBuffer.Builder (execPut, putFloat64be)
4046
4147do
42− arraybuffer :: ArrayBuffer <- execPut do
48+ arraybuffer :: ArrayBuffer <- execPut $ do
4349 putFloat64be 1.0
4450 putFloat64be 2.0
4551 putFloat64be 3.0
@@ -51,26 +57,23 @@ Encode a `String` as UTF8 with a length prefix into our `Builder`.
5157
5258We give this as an example, rather than supporting it in the library, because
5359it 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).
5561
5662```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)
6164import Data.ArrayBuffer.Typed (buffer)
65+import Data.TextEncoding (encodeUtf8)
6266import Data.ArrayBuffer.ArrayBuffer (byteLength)
63−import Web.Encoding.TextEncoder (new, TextEncoder, encode)
6467
65−putStringUtf8 :: forall m. MonadEffect m => String -> PutM m Unit
68+putStringUtf8 :: forall m. (MonadEffect m) => String -> PutM m Unit
6669putStringUtf8 s = do
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
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
7173 putArrayBuffer stringbuf
7274
73−arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "🦝"
75+do
76+ arraybuffer :: ArrayBuffer <- execPut $ putStringUtf8 "BLM"
7477```
7578
7679### Serialize an `Array Int`
@@ -87,9 +90,9 @@ import Data.ArrayBuffer.Builder (execPut, putInt32be)
8790import Data.Foldable (traverse_)
8891import Data.Array (length)
8992
90−putArrayInt32 :: forall m. MonadEffect m => Array Int -> PutM m Unit
93+putArrayInt32 :: forall m. (MonadEffect m) => Array Int -> PutM m Unit
9194putArrayInt32 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.
9396 putInt32be 0
9497 putInt32be $ length xs
9598 traverse_ putInt32be xs
@@ -98,47 +101,20 @@ do
98101 arraybuffer <- execPut $ putArrayInt32 [1,2,3]
99102```
100103
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−
123104## Deserialization
124105
125106This package is only for writing `ArrayBuffer`s, not reading them.
126107See
127−[__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
108+[__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview/)
128109for a way to deserialize from `ArrayBuffer` back to Purescript data.
129110
111+## References
112+
113+* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer)
114+
130115## Alternative packages for serializing to an `ArrayBuffer`
131116
132117* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers)
133118* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer)
134119* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class)
135−* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)
136−* [__array-builder__](https://pursuit.purescript.org/packages/purescript-array-builder)
137−
138−## Development
139−
140−To run the tests,
141−
142−```shell
143−spago -x spago-dev.dhall test
144−```
120+* [__bytestrings__](https://pursuit.purescript.org/packages/purescript-bytestrings/)
bower.json+8−12
@@ -14,17 +14,13 @@
1414 "output"
1515 ],
1616 "dependencies": {
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"
17+ "purescript-arraybuffer": "^v11.0.1",
18+ "purescript-arraybuffer-types": "^v3.0.0",
19+ "purescript-effect": "^v3.0.0",
20+ "purescript-float32": "^v1.0.0",
21+ "purescript-maybe": "^v5.0.0",
22+ "purescript-prelude": "^v5.0.1",
23+ "purescript-transformers": "^v5.1.0",
24+ "purescript-uint": "^v6.0.3"
2925 }
3026}
packages.dhall+2−2
@@ -116,9 +116,9 @@ let additions =
116116 }
117117-------------------------------
118118-}
119+
119120let upstream =
120− https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.4-20221209/src/packages.dhall
121− sha256:b55c24bf585df4041ae6e87124cab7b35d474a9a77c9c3862ee6bf1dae618d72
121+ https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall
122122
123123let overrides = {=}
124124
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 @@
44, dependencies =
55 [ "effect"
66 , "float32"
7− , "identity"
8− , "lists"
97 , "maybe"
10− , "newtype"
118 , "prelude"
129 , "transformers"
1310 , "uint"
1411 , "arraybuffer-types"
1512 , "arraybuffer"
16− , "tailrec"
1713 ]
1814, packages = ./packages.dhall
1915, sources = [ "src/**/*.purs" ]
src/Data/ArrayBuffer/Builder.purs+30−30
@@ -5,39 +5,39 @@
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 other operations for working with `ArrayBuffer`, see
8+-- | For 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 __arraybuffer__.
11+-- | in package __purescript-arraybuffer__.
1212module Data.ArrayBuffer.Builder
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
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+)
37+where
3738
3839import Prelude
3940
40−import Control.Monad.Rec.Class (class MonadRec)
4141import Control.Monad.Writer.Trans (WriterT, execWriterT, tell, lift)
4242import Data.ArrayBuffer.Builder.Internal (Builder, DataBuff(..), length, toView, (<>>))
4343import Data.ArrayBuffer.Builder.Internal as Internal
@@ -58,11 +58,11 @@ type PutM = WriterT Builder
5858-- | The `PutM` type reified to `Effect`, in other words `WriterT Builder Effect`.
5959type Put = PutM Effect
6060
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
61+-- | Build an `ArrayBuffer` with do-notation in any `MonadEffect`. *O(n)*
62+execPutM :: forall m. MonadEffect m => PutM m Unit -> m ArrayBuffer
6363execPutM = Internal.execBuilder <=< execWriterT
6464
65−-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)* Stack-safe.
65+-- | Build an `ArrayBuffer` with do-notation in `Effect`. *O(n)*
6666execPut :: Put Unit -> Effect ArrayBuffer
6767execPut = execPutM
6868
src/Data/ArrayBuffer/Internal.purs+45−63
@@ -79,45 +79,42 @@
7979-- | so that if we want to change the `Builder` implementation later then we can.
8080-- |
8181module 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
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+)
108+where
108109
109110import Prelude
110111
111−import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
112112import Data.ArrayBuffer.ArrayBuffer as AB
113113import Data.ArrayBuffer.DataView as DV
114114import Data.ArrayBuffer.Typed as AT
115115import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, DataView, Uint8Array)
116116import Data.Float32 (Float32)
117−import Data.Identity (Identity)
118−import Data.List (List(..), uncons, (:))
119117import Data.Maybe (Maybe(..))
120−import Data.Newtype (unwrap)
121118import Data.UInt (UInt)
122119import Effect (Effect)
123120import Effect.Class (class MonadEffect, liftEffect)
@@ -130,7 +127,7 @@ data DataBuff
130127-- Concerning DataViews.
131128-- https://v8.dev/blog/dataview
132129
133−-- | View the contents of `DataBuff` as a `DataView`.
130+ -- | View the contents of `DataBuff` as a `DataView`.
134131toView :: DataBuff -> DataView
135132toView (Buff ab) = DV.whole ab
136133toView (View dv) = dv
@@ -190,39 +187,26 @@ instance semigroupBuilder :: Semigroup Builder where
190187 append Null r = r
191188 append l (Node Null rx rr) = Node l rx rr -- this is the snoc case
192189 append (Node ll lx Null) r = Node ll lx r -- found the rightmost Null
193− -- of the left tree
190+ -- of the left tree
194191 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
192+ -- side of the left tree
193+ -- to find the rightmost
194+ -- Null
199195
200196infixl 5 append as <>>
201197
202198instance monoidBuilder :: Monoid Builder where
203199 mempty = Null
204200
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
201+-- | `Builder` is not an instance of `Foldable` because `Builder` is monomorphic.
202+foldl :: forall b. (b -> DataBuff -> b) -> b -> Builder -> b
203+foldl _ a Null = a
204+foldl f a (Node l x r) = foldl f (f (foldl f a l) x) r
208205
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_ }
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)
208+foldM :: forall b m. (Monad m) => (b -> DataBuff -> m b) -> b -> Builder -> m b
209+foldM f a0 = foldl (\ma b -> ma >>= flip f b) (pure a0)
226210
227211-- | Construct a `Builder` with a single `DataBuff`. *O(1)*
228212singleton :: DataBuff -> Builder
@@ -233,8 +217,8 @@ singleton buf = Node Null buf Null
233217length :: Builder -> ByteLength
234218length bldr = foldl (\b a -> b + len a) 0 bldr
235219 where
236− len (Buff ab) = AB.byteLength ab
237− len (View dv) = DV.byteLength dv
220+ len (Buff ab) = AB.byteLength ab
221+ len (View dv) = DV.byteLength dv
238222
239223-- | Prepend a `DataBuff` to the beginning of the `Builder`. *O(1)*
240224cons :: DataBuff -> Builder -> Builder
@@ -245,7 +229,7 @@ snoc :: Builder -> DataBuff -> Builder
245229snoc bs x = Node bs x Null
246230
247231-- | 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
249233execBuilder bldr = do
250234 let buflen = length bldr
251235 -- Allocate the final ArrayBuffer
@@ -259,11 +243,9 @@ execBuilder bldr = do
259243 aview <- liftEffect $ toUint8Array a
260244 _ <- liftEffect $ AT.setTyped newview (Just offset) aview
261245 pure $ offset + AT.byteLength aview
262− )
263− 0
264− bldr
246+ ) 0 bldr
265247 pure buf
266− where
248+ where
267249 toUint8Array :: DataBuff -> Effect Uint8Array
268250 toUint8Array (Buff ab) = AT.whole ab
269251 toUint8Array (View dv) =
spago-dev.dhall → test.dhallrenamed+2−6
@@ -12,9 +12,5 @@ let conf = ./spago.dhall
1212
1313in conf //
1414 { sources = conf.sources # [ "test/**/*.purs" ]
15− , dependencies = conf.dependencies #
16− [ "assert"
17− , "arrays"
18− , "web-encoding"
19− ]
20− }
15+ , dependencies = conf.dependencies # [ "assert" ]
16+ }
test/Main.purs+21−52
@@ -1,24 +1,16 @@
11module Test.Main where
22
3−import Prelude
3+import Data.ArrayBuffer.Builder
44
55import 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)
106import Data.ArrayBuffer.Builder.Internal (cons, encodeInt8, execBuilder, length, singleton, (<>>))
117import Data.ArrayBuffer.DataView as DV
12−import Data.ArrayBuffer.Typed (buffer)
138import Data.ArrayBuffer.Typed as AT
14−import Data.ArrayBuffer.Typed as AV
15−import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array, Int8Array)
9+import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array)
1610import Data.UInt as UInt
1711import Effect (Effect)
18−import Effect.Class (class MonadEffect, liftEffect)
12+import Prelude (Unit, bind, pure, discard, map, negate, ($), (<$>), (=<<), (<>))
1913import Test.Assert (assertEqual')
20−import Web.Encoding.TextEncoder (encode)
21−import Web.Encoding.TextEncoder as TextEncoder
2214
2315asBytes :: ArrayBuffer -> Effect (Array Int)
2416asBytes x = do
@@ -28,48 +20,48 @@ asBytes x = do
2820putTest :: String -> Array Int -> PutM Effect Unit -> Effect Unit
2921putTest label expected put = do
3022 actual <- asBytes =<< execPut put
31− assertEqual' label { actual, expected }
23+ assertEqual' label {actual,expected}
3224
3325buildTest :: String -> Array Int -> Effect Builder -> Effect Unit
3426buildTest label expected bldr = do
3527 actual <- asBytes =<< execBuilder =<< bldr
36− assertEqual' label { actual, expected }
28+ assertEqual' label {actual,expected}
3729
3830main :: Effect Unit
3931main = do
40− putTest "Test 0" [ 6, 7, 8 ] do
32+ putTest "Test 0" [6,7,8] $ do
4133 putInt8 6
4234 putInt8 7
4335 putInt8 8
4436
45− putTest "Test 1" [ 255, 254 ] do
37+ putTest "Test 1" [255,254] $ do
4638 putInt16be (-2)
4739
48− putTest "Test 3" [ 3, 0, 0, 0 ] do
40+ putTest "Test 3" [3,0,0,0] $ do
4941 putInt32le 3
5042
51− buildTest "Test 4" [ 1, 2, 3, 4 ] do
43+ buildTest "Test 4" [1,2,3,4] $ do
5244 b1 <- Buff <$> encodeInt8 1
5345 b2 <- Buff <$> encodeInt8 2
5446 b3 <- Buff <$> encodeInt8 3
5547 b4 <- Buff <$> encodeInt8 4
5648 pure $ singleton b1 <> singleton b2 <> singleton b3 <> singleton b4
5749
58− buildTest "Test 5" [ 1, 2, 3, 4 ] do
50+ buildTest "Test 5" [1,2,3,4] $ do
5951 b1 <- Buff <$> encodeInt8 1
6052 b2 <- Buff <$> encodeInt8 2
6153 b3 <- Buff <$> encodeInt8 3
6254 b4 <- Buff <$> encodeInt8 4
6355 pure $ singleton b1 <>> singleton b2 <>> singleton b3 <>> singleton b4
6456
65− buildTest "Test 6" [ 1, 2, 3, 4 ] do
57+ buildTest "Test 6" [1,2,3,4] $ do
6658 b1 <- Buff <$> encodeInt8 1
6759 b2 <- Buff <$> encodeInt8 2
6860 b3 <- Buff <$> encodeInt8 3
6961 b4 <- Buff <$> encodeInt8 4
7062 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
7163
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
7365 b1 <- Buff <$> encodeInt8 1
7466 b2 <- Buff <$> encodeInt8 2
7567 b3 <- Buff <$> encodeInt8 3
@@ -79,11 +71,9 @@ main = do
7971 b7 <- Buff <$> encodeInt8 7
8072 b8 <- Buff <$> encodeInt8 8
8173 pure $ singleton b1 <> (singleton b2 <> singleton b3) <> singleton b4
82− <> singleton b5
83− <> (singleton b6 <> singleton b7)
84− <> singleton b8
74+ <> singleton b5 <> (singleton b6 <> singleton b7) <> singleton b8
8575
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
8777 b1 <- Buff <$> encodeInt8 1
8878 b2 <- Buff <$> encodeInt8 2
8979 b3 <- Buff <$> encodeInt8 3
@@ -93,17 +83,17 @@ main = do
9383 b7 <- Buff <$> encodeInt8 7
9484 b8 <- Buff <$> encodeInt8 8
9585 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))
9787
98− buildTest "Test 8" [ 1, 2, 3, 4 ] do
88+ buildTest "Test 8" [1,2,3,4] $ do
9989 b1 <- Buff <$> encodeInt8 1
10090 b2 <- Buff <$> encodeInt8 2
10191 b3 <- Buff <$> encodeInt8 3
10292 b4 <- Buff <$> encodeInt8 4
10393 pure $ (cons b1 (singleton b2)) <> (cons b3 (singleton b4))
10494
105− putTest "Test 9" [ 1, 2, 2, 3, 4 ] do
106− x <- subBuilder do
95+ putTest "Test 9" [1,2,2,3,4] $ do
96+ x <- subBuilder $ do
10797 putInt8 3
10898 putInt8 4
10999 putInt8 1
@@ -111,7 +101,7 @@ main = do
111101 putInt8 $ length x
112102 tell x
113103
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
115105 b1 <- View <$> DV.whole <$> encodeInt8 1
116106 b2 <- View <$> DV.whole <$> encodeInt8 2
117107 b3 <- View <$> DV.whole <$> encodeInt8 3
@@ -121,26 +111,5 @@ main = do
121111 b7 <- View <$> DV.whole <$> encodeInt8 7
122112 b8 <- View <$> DV.whole <$> encodeInt8 8
123113 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− }
114+ <> ((singleton b5 <> singleton b6) <> (singleton b7 <> singleton b8))
115+