diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..7c68b07 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,13 @@ +# https://editorconfig.org +root = true + +[*] +indent_style = space +indent_size = 2 +end_of_line = lf +charset = utf-8 +trim_trailing_whitespace = true +insert_final_newline = true + +[*.md] +trim_trailing_whitespace = false diff --git a/.github/ISSUE_TEMPLATE/bug-report.md b/.github/ISSUE_TEMPLATE/bug-report.md new file mode 100644 index 0000000..b79b995 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/bug-report.md @@ -0,0 +1,19 @@ +--- +name: Bug report +about: Report an issue +title: "" +labels: bug +assignees: "" +--- + +**Describe the bug** +A clear and concise description of the bug. + +**To Reproduce** +A minimal code example (preferably a runnable example on [Try PureScript](https://try.purescript.org)!) or steps to reproduce the issue. + +**Expected behavior** +A clear and concise description of what you expected to happen. + +**Additional context** +Add any other context about the problem here. diff --git a/.github/ISSUE_TEMPLATE/change-request.md b/.github/ISSUE_TEMPLATE/change-request.md new file mode 100644 index 0000000..a2ee685 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/change-request.md @@ -0,0 +1,21 @@ +--- +name: Change request +about: Propose an improvement to this library +title: "" +labels: "" +assignees: "" +--- + +**Is your change request related to a problem? Please describe.** +A clear and concise description of the problem. + +Examples: + +- It's frustrating to have to [...] +- I was looking for a function to [...] + +**Describe the solution you'd like** +A clear and concise description of what a good solution to you looks like, including any solutions you've already considered. + +**Additional context** +Add any other context about the change request here. diff --git a/.github/ISSUE_TEMPLATE/config.yml b/.github/ISSUE_TEMPLATE/config.yml new file mode 100644 index 0000000..8d7661e --- /dev/null +++ b/.github/ISSUE_TEMPLATE/config.yml @@ -0,0 +1,8 @@ +blank_issues_enabled: false +contact_links: + - name: PureScript Discourse + url: https://discourse.purescript.org/ + about: Ask and answer questions on the PureScript discussion forum. + - name: PureScript Discord + url: https://purescript.org/chat + about: Ask and answer questions on the PureScript chat. diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..d8780f7 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,11 @@ +**Description of the change** +Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. + +--- + +**Checklist:** + +- [ ] Added the change to the changelog's "Unreleased" section with a link to this PR and your username +- [ ] Linked any existing issues or proposals that this pull request should close +- [ ] Updated or added relevant documentation in the README and/or documentation directory +- [ ] Added a test for the contribution (if applicable) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..28243e2 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,52 @@ +name: CI + +on: + push: + branches: [main] + pull_request: + branches: [main] + +jobs: + build: + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v2 + + - name: Set up a PureScript toolchain + uses: purescript-contrib/setup-purescript@main + with: + purescript: "unstable" + purs-tidy: "latest" + + - name: Cache PureScript dependencies + uses: actions/cache@v2 + with: + key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} + path: | + .spago + output + + - name: Install dependencies + run: spago install + + - name: Build source + run: spago build --no-install --purs-args '--censor-lib --strict' + + - name: Install test dependencies + run: spago -x spago-test.dhall install + + - name: Build tests + run: spago -x spago-test.dhall build --no-install --purs-args '--censor-lib --strict' + + - name: Run tests + run: spago -x spago-test.dhall test --no-install + + - name: Check formatting + run: purs-tidy check src test + + - name: Verify Bower & Pulp + run: | + npm install bower pulp@16.0.0-0 + npx bower install + npx pulp build -- --censor-lib --strict diff --git a/.gitignore b/.gitignore index 9cb72c2..7e82b68 100644 --- a/.gitignore +++ b/.gitignore @@ -1,10 +1,9 @@ -*~ -output/ -bower_components/ -node_modules/ -.psci -.psci_modules/ -yarn-error.log -yarn.lock -generated-docs/ -.spago/ +.* +!.gitignore +!.github +!.editorconfig +!.tidyrc.json + +output +generated-docs +bower_components diff --git a/.tidyrc.json b/.tidyrc.json new file mode 100644 index 0000000..4f013c1 --- /dev/null +++ b/.tidyrc.json @@ -0,0 +1,10 @@ +{ + "importSort": "source", + "importWrap": "source", + "indent": 2, + "operatorsFile": null, + "ribbon": 1, + "typeArrowPlacement": "first", + "unicode": "never", + "width": null +} diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 1f93807..0000000 --- a/.travis.yml +++ /dev/null @@ -1,9 +0,0 @@ -language: node_js -sudo: required -dist: trusty -node_js: 8 -install: - - npm install -g purescript pulp bower -script: - - bower install - - pulp test diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..fb92693 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,86 @@ +# Changelog + +Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## Unreleased + +Breaking changes: + +New features: + +Bugfixes: + +Other improvements: + +## [v13.2.0](https://github.com/purescript-contrib/purescript-arraybuffer/releases/tag/v13.2.0) - 2023-02-13 + +Other improvements: + +- Correct `Typed` `slice` and `subArray` docs (#51 by @jamesdbrock) + +## [v13.1.0](https://github.com/purescript-contrib/purescript-arraybuffer/releases/tag/v13.1.0) - 2022-12-01 + +New features: + +- `Data.ArrayBuffer.Cast` (#46 by @jamesdbrock) + +## [v13.0.0](https://github.com/purescript-contrib/purescript-arraybuffer/releases/tag/v13.0.0) - 2022-04-27 + +Breaking Changes: +- Migrate FFI to ES modules (#41 by @JordanMartinez) +- Replaced polymorphic proxies with monomorphic `Proxy` (#41 by @JordanMartinez) + +## v12.0.0 + +Delete the `TypedArray` polyfill which was preventing this +library from working with `purs bundle` v0.14.4. +https://github.com/purescript-contrib/purescript-arraybuffer/issues/34 + +### Breaking Changes + +May lose partial polyfill `TypedArray` support for only the methods present +in regular JavaScript Arrays. +https://web.archive.org/web/20171019084331/https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray#Methods_Polyfill + +## v11.0.3 + +Revert to v11.0.1. +https://github.com/purescript-contrib/purescript-arraybuffer/issues/37 + +## v11.0.2 + +Delete the `TypedArray` polyfill which was preventing this +library from working with `purs bundle` v0.14.4. +https://github.com/purescript-contrib/purescript-arraybuffer/issues/34 + +## v11.0.1 + +Regenerate `bower.json`. + +## v11.0.0 + +Jorge Acereda has graciously donated this package to __purescript-contrib__. + +For version 11, we have refactored this library so that it depends only on +other packages in __purescript-contrib__. + +https://github.com/purescript-contrib/governance/issues/40 + +We have removed the dependencies on these non-__purescript-contrib__ packages: + +* https://pursuit.purescript.org/packages/purescript-typelevel +* https://pursuit.purescript.org/packages/purescript-quickcheck-combinators + +In v11.0.0 of this package, we have also upgraded to PureScript v0.14. + +### Breaking Changes + +To upgrade to v11.0.0, you might need to do a few substitutions +to the type declarations in your own dependent code: + +* Replace the type `AProxy` with `Proxy` from the Prelude. +* Remove most of the `Nat` typeclass constraints. https://github.com/purescript-contrib/purescript-arraybuffer/issues/29 +* Replace any `BytesPerValue a b` typeclass constraints with `BytesPerType a`. + +We have also privatized `Typed.part'`. https://github.com/purescript-contrib/purescript-arraybuffer/issues/32 + diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..bff4e66 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,5 @@ +# Contributing to Arraybuffer + +Thanks for your interest in contributing to `arraybuffer`! We welcome new contributions regardless of your level of experience or familiarity with PureScript. + +Every library in the Contributors organization shares a simple handbook that helps new contributors get started. With that in mind, please [read the short contributing guide on purescript-contrib/governance](https://github.com/purescript-contrib/governance/blob/main/contributing.md) before contributing to this library. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..f6503c4 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2021 PureScript Contrib + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md index e318957..ee4c15d 100644 --- a/README.md +++ b/README.md @@ -1,16 +1,102 @@ -# purescript-arraybuffer +# arraybuffer -ArrayBuffer bindings for PureScript. +[![CI](https://github.com/purescript-contrib/purescript-arraybuffer/workflows/CI/badge.svg?branch=main)](https://github.com/purescript-contrib/purescript-arraybuffer/actions?query=workflow%3ACI+branch%3Amain) +[![Release](https://img.shields.io/github/release/purescript-contrib/purescript-arraybuffer.svg)](https://github.com/purescript-contrib/purescript-arraybuffer/releases) +[![Pursuit](https://pursuit.purescript.org/packages/purescript-arraybuffer/badge)](https://pursuit.purescript.org/packages/purescript-arraybuffer) +[![Maintainer: jacereda](https://img.shields.io/badge/maintainer-jacereda-teal.svg)](https://github.com/jacereda) +[![Maintainer: jamesdbrock](https://img.shields.io/badge/maintainer-jamesdbrock-teal.svg)](https://github.com/jamesdbrock) + + +Bindings and implementation for mutable JavaScript `ArrayBuffer`s. + +An `ArrayBuffer` is a built-in JavaScript object for storage of a flat continuous +region of memory. + +The `Typed` module provides a view into an `ArrayBuffer` for array +access of aligned local-machine-endian types, for in-process flat memory operations. + +The `DataView` module provides a view into an `ArrayBuffer` for inter-process +flat memory operations. + +* [MDN `ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer) +* [ECMA-262 `ArrayBuffer`](https://tc39.es/ecma262/multipage/structured-data.html#sec-arraybuffer-objects) ## Installation -``` - bower install purescript-arraybuffer +Install `arraybuffer` with [Spago](https://github.com/purescript/spago): + +```sh +spago install arraybuffer ``` ## Documentation -Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-arraybuffer). +`arraybuffer` documentation is stored in a few places: + +1. Module documentation is [published on Pursuit](https://pursuit.purescript.org/packages/purescript-arraybuffer). +2. Written documentation is kept in the [docs directory](./docs). +3. Usage examples can be found in [the test suite](./test). + +If you get stuck, there are several ways to get help: + +- [Open an issue](https://github.com/purescript-contrib/purescript-arraybuffer/issues) if you have encountered a bug or problem. +- Ask general questions on the [PureScript Discourse](https://discourse.purescript.org) forum or the [PureScript Discord](https://purescript.org/chat) chat. + +## Contributing + +You can contribute to `arraybuffer` in several ways: + +1. If you encounter a problem or have a question, please [open an issue](https://github.com/purescript-contrib/purescript-arraybuffer/issues). We'll do our best to work with you to resolve or answer it. + +2. If you would like to contribute code, tests, or documentation, please [read the contributor guide](./CONTRIBUTING.md). It's a short, helpful introduction to contributing to this library, including development instructions. + +3. If you have written a library, tutorial, guide, or other resource based on this package, please share it on the [PureScript Discourse](https://discourse.purescript.org)! Writing libraries and learning resources are a great way to help this library succeed. + +## Usage -See https://github.com/AlexaDeWit/purescript-arraybuffer-codecs if you need text/base64 encoding/decoding functions. +### Polyfill + +This library relies on runtime implementations of +[`ArrayBuffer`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer) +and +[`DataView`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DataView) +([Structured Data](https://tc39.es/ecma262/multipage/structured-data.html#sec-structured-data)), +and +[`TypedArray`](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray) +([Indexed Collections](https://tc39.es/ecma262/multipage/indexed-collections.html#sec-indexed-collections)). + +If you want to be sure that those implementations are available in your target +runtime environment, you might want to consider using a polyfill such as +[__core-js__ Typed Arrays](https://github.com/zloirock/core-js#ecmascript-typed-arrays). + +## Related packages + +These are some other packages which provide more `ArrayBuffer` features. + +### Reading and Writing + +* [__arraybuffer-class__](https://pursuit.purescript.org/packages/purescript-arraybuffer-class) +* [__dynamic-buffers__](https://pursuit.purescript.org/packages/purescript-dynamic-buffers) +* [__parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview) +* [__arraybuffer-builder__](https://pursuit.purescript.org/packages/purescript-arraybuffer-builder) + +### Node.js + +* [__node-buffer__](https://pursuit.purescript.org/packages/purescript-node-buffer) + +### UTF + +* [__web-encoding__](https://pursuit.purescript.org/packages/purescript-web-encoding) + +### Base64 + +* [__base64-codec__](https://pursuit.purescript.org/packages/purescript-base64-codec) + +## Development + +Run the tests with + +```sh +spago -x spago-test.dhall test +``` diff --git a/bower.json b/bower.json index 9f5755a..e0cb70c 100644 --- a/bower.json +++ b/bower.json @@ -1,32 +1,30 @@ { - "name": "purescript-arraybuffer", - "license": "MIT", - "repository": { - "type": "git", - "url": "git://github.com/jacereda/purescript-arraybuffer.git" - }, - "ignore": [ - "**/.*", - "node_modules", - "bower_components", - "output" - ], - "dependencies": { - "purescript-prelude": "^5.0.0", - "purescript-functions": "^5.0.0", - "purescript-arraybuffer-types": "^2.0.0", - "purescript-maybe": "^5.0.0", - "purescript-effect": "^3.0.0", - "purescript-nullable": "^5.0.0", - "purescript-typelevel": "^6.0.0", - "purescript-uint": "^5.1.4", - "purescript-partial": "^3.0.0", - "purescript-float32": "~0.2.0" - }, - "devDependencies": { - "purescript-debug": "^5.0.0", - "purescript-quickcheck": "^7.0.0", - "purescript-quickcheck-combinators": "~0.1.3", - "purescript-quickcheck-laws": "^6.0.0" - } + "name": "purescript-arraybuffer", + "license": [ + "MIT" + ], + "repository": { + "type": "git", + "url": "https://github.com/purescript-contrib/purescript-arraybuffer" + }, + "ignore": [ + "**/.*", + "node_modules", + "bower_components", + "output" + ], + "dependencies": { + "purescript-arraybuffer-types": "^v3.0.2", + "purescript-arrays": "^v7.2.0", + "purescript-effect": "^v4.0.0", + "purescript-float32": "^v2.0.0", + "purescript-functions": "^v6.0.0", + "purescript-gen": "^v4.0.0", + "purescript-maybe": "^v6.0.0", + "purescript-nullable": "^v6.0.0", + "purescript-prelude": "^v6.0.1", + "purescript-tailrec": "^v6.1.0", + "purescript-uint": "^v7.0.0", + "purescript-unfoldable": "^v6.0.0" + } } diff --git a/docs/README.md b/docs/README.md new file mode 100644 index 0000000..2e2f3dd --- /dev/null +++ b/docs/README.md @@ -0,0 +1,3 @@ +# Arraybuffer Documentation + +This directory contains documentation for `arraybuffer`. If you are interested in contributing new documentation, please read the [contributor guidelines](../CONTRIBUTING.md) and [What Nobody Tells You About Documentation](https://documentation.divio.com) for help getting started. diff --git a/package.json b/package.json deleted file mode 100644 index 110d9f1..0000000 --- a/package.json +++ /dev/null @@ -1,9 +0,0 @@ -{ - "name": "purescript-arraybuffer", - "version": "9.0.0", - "main": "index.js", - "repository": "git@github.com:jacereda/purescript-arraybuffer.git", - "author": "https://github.com/jacereda", - "license": "MIT", - "devDependencies": {} -} \ No newline at end of file diff --git a/packages.dhall b/packages.dhall index cf30481..8af7890 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,34 +1,5 @@ - let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.14.1-20210419/packages.dhall sha256:d9a082ffb5c0fabf689574f0680e901ca6f924e01acdbece5eeedd951731375a - -let overrides = {=} - -let additions = - { float32 = - { dependencies = - [ "effect" - , "gen" - , "maybe" - , "prelude" - ] - , repo = - "https://github.com/athanclark/purescript-float32.git" - , version = - "v0.2.0" - } - , uint = - { dependencies = - [ "effect" - , "math" - , "maybe" - , "quickcheck" - , "quickcheck-laws" - ] - , repo = "https://github.com/zaquest/purescript-uint.git" - , version = "v5.1.4" - } - } - -in upstream // overrides // additions + https://github.com/purescript/package-sets/releases/download/psc-0.15.7-20230211/packages.dhall + sha256:c44fcd5b1b7a1adf85bbd4ed2eeb08865c44996bd0c8b1e1fdcd3dea8cfab914 +in upstream diff --git a/spago-test.dhall b/spago-test.dhall new file mode 100644 index 0000000..7037d90 --- /dev/null +++ b/spago-test.dhall @@ -0,0 +1,13 @@ +let conf = ./spago.dhall +in conf // { +, dependencies = conf.dependencies # + [ "console" + , "foldable-traversable" + , "partial" + , "refs" + , "tuples" + , "quickcheck" + , "quickcheck-laws" + ] +, sources = conf.sources # [ "test/**/*.purs" ] +} diff --git a/spago.dhall b/spago.dhall index ef25406..48fc095 100644 --- a/spago.dhall +++ b/spago.dhall @@ -2,26 +2,19 @@ , dependencies = [ "arraybuffer-types" , "arrays" - , "console" , "effect" , "float32" - , "foldable-traversable" , "functions" , "gen" , "maybe" , "nullable" - , "partial" , "prelude" - , "quickcheck" - , "quickcheck-combinators" - , "quickcheck-laws" - , "refs" , "tailrec" - , "typelevel" - , "typelevel-prelude" , "uint" , "unfoldable" ] , packages = ./packages.dhall -, sources = [ "src/**/*.purs", "test/**/*.purs" ] +, sources = [ "src/**/*.purs" ] +, license = "MIT" +, repository = "https://github.com/purescript-contrib/purescript-arraybuffer" } diff --git a/src/Data/ArrayBuffer/ArrayBuffer.js b/src/Data/ArrayBuffer/ArrayBuffer.js index b341921..9bb2fc1 100644 --- a/src/Data/ArrayBuffer/ArrayBuffer.js +++ b/src/Data/ArrayBuffer/ArrayBuffer.js @@ -1,15 +1,13 @@ -"use strict"; - // module Data.ArrayBuffer.ArrayBuffer -exports.emptyImpl = function empty (s) { +export function emptyImpl(s) { return new ArrayBuffer(s); }; -exports.byteLength = function byteLength (a) { +export function byteLength(a) { return a.byteLength; -}; +} -exports.sliceImpl = function sliceImpl (a, s, e) { +export function sliceImpl(a, s, e) { return a.slice(s, e); -}; +} diff --git a/src/Data/ArrayBuffer/ArrayBuffer.purs b/src/Data/ArrayBuffer/ArrayBuffer.purs index 1206040..fecb62b 100644 --- a/src/Data/ArrayBuffer/ArrayBuffer.purs +++ b/src/Data/ArrayBuffer/ArrayBuffer.purs @@ -1,6 +1,5 @@ -- | This module represents the functional bindings to JavaScript's `ArrayBuffer` -- | objects. See [MDN's spec](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/ArrayBuffer) for details. - module Data.ArrayBuffer.ArrayBuffer ( empty , byteLength @@ -15,6 +14,7 @@ import Effect.Uncurried (EffectFn1, runEffectFn1) -- | Create an `ArrayBuffer` with the given capacity. empty :: ByteLength -> Effect ArrayBuffer empty l = runEffectFn1 emptyImpl l + foreign import emptyImpl :: EffectFn1 ByteLength ArrayBuffer -- | Represents the length of an `ArrayBuffer` in bytes. @@ -23,4 +23,5 @@ foreign import byteLength :: ArrayBuffer -> ByteLength -- | Returns a new `ArrayBuffer` whose contents are a copy of this ArrayBuffer's bytes from begin, inclusive, up to end, exclusive. slice :: ByteOffset -> ByteOffset -> ArrayBuffer -> ArrayBuffer slice s e a = runFn3 sliceImpl a s e + foreign import sliceImpl :: Fn3 ArrayBuffer ByteOffset ByteOffset ArrayBuffer diff --git a/src/Data/ArrayBuffer/ArrayBuffer/Gen.purs b/src/Data/ArrayBuffer/ArrayBuffer/Gen.purs index dbe909a..381931c 100644 --- a/src/Data/ArrayBuffer/ArrayBuffer/Gen.purs +++ b/src/Data/ArrayBuffer/ArrayBuffer/Gen.purs @@ -6,8 +6,5 @@ import Data.ArrayBuffer.Typed.Gen (genTypedArray, genUint8) import Data.ArrayBuffer.Types (ArrayBuffer, Uint8Array) import Prelude ((<$>)) - -genArrayBuffer :: forall m - . MonadGen m - => m ArrayBuffer +genArrayBuffer :: forall m. MonadGen m => m ArrayBuffer genArrayBuffer = buffer <$> (genTypedArray genUint8 :: m Uint8Array) diff --git a/src/Data/ArrayBuffer/Cast.purs b/src/Data/ArrayBuffer/Cast.purs new file mode 100644 index 0000000..10e5b0a --- /dev/null +++ b/src/Data/ArrayBuffer/Cast.purs @@ -0,0 +1,46 @@ +-- | `DataView` represents unaligned memory of unknown endianness. +-- | +-- | `ArrayView` represents arrays of aligned elements of +-- | local-machine endianness. +-- | For the cases of `Int8Array`, `Uint8Array`, `Uint8ClampedArray`, +-- | the elements +-- | are single bytes, so they are always aligned and they have no +-- | endianness. Therefore in those cases we can freely cast back and forth +-- | to `DataView`. +module Data.ArrayBuffer.Cast + ( fromInt8Array + , fromUint8Array + , fromUint8ClampedArray + , toInt8Array + , toUint8Array + , toUint8ClampedArray + ) where + +import Data.ArrayBuffer.DataView as DV +import Data.ArrayBuffer.Typed as AT +import Data.ArrayBuffer.Types (DataView, Uint8Array, Uint8ClampedArray, Int8Array) +import Effect (Effect) + +-- | Cast an `Int8Array` to a `DataView`. +fromInt8Array :: Int8Array -> Effect DataView +fromInt8Array x = DV.part (AT.buffer x) (AT.byteOffset x) (AT.byteLength x) + +-- | Cast a `DataView` to an `Int8Array`. +toInt8Array :: DataView -> Effect Int8Array +toInt8Array x = AT.part (DV.buffer x) (DV.byteOffset x) (DV.byteLength x) + +-- | Cast a `UInt8Array` to a `DataView`. +fromUint8Array :: Uint8Array -> Effect DataView +fromUint8Array x = DV.part (AT.buffer x) (AT.byteOffset x) (AT.byteLength x) + +-- | Cast a `DataView` to a `Uint8Array`. +toUint8Array :: DataView -> Effect Uint8Array +toUint8Array x = AT.part (DV.buffer x) (DV.byteOffset x) (DV.byteLength x) + +-- | Cast a `UInt8ClampedArray` to a `DataView`. +fromUint8ClampedArray :: Uint8ClampedArray -> Effect DataView +fromUint8ClampedArray x = DV.part (AT.buffer x) (AT.byteOffset x) (AT.byteLength x) + +-- | Cast a `DataView` to a `Uint8ClampedArray`. +toUint8ClampedArray :: DataView -> Effect Uint8ClampedArray +toUint8ClampedArray x = AT.part (DV.buffer x) (DV.byteOffset x) (DV.byteLength x) diff --git a/src/Data/ArrayBuffer/DataView.js b/src/Data/ArrayBuffer/DataView.js index 6bfee81..1eeb060 100644 --- a/src/Data/ArrayBuffer/DataView.js +++ b/src/Data/ArrayBuffer/DataView.js @@ -1,43 +1,41 @@ -"use strict"; - // module Data.ArrayBuffer.DataView -exports.whole = function whole (b) { +export function whole(b) { return new DataView(b); -}; +} -exports.remainderImpl = function remainderImpl (b,i) { +export function remainderImpl(b, i) { return new DataView(b,i); -}; +} -exports.partImpl = function partImpl (b,i,j) { +export function partImpl(b, i, j) { return new DataView(b,i,j); -}; +} -exports.buffer = function buffer (v) { +export function buffer(v) { return v.buffer; -}; +} -exports.byteOffset = function byteOffset (v) { +export function byteOffset(v) { return v.byteOffset; -}; +} -exports.byteLength = function byteLength (v) { +export function byteLength(v) { return v.byteLength; -}; +} -exports.getterImpl = function getterImpl (data, v, o) { +export function getterImpl(data, v, o) { return ((o + data.bytesPerValue) >>> 0) <= v.byteLength ? v[data.functionName].call(v,o,data.littleEndian) : null; -}; +} -exports.setterImpl = function setterImpl (data, v, o, n) { +export function setterImpl(data, v, o, n) { if (((o + data.bytesPerValue) >>> 0) <= v.byteLength) { v[data.functionName].call(v,o,n,data.littleEndian); return true; } else { return false; } -}; +} diff --git a/src/Data/ArrayBuffer/DataView.purs b/src/Data/ArrayBuffer/DataView.purs index b88f344..badab60 100644 --- a/src/Data/ArrayBuffer/DataView.purs +++ b/src/Data/ArrayBuffer/DataView.purs @@ -1,78 +1,82 @@ -- | This module represents the functional bindings to JavaScript's `DataView` -- | objects. See [MDN's spec](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/DataView) for details. - module Data.ArrayBuffer.DataView - ( AProxy (..) - , Endian (..) - , buffer - , byteLength - , byteOffset - , get - , getBE - , getFloat32be - , getFloat32le - , getFloat64be - , getFloat64le - , getInt16be - , getInt16le - , getInt32be - , getInt32le - , getInt8 - , getLE - , getUint16be - , getUint16le - , getUint32be - , getUint32le - , getUint8 - , part - , remainder - , set - , setBE - , setFloat32be - , setFloat32le - , setFloat64be - , setFloat64le - , setInt16be - , setInt16le - , setInt32be - , setInt32le - , setInt8 - , setLE - , setUint16be - , setUint16le - , setUint32be - , setUint32le - , setUint8 - , whole - ) where - -import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, ByteOffset, DataView, Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8, kind ArrayViewType) -import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerValue, class ShowArrayViewType) + ( Endian(..) + , buffer + , byteLength + , byteOffset + , get + , getBE + , getFloat32be + , getFloat32le + , getFloat64be + , getFloat64le + , getInt16be + , getInt16le + , getInt32be + , getInt32le + , getInt8 + , getLE + , getUint16be + , getUint16le + , getUint32be + , getUint32le + , getUint8 + , part + , remainder + , set + , setBE + , setFloat32be + , setFloat32le + , setFloat64be + , setFloat64le + , setInt16be + , setInt16le + , setInt32be + , setInt32le + , setInt8 + , setLE + , setUint16be + , setUint16le + , setUint32be + , setUint32le + , setUint8 + , whole + ) where + +import Data.ArrayBuffer.Types (ArrayBuffer, ByteLength, ByteOffset, DataView, Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8) +import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerType, class ShowArrayViewType, byteWidth) import Data.Float32 (Float32) as F import Data.Maybe (Maybe) import Data.Nullable (Nullable, toMaybe) -import Data.Symbol (SProxy(..), class IsSymbol, reflectSymbol) -import Data.Typelevel.Num (toInt', class Nat) +import Data.Symbol (class IsSymbol, reflectSymbol) import Data.UInt (UInt) import Effect (Effect) import Effect.Uncurried (EffectFn2, EffectFn3, EffectFn4, runEffectFn2, runEffectFn3, runEffectFn4) import Prelude (class Eq, (<$>), (<>), (==)) import Type.Proxy (Proxy(..)) +-- | Endianness of a multi-byte type. Little-Endian or Big-Endian. +data Endian = LE | BE +instance eqEndian :: Eq Endian where + eq LE LE = true + eq BE BE = true + eq _ _ = false -- | View mapping the whole `ArrayBuffer`. foreign import whole :: ArrayBuffer -> DataView - -- | View mapping the rest of an `ArrayBuffer` after an index. remainder :: ArrayBuffer -> ByteOffset -> Effect DataView remainder a o = runEffectFn2 remainderImpl a o + foreign import remainderImpl :: EffectFn2 ArrayBuffer ByteOffset DataView -- | View mapping a region of the `ArrayBuffer`. part :: ArrayBuffer -> ByteOffset -> ByteLength -> Effect DataView part a o l = runEffectFn3 partImpl a o l + foreign import partImpl :: EffectFn3 ArrayBuffer ByteOffset ByteLength DataView -- | `ArrayBuffer` being mapped by the view. @@ -84,230 +88,266 @@ foreign import byteOffset :: DataView -> ByteOffset -- | Represents the length of this view. foreign import byteLength :: DataView -> ByteLength - -data AProxy (a :: ArrayViewType) = AProxy - -data Endian = LE | BE - -instance eqEndian :: Eq Endian where - eq LE LE = true - eq BE BE = true - eq _ _ = false - - -getter :: forall t. - { functionName :: String - , bytesPerValue :: ByteLength - , littleEndian :: Boolean - } - -> DataView -> ByteOffset -> Effect (Maybe t) -getter data' d o = toMaybe <$> - runEffectFn3 getterImpl +getter + :: forall t + . { functionName :: String + , bytesPerValue :: ByteLength + , littleEndian :: Boolean + } + -> DataView + -> ByteOffset + -> Effect (Maybe t) +getter data' dataView offset = + toMaybe <$> runEffectFn3 getterImpl { functionName: data'.functionName , littleEndian: data'.littleEndian , bytesPerValue: data'.bytesPerValue - } d o -foreign import getterImpl :: forall t - . EffectFn3 { functionName :: String - , littleEndian :: Boolean - , bytesPerValue :: ByteLength - } DataView ByteOffset (Nullable t) - - - -get :: forall a name t b - . BinaryValue a t - => BytesPerValue a b - => ShowArrayViewType a name - => IsSymbol name - => Nat b - => Endian -> AProxy a -> DataView -> ByteOffset -> Effect (Maybe t) -get endian prx = - let le = endian == LE - pnm = "get" <> reflectSymbol (SProxy :: SProxy name) - bpv = toInt' (Proxy :: Proxy b) - in getter { functionName: pnm - , bytesPerValue: bpv - , littleEndian: le - } - -getBE :: forall a name t b - . BinaryValue a t - => BytesPerValue a b - => ShowArrayViewType a name - => IsSymbol name - => Nat b - => AProxy a -> DataView -> ByteOffset -> Effect (Maybe t) + } + dataView + offset + +foreign import getterImpl + :: forall t + . EffectFn3 + { functionName :: String + , littleEndian :: Boolean + , bytesPerValue :: ByteLength + } + DataView + ByteOffset + (Nullable t) + +get + :: forall a name t + . BinaryValue a t + => BytesPerType a + => ShowArrayViewType a name + => IsSymbol name + => Endian + -> Proxy a + -> DataView + -> ByteOffset + -> Effect (Maybe t) +get endian prx = do + let + le = endian == LE + pnm = "get" <> reflectSymbol (Proxy :: Proxy name) + bpv = byteWidth prx + + getter + { functionName: pnm + , bytesPerValue: bpv + , littleEndian: le + } + +getBE + :: forall a name t + . BinaryValue a t + => BytesPerType a + => ShowArrayViewType a name + => IsSymbol name + => Proxy a + -> DataView + -> ByteOffset + -> Effect (Maybe t) getBE = get BE -getLE :: forall a name t b - . BinaryValue a t - => BytesPerValue a b - => ShowArrayViewType a name - => IsSymbol name - => Nat b - => AProxy a -> DataView -> ByteOffset -> Effect (Maybe t) +getLE + :: forall a name t + . BinaryValue a t + => BytesPerType a + => ShowArrayViewType a name + => IsSymbol name + => Proxy a + -> DataView + -> ByteOffset + -> Effect (Maybe t) getLE = get LE -setter :: forall t. - { functionName :: String - , bytesPerValue :: ByteLength - , littleEndian :: Boolean - } -> DataView -> ByteOffset -> t -> Effect Boolean -setter d o t = runEffectFn4 setterImpl d o t -foreign import setterImpl :: forall t - . EffectFn4 { functionName :: String - , littleEndian :: Boolean - , bytesPerValue :: ByteLength - } DataView ByteOffset t Boolean - - -set :: forall a name t b - . BinaryValue a t - => BytesPerValue a b - => ShowArrayViewType a name - => IsSymbol name - => Nat b - => Endian -> AProxy a -> DataView -> ByteOffset -> t -> Effect Boolean -set endian prx = - let le = endian == LE - pnm = "set" <> reflectSymbol (SProxy :: SProxy name) - bpv = toInt' (Proxy :: Proxy b) - in setter { functionName: pnm - , bytesPerValue: bpv - , littleEndian: le - } +setter + :: forall t + . { functionName :: String + , bytesPerValue :: ByteLength + , littleEndian :: Boolean + } + -> DataView + -> ByteOffset + -> t + -> Effect Boolean +setter dataView offset t = runEffectFn4 setterImpl dataView offset t + +foreign import setterImpl + :: forall t + . EffectFn4 + { functionName :: String + , littleEndian :: Boolean + , bytesPerValue :: ByteLength + } + DataView + ByteOffset + t + Boolean + +set + :: forall a name t + . BinaryValue a t + => BytesPerType a + => ShowArrayViewType a name + => IsSymbol name + => Endian + -> Proxy a + -> DataView + -> ByteOffset + -> t + -> Effect Boolean +set endian prx = do + let + le = endian == LE + pnm = "set" <> reflectSymbol (Proxy :: Proxy name) + bpv = byteWidth prx + + setter + { functionName: pnm + , bytesPerValue: bpv + , littleEndian: le + } -- | Fetch int8 value at a certain index in a `DataView`. getInt8 :: DataView -> ByteOffset -> Effect (Maybe Int) -getInt8 = getLE (AProxy :: AProxy Int8) +getInt8 = getLE (Proxy :: Proxy Int8) -- | Fetch big-endian int16 value at a certain index in a `DataView`. getInt16be :: DataView -> ByteOffset -> Effect (Maybe Int) -getInt16be = getBE (AProxy :: AProxy Int16) +getInt16be = getBE (Proxy :: Proxy Int16) -- | Fetch little-endian int16 value at a certain index in a `DataView`. getInt16le :: DataView -> ByteOffset -> Effect (Maybe Int) -getInt16le = getLE (AProxy :: AProxy Int16) +getInt16le = getLE (Proxy :: Proxy Int16) -- | Fetch big-endian int32 value at a certain index in a `DataView`. getInt32be :: DataView -> ByteOffset -> Effect (Maybe Int) -getInt32be = getBE (AProxy :: AProxy Int32) +getInt32be = getBE (Proxy :: Proxy Int32) -- | Fetch little-endian int32 value at a certain index in a `DataView`. getInt32le :: DataView -> ByteOffset -> Effect (Maybe Int) -getInt32le = getLE (AProxy :: AProxy Int32) +getInt32le = getLE (Proxy :: Proxy Int32) -- | Fetch uint8 value at a certain index in a `DataView`. getUint8 :: DataView -> ByteOffset -> Effect (Maybe UInt) -getUint8 = getLE (AProxy :: AProxy Uint8) +getUint8 = getLE (Proxy :: Proxy Uint8) -- | Fetch big-endian uint16 value at a certain index in a `DataView`. getUint16be :: DataView -> ByteOffset -> Effect (Maybe UInt) -getUint16be = getBE (AProxy :: AProxy Uint16) +getUint16be = getBE (Proxy :: Proxy Uint16) -- | Fetch little-endian uint16 value at a certain index in a `DataView`. getUint16le :: DataView -> ByteOffset -> Effect (Maybe UInt) -getUint16le = getLE (AProxy :: AProxy Uint16) +getUint16le = getLE (Proxy :: Proxy Uint16) -- | Fetch big-endian uint32 value at a certain index in a `DataView`. getUint32be :: DataView -> ByteOffset -> Effect (Maybe UInt) -getUint32be = getBE (AProxy :: AProxy Uint32) +getUint32be = getBE (Proxy :: Proxy Uint32) -- | Fetch little-endian uint32 value at a certain index in a `DataView`. getUint32le :: DataView -> ByteOffset -> Effect (Maybe UInt) -getUint32le = getLE (AProxy :: AProxy Uint32) +getUint32le = getLE (Proxy :: Proxy Uint32) -- | Fetch big-endian float32 value at a certain index in a `DataView`. getFloat32be :: DataView -> ByteOffset -> Effect (Maybe F.Float32) -getFloat32be = getBE (AProxy :: AProxy Float32) +getFloat32be = getBE (Proxy :: Proxy Float32) -- | Fetch little-endian float32 value at a certain index in a `DataView`. getFloat32le :: DataView -> ByteOffset -> Effect (Maybe F.Float32) -getFloat32le = getLE (AProxy :: AProxy Float32) +getFloat32le = getLE (Proxy :: Proxy Float32) -- | Fetch big-endian float64 value at a certain index in a `DataView`. getFloat64be :: DataView -> ByteOffset -> Effect (Maybe Number) -getFloat64be = getBE (AProxy :: AProxy Float64) +getFloat64be = getBE (Proxy :: Proxy Float64) -- | Fetch little-endian float64 value at a certain index in a `DataView`. getFloat64le :: DataView -> ByteOffset -> Effect (Maybe Number) -getFloat64le = getLE (AProxy :: AProxy Float64) - +getFloat64le = getLE (Proxy :: Proxy Float64) -- | Store big-endian value at a certain index in a `DataView`. -setBE :: forall a name t b - . BinaryValue a t - => BytesPerValue a b - => ShowArrayViewType a name - => IsSymbol name - => Nat b - => AProxy a -> DataView -> ByteOffset -> t -> Effect Boolean +setBE + :: forall a name t + . BinaryValue a t + => BytesPerType a + => ShowArrayViewType a name + => IsSymbol name + => Proxy a + -> DataView + -> ByteOffset + -> t + -> Effect Boolean setBE = set BE -- | Store little-endian value at a certain index in a `DataView`. -setLE :: forall a name t b - . BinaryValue a t - => BytesPerValue a b - => ShowArrayViewType a name - => IsSymbol name - => Nat b - => AProxy a -> DataView -> ByteOffset -> t -> Effect Boolean +setLE + :: forall a name t + . BinaryValue a t + => BytesPerType a + => ShowArrayViewType a name + => IsSymbol name + => Proxy a + -> DataView + -> ByteOffset + -> t + -> Effect Boolean setLE = set LE -- | Store int8 value at a certain index in a `DataView`. setInt8 :: DataView -> ByteOffset -> Int -> Effect Boolean -setInt8 = setLE (AProxy :: AProxy Int8) +setInt8 = setLE (Proxy :: Proxy Int8) -- | Store big-endian int16 value at a certain index in a `DataView`. setInt16be :: DataView -> ByteOffset -> Int -> Effect Boolean -setInt16be = setBE (AProxy :: AProxy Int16) +setInt16be = setBE (Proxy :: Proxy Int16) -- | Store little-endian int16 value at a certain index in a `DataView`. setInt16le :: DataView -> ByteOffset -> Int -> Effect Boolean -setInt16le = setLE (AProxy :: AProxy Int16) +setInt16le = setLE (Proxy :: Proxy Int16) -- | Store big-endian int32 value at a certain index in a `DataView`. setInt32be :: DataView -> ByteOffset -> Int -> Effect Boolean -setInt32be = setBE (AProxy :: AProxy Int32) +setInt32be = setBE (Proxy :: Proxy Int32) -- | Store little-endian int32 value at a certain index in a `DataView`. setInt32le :: DataView -> ByteOffset -> Int -> Effect Boolean -setInt32le = setLE (AProxy :: AProxy Int32) +setInt32le = setLE (Proxy :: Proxy Int32) -- | Store uint8 value at a certain index in a `DataView`. setUint8 :: DataView -> ByteOffset -> UInt -> Effect Boolean -setUint8 = setLE (AProxy :: AProxy Uint8) - +setUint8 = setLE (Proxy :: Proxy Uint8) -- | Store big-endian uint16 value at a certain index in a `DataView`. setUint16be :: DataView -> ByteOffset -> UInt -> Effect Boolean -setUint16be = setBE (AProxy :: AProxy Uint16) +setUint16be = setBE (Proxy :: Proxy Uint16) -- | Store little-endian uint16 value at a certain index in a `DataView`. setUint16le :: DataView -> ByteOffset -> UInt -> Effect Boolean -setUint16le = setLE (AProxy :: AProxy Uint16) +setUint16le = setLE (Proxy :: Proxy Uint16) -- | Store big-endian uint32 value at a certain index in a `DataView`. setUint32be :: DataView -> ByteOffset -> UInt -> Effect Boolean -setUint32be = setBE (AProxy :: AProxy Uint32) +setUint32be = setBE (Proxy :: Proxy Uint32) -- | Store little-endian uint32 value at a certain index in a `DataView`. setUint32le :: DataView -> ByteOffset -> UInt -> Effect Boolean -setUint32le = setLE (AProxy :: AProxy Uint32) +setUint32le = setLE (Proxy :: Proxy Uint32) -- | Store big-endian float32 value at a certain index in a `DataView`. setFloat32be :: DataView -> ByteOffset -> F.Float32 -> Effect Boolean -setFloat32be = setBE (AProxy :: AProxy Float32) +setFloat32be = setBE (Proxy :: Proxy Float32) -- | Store little-endian float32 value at a certain index in a `DataView`. setFloat32le :: DataView -> ByteOffset -> F.Float32 -> Effect Boolean -setFloat32le = setLE (AProxy :: AProxy Float32) +setFloat32le = setLE (Proxy :: Proxy Float32) -- | Store big-endian float64 value at a certain index in a `DataView`. setFloat64be :: DataView -> ByteOffset -> Number -> Effect Boolean -setFloat64be = setBE (AProxy :: AProxy Float64) +setFloat64be = setBE (Proxy :: Proxy Float64) -- | Store little-endian float64 value at a certain index in a `DataView`. setFloat64le :: DataView -> ByteOffset -> Number -> Effect Boolean -setFloat64le = setLE (AProxy :: AProxy Float64) +setFloat64le = setLE (Proxy :: Proxy Float64) diff --git a/src/Data/ArrayBuffer/DataView/Gen.purs b/src/Data/ArrayBuffer/DataView/Gen.purs index 441851a..cd1c974 100644 --- a/src/Data/ArrayBuffer/DataView/Gen.purs +++ b/src/Data/ArrayBuffer/DataView/Gen.purs @@ -1,43 +1,35 @@ module Data.ArrayBuffer.DataView.Gen where -import Prelude ((<$>), bind, (<=), (-), pure) - import Control.Monad.Gen (suchThat) import Control.Monad.Gen.Class (class MonadGen, chooseInt) import Control.Monad.Rec.Class (class MonadRec) import Data.ArrayBuffer.ArrayBuffer.Gen (genArrayBuffer) import Data.ArrayBuffer.DataView (whole, byteLength) -import Data.ArrayBuffer.Types (DataView, ByteOffset, kind ArrayViewType) -import Data.ArrayBuffer.ValueMapping (class BytesPerValue, class BinaryValue) -import Data.Typelevel.Num (class Nat, toInt') +import Data.ArrayBuffer.Types (DataView, ByteOffset, ArrayViewType) +import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerType, byteWidth) import Data.Unfoldable (replicateA) +import Prelude ((<$>), bind, (<=), (-), pure) import Type.Proxy (Proxy(..)) - -genDataView :: forall m - . MonadGen m - => m DataView +genDataView :: forall m. MonadGen m => m DataView genDataView = whole <$> genArrayBuffer - - -- | For generating some set of offsets residing inside the generated array, with some computable value -data WithOffsetAndValue n (a :: ArrayViewType) t = +data WithOffsetAndValue (a :: ArrayViewType) t = WithOffsetAndValue (Array ByteOffset) t DataView -genWithOffsetAndValue :: forall m n a b t - . MonadGen m - => MonadRec m - => Nat n - => BytesPerValue a b - => BinaryValue a t - => Nat b - => m DataView -- ^ Assumes generated length is at least the minimum length of one value - -> m t - -> m (WithOffsetAndValue n a t) -genWithOffsetAndValue gen genT = do - let n = toInt' (Proxy :: Proxy n) - b = toInt' (Proxy :: Proxy b) +genWithOffsetAndValue + :: forall m a t + . MonadGen m + => MonadRec m + => BytesPerType a + => BinaryValue a t + => Int -- generated length + -> m DataView -- ^ Assumes generated length is at least the minimum length of one value + -> m t + -> m (WithOffsetAndValue a t) +genWithOffsetAndValue n gen genT = do + let b = byteWidth (Proxy :: Proxy a) xs <- gen `suchThat` \xs -> b <= byteLength xs let l = byteLength xs os <- replicateA n (chooseInt 0 (l - b)) diff --git a/src/Data/ArrayBuffer/Typed.js b/src/Data/ArrayBuffer/Typed.js index cf2d733..fc19771 100644 --- a/src/Data/ArrayBuffer/Typed.js +++ b/src/Data/ArrayBuffer/Typed.js @@ -1,39 +1,18 @@ -"use strict"; - - - -// Lightweight polyfill for ie - see https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray#Methods_Polyfill -function polyFill () { - var typedArrayTypes = - [ Int8Array, Uint8Array, Uint8ClampedArray, Int16Array - , Uint16Array, Int32Array, Uint32Array, Float32Array, Float64Array - ]; - - for (var k in typedArrayTypes) { - for (var v in Array.prototype) { - if (Array.prototype.hasOwnProperty(v) && !typedArrayTypes[k].prototype.hasOwnProperty(v)) - typedArrayTypes[k].prototype[v] = Array.prototype[v]; - } - } -}; - -polyFill(); - // module Data.ArrayBuffer.Typed -exports.buffer = function buffer (v) { +export function buffer(v) { return v.buffer; -}; +} -exports.byteOffset = function byteOffset (v) { +export function byteOffset(v) { return v.byteOffset; -}; +} -exports.byteLength = function byteLength (v) { +export function byteLength(v) { return v.byteLength; -}; +} -exports.lengthImpl = function lemgthImpl (v) { +export function lengthImpl(v) { return v.length; }; @@ -55,130 +34,126 @@ function newArray (f) { }; } -exports.newUint8ClampedArray = newArray(Uint8ClampedArray); -exports.newUint32Array = newArray(Uint32Array); -exports.newUint16Array = newArray(Uint16Array); -exports.newUint8Array = newArray(Uint8Array); -exports.newInt32Array = newArray(Int32Array); -exports.newInt16Array = newArray(Int16Array); -exports.newInt8Array = newArray(Int8Array); -exports.newFloat32Array = newArray(Float32Array); -exports.newFloat64Array = newArray(Float64Array); - +export const newUint8ClampedArray = newArray(Uint8ClampedArray); +export const newUint32Array = newArray(Uint32Array); +export const newUint16Array = newArray(Uint16Array); +export const newUint8Array = newArray(Uint8Array); +export const newInt32Array = newArray(Int32Array); +export const newInt16Array = newArray(Int16Array); +export const newInt8Array = newArray(Int8Array); +export const newFloat32Array = newArray(Float32Array); +export const newFloat64Array = newArray(Float64Array); // ------ -exports.everyImpl = function everyImpl (a,p) { +export function everyImpl(a, p) { return a.every(p); -}; -exports.someImpl = function someImpl (a,p) { - return a.some(p); -}; +} +export function someImpl(a, p) { + return a.some(p); +} -exports.fillImpl = function fillImpl (x, s, e, a) { +export function fillImpl(x, s, e, a) { return a.fill(x,s,e); -}; - +} -exports.mapImpl = function mapImpl (a,f) { +export function mapImpl(a, f) { return a.map(f); -}; +} -exports.forEachImpl = function forEachImpl (a,f) { +export function forEachImpl(a, f) { a.forEach(f); -}; +} -exports.filterImpl = function filterImpl (a,p) { +export function filterImpl(a, p) { return a.filter(p); -}; +} -exports.includesImpl = function includesImpl (a,x,mo) { +export function includesImpl(a, x, mo) { return mo === null ? a.includes(x) : a.includes(x,mo); -}; +} -exports.reduceImpl = function reduceImpl (a,f,i) { +export function reduceImpl(a, f, i) { return a.reduce(f,i); -}; -exports.reduce1Impl = function reduce1Impl (a,f) { +} + +export function reduce1Impl(a, f) { return a.reduce(f); -}; -exports.reduceRightImpl = function reduceRightImpl (a,f,i) { +} + +export function reduceRightImpl(a, f, i) { return a.reduceRight(f,i); -}; -exports.reduceRight1Impl = function reduceRight1Impl (a,f) { +} + +export function reduceRight1Impl(a, f) { return a.reduceRight(f); -}; +} -exports.findImpl = function findImpl (a,f) { +export function findImpl(a, f) { return a.find(f); -}; +} -exports.findIndexImpl = function findIndexImpl (a,f) { +export function findIndexImpl(a, f) { var r = a.findIndex(f); return r === -1 ? null : r; -}; -exports.indexOfImpl = function indexOfImpl (a,x,mo) { +} + +export function indexOfImpl(a, x, mo) { var r = mo === null ? a.indexOf(x) : a.indexOf(x,mo); return r === -1 ? null : r; -}; -exports.lastIndexOfImpl = function lastIndexOfImpl (a,x,mo) { +} + +export function lastIndexOfImpl(a, x, mo) { var r = mo === null ? a.lastIndexOf(x) : a.lastIndexOf(x,mo); return r === -1 ? null : r; -}; - - +} -exports.copyWithinImpl = function copyWithinImpl (a,t,s,me) { +export function copyWithinImpl(a, t, s, me) { if (me === null) { a.copyWithin(t,s); } else { a.copyWithin(t,s,me); } -}; - +} -exports.reverseImpl = function reverseImpl (a) { +export function reverseImpl(a) { a.reverse(); -}; - +} -exports.setImpl = function setImpl (a, off, b) { +export function setImpl(a, off, b) { a.set(b,off); -}; - +} -exports.sliceImpl = function sliceImpl (a, s, e) { +export function sliceImpl(a, s, e) { return a.slice(s,e); -}; +} -exports.sortImpl = function sortImpl (a) { +export function sortImpl(a) { a.sort(); -}; - +} -exports.subArrayImpl = function subArrayImpl (a, s, e) { +export function subArrayImpl(a, s, e) { return a.subarray(s, e); -}; - +} -exports.toStringImpl = function toStringImpl (a) { +export function toStringImpl(a) { return a.toString(); -}; +} -exports.joinImpl = function joinImpl (a,s) { +export function joinImpl(a, s) { return a.join(s); -}; +} -exports.unsafeAtImpl = function(a, i) { +export function unsafeAtImpl(a, i) { return a[i]; } -exports.hasIndexImpl = function(a, i) { +export function hasIndexImpl(a, i) { return i in a; } -exports.toArrayImpl = function(a) { +export function toArrayImpl(a) { var l = a.length; var ret = new Array(l); for (var i = 0; i < l; i++) diff --git a/src/Data/ArrayBuffer/Typed.purs b/src/Data/ArrayBuffer/Typed.purs index 6d17ee1..e46132d 100644 --- a/src/Data/ArrayBuffer/Typed.purs +++ b/src/Data/ArrayBuffer/Typed.purs @@ -23,40 +23,79 @@ -- | - `foldr`, `foldrM`, `foldr1`, `foldr1M`, `foldl`, `foldlM`, `foldl1`, `foldl1M` all can reduce an array -- | - `find` and `findIndex` are searching functions via a predicate -- | - `indexOf` and `lastIndexOf` are searching functions via equality --- | - `slice` returns a new typed array on the same array buffer content as the input --- | - `subArray` returns a new typed array with a separate array buffer +-- | - `slice` returns a new typed array with a new copied underlying `ArrayBuffer` +-- | - `subArray` returns a new typed array view of the same `ArrayBuffer` -- | - `toString` prints to a CSV, `join` allows you to supply the delimiter -- | - `toArray` returns an array of numeric values - module Data.ArrayBuffer.Typed - ( Index, Length - , buffer, byteOffset, byteLength, length - , compare, eq + ( Index + , Length + , buffer + , byteOffset + , byteLength + , length + , compare + , eq , class TypedArray - , create, whole, remainder, part, part', empty, fromArray - , fill, set, setTyped, copyWithin - , map, traverse, traverse_, filter - , mapWithIndex, traverseWithIndex, traverseWithIndex_, filterWithIndex - , sort, reverse + , create + , whole + , remainder + , part + , empty + , fromArray + , fill + , set + , setTyped + , copyWithin + , map + , traverse + , traverse_ + , filter + , mapWithIndex + , traverseWithIndex + , traverseWithIndex_ + , filterWithIndex + , sort + , reverse , elem - , all, any - , allWithIndex, anyWithIndex - , unsafeAt, hasIndex, at, (!) - , reduce, reduce1, foldl, foldl1, reduceRight, reduceRight1, foldr, foldr1 - , find, findIndex, indexOf, lastIndexOf - , slice, subArray - , toString, join, toArray + , all + , any + , allWithIndex + , anyWithIndex + , unsafeAt + , hasIndex + , at + , (!) + , reduce + , reduce1 + , foldl + , foldl1 + , reduceRight + , reduceRight1 + , foldr + , foldr1 + , foldlWithIndex + , foldrWithIndex + , find + , findIndex + , findWithIndex + , indexOf + , lastIndexOf + , slice + , subArray + , toString + , join + , toArray ) where import Data.Array (length) as A -import Data.ArrayBuffer.Types (ArrayView, kind ArrayViewType, ArrayBuffer, ByteOffset, ByteLength, Float64Array, Float32Array, Uint8ClampedArray, Uint32Array, Uint16Array, Uint8Array, Int32Array, Int16Array, Int8Array, Float64, Float32, Uint8Clamped, Uint32, Uint16, Uint8, Int32, Int16, Int8) -import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerValue) +import Data.ArrayBuffer.Types (ArrayView, ArrayViewType, ArrayBuffer, ByteOffset, ByteLength, Float64Array, Float32Array, Uint8ClampedArray, Uint32Array, Uint16Array, Uint8Array, Int32Array, Int16Array, Int8Array, Float64, Float32, Uint8Clamped, Uint32, Uint16, Uint8, Int32, Int16, Int8) +import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerType, byteWidth) import Data.Float32 (Float32) as F import Data.Function.Uncurried (Fn2, Fn3, mkFn2, runFn2, runFn3) import Data.Maybe (Maybe, fromMaybe) import Data.Nullable (Nullable, notNull, null, toMaybe, toNullable) -import Data.Typelevel.Num (class Nat, toInt') import Data.UInt (UInt) import Effect (Effect) import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, mkEffectFn2, mkEffectFn3, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4) @@ -65,7 +104,6 @@ import Prelude (class Eq, class Ord, Ordering, Unit, flip, pure, ($), (&&), (*), import Prelude as Prelude import Type.Proxy (Proxy(..)) - -- | `ArrayBuffer` being mapped by the typed array. foreign import buffer :: forall a. ArrayView a -> ArrayBuffer @@ -78,6 +116,7 @@ foreign import byteLength :: forall a. ArrayView a -> ByteLength -- | Represents the number of elements in this typed array. length :: forall a. ArrayView a -> Length length = lengthImpl + foreign import lengthImpl :: forall a. ArrayView a -> Length -- object creator implementations for each typed array @@ -92,32 +131,38 @@ foreign import newInt8Array :: forall a. EffectFn3 a (Nullable ByteOffset) (Null foreign import newFloat32Array :: forall a. EffectFn3 a (Nullable ByteOffset) (Nullable ByteLength) Float32Array foreign import newFloat64Array :: forall a. EffectFn3 a (Nullable ByteOffset) (Nullable ByteLength) Float64Array - -- | Value-oriented array index. type Index = Int -- | Value-oriented array length. type Length = Int - class BinaryValue a t <= TypedArray (a :: ArrayViewType) (t :: Type) | a -> t where create :: forall x. EffectFn3 x (Nullable ByteOffset) (Nullable ByteLength) (ArrayView a) instance typedArrayUint8Clamped :: TypedArray Uint8Clamped UInt where create = newUint8ClampedArray + instance typedArrayUint32 :: TypedArray Uint32 UInt where create = newUint32Array + instance typedArrayUint16 :: TypedArray Uint16 UInt where create = newUint16Array + instance typedArrayUint8 :: TypedArray Uint8 UInt where create = newUint8Array + instance typedArrayInt32 :: TypedArray Int32 Int where create = newInt32Array + instance typedArrayInt16 :: TypedArray Int16 Int where create = newInt16Array + instance typedArrayInt8 :: TypedArray Int8 Int where create = newInt8Array + instance typedArrayFloat32 :: TypedArray Float32 F.Float32 where create = newFloat32Array + instance typedArrayFloat64 :: TypedArray Float64 Number where create = newFloat64Array @@ -126,18 +171,22 @@ whole :: forall a t. TypedArray a t => ArrayBuffer -> Effect (ArrayView a) whole a = runEffectFn3 create a null null -- | View mapping the rest of an `ArrayBuffer` after an index. -remainder :: forall a b t. TypedArray a t => Nat b => BytesPerValue a b => ArrayBuffer -> Index -> Effect (ArrayView a) +remainder :: forall a b t. TypedArray a t => BytesPerType b => ArrayBuffer -> Index -> Effect (ArrayView a) remainder a x = remainder' a o - where o = x * toInt' (Proxy :: Proxy b) + where + o = x * byteWidth (Proxy :: Proxy b) remainder' :: forall a t. TypedArray a t => ArrayBuffer -> ByteOffset -> Effect (ArrayView a) remainder' a x = runEffectFn3 create a (notNull x) null -- | View mapping a region of the `ArrayBuffer`. -part :: forall a b t. TypedArray a t => Nat b => BytesPerValue a b => ArrayBuffer -> Index -> Length -> Effect (ArrayView a) +part :: forall a t. TypedArray a t => BytesPerType a => ArrayBuffer -> Index -> Length -> Effect (ArrayView a) part a x y = part' a o y - where o = x * toInt' (Proxy :: Proxy b) + where + o = x * byteWidth (Proxy :: Proxy a) +-- | The ByteOffset must be aligned. +-- | https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray#byteoffset_must_be_aligned part' :: forall a t. TypedArray a t => ArrayBuffer -> ByteOffset -> Length -> Effect (ArrayView a) part' a x y = runEffectFn3 create a (notNull x) (notNull y) @@ -152,6 +201,7 @@ fromArray a = runEffectFn3 create a null null -- | Fill the array with a value. fill :: forall a t. TypedArray a t => t -> Index -> Index -> ArrayView a -> Effect Unit fill x s e a = runEffectFn4 fillImpl x s e a + foreign import fillImpl :: forall a b. EffectFn4 b Index Index (ArrayView a) Unit -- | Stores multiple values into the typed array. @@ -161,8 +211,7 @@ set = setInternal A.length ap1 :: forall a b c. (a -> c) -> (a -> b -> c) ap1 f = \x _ -> f x - --- | Maps a new value over the typed array, creating a new buffer and +-- | Maps a new value over the typed array, creating a new `ArrayBuffer` and -- | typed array as well. map :: forall a t. TypedArray a t => (t -> t) -> ArrayView a -> ArrayView a map = mapWithIndex' <<< ap1 @@ -175,6 +224,7 @@ mapWithIndex = mapWithIndex' <<< flip mapWithIndex' :: forall a t. TypedArray a t => (t -> Index -> t) -> ArrayView a -> ArrayView a mapWithIndex' f a = unsafePerformEffect (runEffectFn2 mapImpl a (mkEffectFn2 \x o -> pure (f x o))) + foreign import mapImpl :: forall a b. EffectFn2 (ArrayView a) (EffectFn2 b Index b) (ArrayView a) -- | Traverses over each value, returning a new one. @@ -198,6 +248,7 @@ traverseWithIndex_ = traverseWithIndex_' <<< flip traverseWithIndex_' :: forall a t. TypedArray a t => (t -> Index -> Effect Unit) -> ArrayView a -> Effect Unit traverseWithIndex_' f a = runEffectFn2 forEachImpl a (mkEffectFn2 f) + foreign import forEachImpl :: forall a b. EffectFn2 (ArrayView a) (EffectFn2 b Index Unit) Unit -- | Test a predicate to pass on all values. @@ -211,6 +262,7 @@ allWithIndex = every <<< flip every :: forall a t. TypedArray a t => (t -> Index -> Boolean) -> ArrayView a -> Effect Boolean every p a = runEffectFn2 everyImpl a (mkFn2 p) + foreign import everyImpl :: forall a b. EffectFn2 (ArrayView a) (Fn2 b Index Boolean) Boolean -- | Test a predicate to pass on any value. @@ -223,6 +275,7 @@ anyWithIndex = some <<< flip some :: forall a t. TypedArray a t => (t -> Index -> Boolean) -> ArrayView a -> Effect Boolean some p a = runEffectFn2 someImpl a (mkFn2 p) + foreign import someImpl :: forall a b. EffectFn2 (ArrayView a) (Fn2 b Index Boolean) Boolean -- | Returns a new typed array with all values that pass the predicate. @@ -237,11 +290,13 @@ filterWithIndex = filterWithIndex' <<< flip filterWithIndex' :: forall a t. TypedArray a t => (t -> Index -> Boolean) -> ArrayView a -> Effect (ArrayView a) filterWithIndex' p a = runEffectFn2 filterImpl a (mkFn2 p) + foreign import filterImpl :: forall a b. EffectFn2 (ArrayView a) (Fn2 b Index Boolean) (ArrayView a) -- | Tests if a value is an element of the typed array. elem :: forall a t. TypedArray a t => t -> Maybe Index -> ArrayView a -> Effect Boolean elem x mo a = runEffectFn3 includesImpl a x (toNullable mo) + foreign import includesImpl :: forall a b. EffectFn3 (ArrayView a) b (Nullable Index) Boolean -- | Fetch element at index. @@ -251,21 +306,25 @@ unsafeAt a o = runEffectFn2 unsafeAtImpl a o -- | Folding from the left. reduce :: forall a t b. TypedArray a t => (b -> t -> Index -> Effect b) -> b -> ArrayView a -> Effect b reduce f i a = runEffectFn3 reduceImpl a (mkEffectFn3 f) i + foreign import reduceImpl :: forall a b c. EffectFn3 (ArrayView a) (EffectFn3 c b Index c) c c -- | Folding from the left. Assumes the typed array is non-empty. reduce1 :: forall a t. Partial => TypedArray a t => (t -> t -> Index -> Effect t) -> ArrayView a -> Effect t reduce1 f a = runEffectFn2 reduce1Impl a (mkEffectFn3 f) + foreign import reduce1Impl :: forall a b. EffectFn2 (ArrayView a) (EffectFn3 b b Index b) b -- | Folding from the right. reduceRight :: forall a t b. TypedArray a t => (t -> b -> Index -> Effect b) -> b -> ArrayView a -> Effect b reduceRight f i a = runEffectFn3 reduceRightImpl a (mkEffectFn3 \acc x o -> f x acc o) i + foreign import reduceRightImpl :: forall a b c. EffectFn3 (ArrayView a) (EffectFn3 c b Index c) c c -- | Folding from the right. Assumes the typed array is non-empty. reduceRight1 :: forall a t. Partial => TypedArray a t => (t -> t -> Index -> Effect t) -> ArrayView a -> Effect t reduceRight1 f a = runEffectFn2 reduceRight1Impl a (mkEffectFn3 \acc x o -> f x acc o) + foreign import reduceRight1Impl :: forall a b. EffectFn2 (ArrayView a) (EffectFn3 b b Index b) b -- | Returns the first value satisfying the predicate. @@ -279,21 +338,25 @@ findWithIndex = findWithIndex' <<< flip findWithIndex' :: forall a t. TypedArray a t => (t -> Index -> Boolean) -> ArrayView a -> Effect (Maybe t) findWithIndex' f a = toMaybe <$> runEffectFn2 findImpl a (mkFn2 f) + foreign import findImpl :: forall a b. EffectFn2 (ArrayView a) (Fn2 b Index Boolean) (Nullable b) -- | Returns the first index of the value satisfying the predicate. findIndex :: forall a t. TypedArray a t => (t -> Index -> Boolean) -> ArrayView a -> Effect (Maybe Index) findIndex f a = toMaybe <$> runEffectFn2 findIndexImpl a (mkFn2 f) + foreign import findIndexImpl :: forall a b. EffectFn2 (ArrayView a) (Fn2 b Index Boolean) (Nullable Index) -- | Returns the first index of the element, if it exists, from the left. indexOf :: forall a t. TypedArray a t => t -> Maybe Index -> ArrayView a -> Effect (Maybe Index) indexOf x mo a = toMaybe <$> runEffectFn3 indexOfImpl a x (toNullable mo) + foreign import indexOfImpl :: forall a b. EffectFn3 (ArrayView a) b (Nullable Index) (Nullable Index) -- | Returns the first index of the element, if it exists, from the right. lastIndexOf :: forall a t. TypedArray a t => t -> Maybe Index -> ArrayView a -> Effect (Maybe Index) lastIndexOf x mo a = toMaybe <$> runEffectFn3 lastIndexOfImpl a x (toNullable mo) + foreign import lastIndexOfImpl :: forall a b. EffectFn3 (ArrayView a) b (Nullable Index) (Nullable Index) -- | Fold a list from the left, accumulating the result using the @@ -329,61 +392,71 @@ foldr1 f = reduceRight1 \x a _ -> pure $ f a x -- | Internally copy values - see [MDN's spec](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray/copyWithin) for details. copyWithin :: forall a. ArrayView a -> Index -> Index -> Maybe Index -> Effect Unit copyWithin a t s me = runEffectFn4 copyWithinImpl a t s (toNullable me) + foreign import copyWithinImpl :: forall a. EffectFn4 (ArrayView a) Index Index (Nullable Index) Unit -- | Reverses a typed array in-place. reverse :: forall a. ArrayView a -> Effect Unit reverse a = runEffectFn1 reverseImpl a -foreign import reverseImpl :: forall a. EffectFn1 (ArrayView a) Unit +foreign import reverseImpl :: forall a. EffectFn1 (ArrayView a) Unit setInternal :: forall a b. (b -> Length) -> ArrayView a -> Maybe Index -> b -> Effect Boolean -setInternal lenfn a mo b = +setInternal lenfn a mo b = do let o = fromMaybe 0 mo - in if o >= 0 && lenfn b <= length a - o - then runEffectFn3 setImpl a o b *> pure true - else pure false -foreign import setImpl :: forall a b. EffectFn3 (ArrayView a) Index b Unit - + if o >= 0 && lenfn b <= length a - o then + runEffectFn3 setImpl a o b *> pure true + else + pure false +foreign import setImpl :: forall a b. EffectFn3 (ArrayView a) Index b Unit -- | Stores multiple values in the typed array, reading input values from the second typed array. setTyped :: forall a. ArrayView a -> Maybe Index -> ArrayView a -> Effect Boolean setTyped = setInternal length --- | Copy part of the contents of a typed array into a new buffer, between some start and end indices. +-- | Copy part of the contents of a typed array into a new `ArrayBuffer`, +-- | between the start and end indices. slice :: forall a. Index -> Index -> ArrayView a -> Effect (ArrayView a) slice s e a = runEffectFn3 sliceImpl a s e + foreign import sliceImpl :: forall a. EffectFn3 (ArrayView a) Index Index (ArrayView a) -- | Sorts the values in-place. sort :: forall a. ArrayView a -> Effect Unit sort a = runEffectFn1 sortImpl a + foreign import sortImpl :: forall a. EffectFn1 (ArrayView a) Unit --- | Returns a new typed array view of the same buffer, beginning at the index and ending at the second. +-- | Returns a new typed array view of the same `ArrayBuffer`, beginning at +-- | the index and ending at the second. subArray :: forall a. Index -> Index -> ArrayView a -> ArrayView a subArray s e a = runFn3 subArrayImpl a s e + foreign import subArrayImpl :: forall a. Fn3 (ArrayView a) Index Index (ArrayView a) -- | Prints array to a comma-separated string - see [MDN's spec](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray/toString) for details. toString :: forall a. ArrayView a -> Effect String toString a = runEffectFn1 toStringImpl a + foreign import toStringImpl :: forall a. EffectFn1 (ArrayView a) String -- | Prints array to a delimiter-separated string - see [MDN's spec](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/TypedArray/join) for details. join :: forall a. String -> ArrayView a -> Effect String join s a = runEffectFn2 joinImpl a s + foreign import joinImpl :: forall a. EffectFn2 (ArrayView a) String String -- | Determine if a certain index is valid. hasIndex :: forall a. ArrayView a -> Index -> Boolean hasIndex a o = runFn2 hasIndexImpl a o + foreign import hasIndexImpl :: forall a. Fn2 (ArrayView a) Index Boolean -- | Fetch element at index. at :: forall a t. TypedArray a t => ArrayView a -> Index -> Effect (Maybe t) at a n = toMaybe <$> runEffectFn2 unsafeAtImpl a n + foreign import unsafeAtImpl :: forall a b. EffectFn2 (ArrayView a) Index b infixl 3 at as ! @@ -391,6 +464,7 @@ infixl 3 at as ! -- | Turn typed array into an array. toArray :: forall a t. TypedArray a t => ArrayView a -> Effect (Array t) toArray a = runEffectFn1 toArrayImpl a + foreign import toArrayImpl :: forall a b. EffectFn1 (ArrayView a) (Array b) -- | Compare 2 typed arrays. diff --git a/src/Data/ArrayBuffer/Typed/Gen.purs b/src/Data/ArrayBuffer/Typed/Gen.purs index 380e28b..b2091ff 100644 --- a/src/Data/ArrayBuffer/Typed/Gen.purs +++ b/src/Data/ArrayBuffer/Typed/Gen.purs @@ -1,28 +1,25 @@ -- | Functions for generating typed arrays and values. - module Data.ArrayBuffer.Typed.Gen where -import Prelude ((<$>), bind, (/), (-), negate, ($), bottom, pure, top) import Control.Monad.Gen.Class (class MonadGen, sized, chooseInt, chooseFloat) import Data.ArrayBuffer.Typed (class TypedArray) import Data.ArrayBuffer.Typed as TA import Data.ArrayBuffer.Types (ArrayView) +import Data.ArrayBuffer.ValueMapping (class BytesPerType) import Data.Float32 (Float32, fromNumber') as F -import Data.Generic.Rep (class Generic) -import Data.Typelevel.Num (class Nat, toInt') import Data.UInt (UInt) import Data.UInt (fromInt) as UInt import Data.UInt.Gen (genUInt) as UInt import Data.Unfoldable (replicateA) import Effect.Unsafe (unsafePerformEffect) -import Type.Proxy (Proxy(..)) - +import Prelude (bind, bottom, negate, pure, top, ($), (-), (/), (<$>)) -genTypedArray :: forall m a t - . MonadGen m - => TypedArray a t - => m t - -> m (ArrayView a) +genTypedArray + :: forall m a t + . MonadGen m + => TypedArray a t + => m t + -> m (ArrayView a) genTypedArray gen = sized \s -> do n <- chooseInt 0 s a <- replicateA n gen @@ -50,20 +47,21 @@ genFloat32 :: forall m. MonadGen m => m F.Float32 genFloat32 = F.fromNumber' <$> chooseFloat (-3.40282347e+38) 3.40282347e+38 genFloat64 :: forall m. MonadGen m => m Number -genFloat64 = chooseFloat ((-1.7976931348623157e+308)/div) (1.7976931348623157e+308/div) - where div = 4.0 +genFloat64 = chooseFloat ((-1.7976931348623157e+308) / div) (1.7976931348623157e+308 / div) + where + div = 4.0 -- | For generating some set of offsets residing inside the generated array -data WithIndices n a = WithIndices (Array TA.Index) (ArrayView a) -derive instance genericWithIndices :: Generic (ArrayView a) a' => Generic (WithIndices n a) _ +data WithIndices a = WithIndices (Array TA.Index) (ArrayView a) -genWithIndices :: forall m n a - . MonadGen m - => Nat n - => m (ArrayView a) - -> m (WithIndices n a) -genWithIndices gen = do - let n = toInt' (Proxy :: Proxy n) +genWithIndices + :: forall m a + . MonadGen m + => BytesPerType a + => Int -- Number of offsets residing inside the generated array + -> m (ArrayView a) + -> m (WithIndices a) +genWithIndices n gen = do xs <- gen let l = TA.length xs os <- replicateA n (chooseInt 0 (l - 1)) diff --git a/src/Data/ArrayBuffer/Typed/Unsafe.purs b/src/Data/ArrayBuffer/Typed/Unsafe.purs deleted file mode 100644 index a536eee..0000000 --- a/src/Data/ArrayBuffer/Typed/Unsafe.purs +++ /dev/null @@ -1,41 +0,0 @@ -module Data.ArrayBuffer.Typed.Unsafe where - -import Data.ArrayBuffer.Typed (class TypedArray, toString) -import Data.ArrayBuffer.Typed as TA -import Data.ArrayBuffer.Types (ArrayView) -import Data.Maybe (Maybe(..)) -import Data.Generic.Rep (class Generic) -import Effect.Unsafe (unsafePerformEffect) -import Prelude (class Eq, class Monoid, class Ord, class Semigroup, class Show, bind, discard, pure, void, ($), (+), (<>), (<$>)) -import Test.QuickCheck (class Arbitrary, arbitrary) - -newtype AV a t = AV (ArrayView a) - -derive instance genericAV :: Generic (AV a t) _ - -instance ordArrayView :: (TypedArray a t, Ord t) => Ord (AV a t) where - compare (AV a) (AV b) = unsafePerformEffect $ TA.compare a b - -instance eqArrayView :: (TypedArray a t, Eq t) => Eq (AV a t) where - eq (AV a) (AV b) = unsafePerformEffect $ TA.eq a b - -instance showArrayView :: (TypedArray a t, Show t) => Show (AV a t) where - show (AV a) = "T[" <> s <> "]" - where s = unsafePerformEffect $ toString a - -instance semigroupArrayView :: TypedArray a t => Semigroup (AV a t) where - append (AV a) (AV b) = unsafePerformEffect do - let la = TA.length a - lb = TA.length b - r <- TA.empty $ la + lb - void $ TA.setTyped r (Just 0) a - void $ TA.setTyped r (Just la) b - pure $ AV r - -instance monoidArrayView :: TypedArray a t => Monoid (AV a t) where - mempty = AV $ unsafePerformEffect $ TA.empty 0 - -instance arbitraryArrayView :: (TypedArray a t, Arbitrary t) => Arbitrary (AV a t) where - arbitrary = do - xs <- arbitrary - pure $ unsafePerformEffect $ AV <$> TA.fromArray xs diff --git a/src/Data/ArrayBuffer/ValueMapping.purs b/src/Data/ArrayBuffer/ValueMapping.purs index 87bc256..8694a19 100644 --- a/src/Data/ArrayBuffer/ValueMapping.purs +++ b/src/Data/ArrayBuffer/ValueMapping.purs @@ -1,29 +1,51 @@ -- | This module represents type-level mappings between `ArrayViewType`s -- | and meaningful data. +module Data.ArrayBuffer.ValueMapping + ( class BytesPerType + , byteWidth + , class BinaryValue + , class ShowArrayViewType + ) where -module Data.ArrayBuffer.ValueMapping where - -import Data.ArrayBuffer.Types (kind ArrayViewType, Float64, Float32, Uint8Clamped, Uint32, Uint16, Uint8, Int32, Int16, Int8) -import Data.Typelevel.Num (D1, D2, D4, D8) -import Data.UInt (UInt) +import Data.ArrayBuffer.Types (ArrayViewType, Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8, Uint8Clamped) import Data.Float32 (Float32) as F +import Data.UInt (UInt) +import Type.Proxy (Proxy) + +-- | Type-level map of each `ArrayViewType` to the number of bytes of storage +-- | it requires. +class BytesPerType (a :: ArrayViewType) where + byteWidth :: (Proxy a) -> Int + +instance bytesPerTypeInt8 :: BytesPerType Int8 where + byteWidth _ = 1 + +instance bytesPerTypeInt16 :: BytesPerType Int16 where + byteWidth _ = 2 +instance bytesPerTypeInt32 :: BytesPerType Int32 where + byteWidth _ = 4 --- | Maps a `TypedArray`'s binary casted value, to the space occupied by that value, in bytes. -class BytesPerValue (a :: ArrayViewType) (b :: Type) | a -> b +instance bytesPerTypeUint8 :: BytesPerType Uint8 where + byteWidth _ = 1 -instance bytesPerValueUint8Clamped :: BytesPerValue Uint8Clamped D1 -instance bytesPerValueUint32 :: BytesPerValue Uint32 D4 -instance bytesPerValueUint16 :: BytesPerValue Uint16 D2 -instance bytesPerValueUint8 :: BytesPerValue Uint8 D1 -instance bytesPerValueInt32 :: BytesPerValue Int32 D4 -instance bytesPerValueInt16 :: BytesPerValue Int16 D2 -instance bytesPerValueInt8 :: BytesPerValue Int8 D1 -instance bytesPerValueFloat32 :: BytesPerValue Float32 D4 -instance bytesPerValueFloat64 :: BytesPerValue Float64 D8 +instance bytesPerTypeUint16 :: BytesPerType Uint16 where + byteWidth _ = 2 +instance bytesPerTypeUint32 :: BytesPerType Uint32 where + byteWidth _ = 4 --- | Maps a `TypedArray`'s binary casted value, to its computable representation in JavaScript. +instance bytesPerTypeUint8Clamped :: BytesPerType Uint8Clamped where + byteWidth _ = 1 + +instance bytesPerTypeFloat32 :: BytesPerType Float32 where + byteWidth _ = 4 + +instance bytesPerTypeFloat64 :: BytesPerType Float64 where + byteWidth _ = 8 + +-- | Type-level map of `TypedArray`’s binary casted value to its +-- | representation in JavaScript. class BinaryValue (a :: ArrayViewType) (t :: Type) | a -> t instance binaryValueUint8Clamped :: BinaryValue Uint8Clamped UInt @@ -36,9 +58,9 @@ instance binaryValueInt8 :: BinaryValue Int8 Int instance binaryValueFloat32 :: BinaryValue Float32 F.Float32 instance binaryValueFloat64 :: BinaryValue Float64 Number - - +-- | Type-level map of `TypedArray` to its element type name. class ShowArrayViewType (a :: ArrayViewType) (name :: Symbol) | a -> name + instance showArrayViewTypeUint8Clamped :: ShowArrayViewType Uint8Clamped "Uint8Clamped" instance showArrayViewTypeViewUint32 :: ShowArrayViewType Uint32 "Uint32" instance showArrayViewTypeViewUint16 :: ShowArrayViewType Uint16 "Uint16" diff --git a/test/Main.purs b/test/Main.purs index 40066b3..4ad0759 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -8,6 +8,5 @@ import Test.Properties (propertiesTests) main :: Effect Unit main = do - log "Starting tests..." propertiesTests diff --git a/test/Properties.purs b/test/Properties.purs index 6bf5407..bb529fc 100644 --- a/test/Properties.purs +++ b/test/Properties.purs @@ -8,7 +8,6 @@ import Test.Properties.DataView (dataViewTests) import Test.Properties.TypedArray (typedArrayTests) import Test.Properties.Typed.Laws (typedArrayLaws) - propertiesTests :: Effect Unit propertiesTests = do do diff --git a/test/Properties/ArrayBuffer.purs b/test/Properties/ArrayBuffer.purs index 3be4160..8ab6fe4 100644 --- a/test/Properties/ArrayBuffer.purs +++ b/test/Properties/ArrayBuffer.purs @@ -1,2 +1 @@ module Test.Properties.ArrayBuffer where - diff --git a/test/Properties/DataView.purs b/test/Properties/DataView.purs index 58cde67..e7199bf 100644 --- a/test/Properties/DataView.purs +++ b/test/Properties/DataView.purs @@ -1,6 +1,5 @@ module Test.Properties.DataView where - import Prelude import Data.Array.Partial (head) as Array @@ -8,22 +7,19 @@ import Data.ArrayBuffer.DataView as DV import Data.ArrayBuffer.DataView.Gen (genDataView, genWithOffsetAndValue, WithOffsetAndValue(..)) import Data.ArrayBuffer.Typed.Gen (genFloat32, genFloat64, genInt16, genInt32, genInt8, genUint16, genUint32, genUint8) import Data.ArrayBuffer.Types (Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8) -import Data.ArrayBuffer.ValueMapping (class BytesPerValue, class ShowArrayViewType, class BinaryValue) -import Data.Maybe (Maybe(..)) -import Data.Typelevel.Num (class Nat, D1, D2, D4, D8) -import Data.UInt (UInt) +import Data.ArrayBuffer.ValueMapping (class BinaryValue, class BytesPerType, class ShowArrayViewType) import Data.Float32 (Float32) as F --- import Data.Vec (head) as Vec +import Data.Maybe (Maybe(..)) import Data.Symbol (class IsSymbol) +import Data.UInt (UInt) import Effect (Effect) import Effect.Console (log) import Effect.Ref (Ref) import Effect.Ref as Ref import Effect.Unsafe (unsafePerformEffect) -import Test.QuickCheck (class Testable, quickCheckGen, Result, (===)) import Partial.Unsafe (unsafePartial) - - +import Test.QuickCheck (class Testable, quickCheckGen, Result, (===)) +import Type.Proxy (Proxy(..)) dataViewTests :: Ref Int -> Effect Unit dataViewTests count = do @@ -32,81 +28,100 @@ dataViewTests count = do log " - setLE x o => getLE o === Just x" placingAValueIsThereTests DV.LE count - -type TestableViewF a name b n t q = - Show t +type TestableViewF a name t q = + Show t => Eq t => Ord t => Semiring t - => BytesPerValue a b + => BytesPerType a => BinaryValue a t => ShowArrayViewType a name => IsSymbol name - => Nat b - => WithOffsetAndValue n a t + => WithOffsetAndValue a t -> q - -overAll :: forall q n. Testable q => Nat n => Ref Int -> (forall a name b t. TestableViewF a name b n t q) -> Effect Unit +overAll + :: forall q + . Testable q + => Ref Int + -> (forall a name t. TestableViewF a name t q) + -> Effect Unit overAll count f = do void (Ref.modify (_ + 1) count) log " - Uint32" - quickCheckGen $ - let f' :: TestableViewF Uint32 "Uint32" D4 n UInt q - f' = f - in f' <$> genWithOffsetAndValue genDataView genUint32 + quickCheckGen do + let + f' :: TestableViewF Uint32 "Uint32" UInt q + f' = f + + f' <$> genWithOffsetAndValue 4 genDataView genUint32 log " - Uint16" - quickCheckGen $ - let f' :: TestableViewF Uint16 "Uint16" D2 n UInt q - f' = f - in f' <$> genWithOffsetAndValue genDataView genUint16 + quickCheckGen do + let + f' :: TestableViewF Uint16 "Uint16" UInt q + f' = f + + f' <$> genWithOffsetAndValue 2 genDataView genUint16 log " - Uint8" - quickCheckGen $ - let f' :: TestableViewF Uint8 "Uint8" D1 n UInt q - f' = f - in f' <$> genWithOffsetAndValue genDataView genUint8 + quickCheckGen do + let + f' :: TestableViewF Uint8 "Uint8" UInt q + f' = f + + f' <$> genWithOffsetAndValue 1 genDataView genUint8 log " - Int32" - quickCheckGen $ - let f' :: TestableViewF Int32 "Int32" D4 n Int q - f' = f - in f' <$> genWithOffsetAndValue genDataView genInt32 + quickCheckGen do + let + f' :: TestableViewF Int32 "Int32" Int q + f' = f + + f' <$> genWithOffsetAndValue 4 genDataView genInt32 log " - Int16" - quickCheckGen $ - let f' :: TestableViewF Int16 "Int16" D2 n Int q - f' = f - in f' <$> genWithOffsetAndValue genDataView genInt16 + quickCheckGen do + let + f' :: TestableViewF Int16 "Int16" Int q + f' = f + + f' <$> genWithOffsetAndValue 2 genDataView genInt16 log " - Int8" - quickCheckGen $ - let f' :: TestableViewF Int8 "Int8" D1 n Int q - f' = f - in f' <$> genWithOffsetAndValue genDataView genInt8 + quickCheckGen do + let + f' :: TestableViewF Int8 "Int8" Int q + f' = f + + f' <$> genWithOffsetAndValue 1 genDataView genInt8 log " - Float32" - quickCheckGen $ - let f' :: TestableViewF Float32 "Float32" D4 n F.Float32 q - f' = f - in f' <$> genWithOffsetAndValue genDataView genFloat32 + quickCheckGen do + let + f' :: TestableViewF Float32 "Float32" F.Float32 q + f' = f + + f' <$> genWithOffsetAndValue 4 genDataView genFloat32 log " - Float64" - quickCheckGen $ - let f' :: TestableViewF Float64 "Float64" D8 n Number q - f' = f - in f' <$> genWithOffsetAndValue genDataView genFloat64 + quickCheckGen do + let + f' :: TestableViewF Float64 "Float64" Number q + f' = f + f' <$> genWithOffsetAndValue 8 genDataView genFloat64 placingAValueIsThereTests :: DV.Endian -> Ref Int -> Effect Unit placingAValueIsThereTests endian count = overAll count placingAValueIsThere where - placingAValueIsThere :: forall a name b t. TestableViewF a name b D1 t Result - placingAValueIsThere (WithOffsetAndValue os t xs) = - let o = unsafePartial $ Array.head os - prx = DV.AProxy :: DV.AProxy a - in unsafePerformEffect do - _ <- DV.set endian prx xs o t - my <- DV.get endian prx xs o - pure (my === Just t) + placingAValueIsThere :: forall a name t. TestableViewF a name t Result + placingAValueIsThere (WithOffsetAndValue os t xs) = do + let + o = unsafePartial $ Array.head os + prx = Proxy :: Proxy a + + unsafePerformEffect do + _ <- DV.set endian prx xs o t + my <- DV.get endian prx xs o + pure (my === Just t) diff --git a/test/Properties/Typed/Laws.purs b/test/Properties/Typed/Laws.purs index 8a6f02b..21ac0dd 100644 --- a/test/Properties/Typed/Laws.purs +++ b/test/Properties/Typed/Laws.purs @@ -1,19 +1,22 @@ module Test.Properties.Typed.Laws where -import Data.ArrayBuffer.Typed (class TypedArray) +import Prelude +import Data.ArrayBuffer.Typed (class TypedArray, toString) import Data.ArrayBuffer.Typed.Gen (genFloat32, genFloat64, genInt16, genInt32, genInt8, genTypedArray, genUint16, genUint32, genUint8) -import Data.ArrayBuffer.Typed.Unsafe (AV(..)) -import Data.ArrayBuffer.Types (ArrayView, Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8, Uint8Clamped, kind ArrayViewType) +import Data.ArrayBuffer.Types (ArrayView, Float32, Float64, Int16, Int32, Int8, Uint16, Uint32, Uint8, Uint8Clamped, ArrayViewType) import Data.Float32 as F import Data.UInt (UInt) import Effect (Effect) import Effect.Ref (Ref) import Effect.Ref as Ref -import Prelude (class Eq, class Monoid, class Ord, class Semigroup, Unit, discard, void, ($), (+), (<$>), (<<<)) -import Test.QuickCheck (class Arbitrary) +import Test.QuickCheck (class Arbitrary, arbitrary) import Test.QuickCheck.Gen (Gen) import Test.QuickCheck.Laws.Data (checkEq, checkMonoid, checkOrd, checkSemigroup) -import Type.Prelude (Proxy(..)) +import Type.Proxy (Proxy(..)) +import Data.ArrayBuffer.Typed as TA +import Data.Generic.Rep (class Generic) +import Data.Maybe (Maybe(..)) +import Effect.Unsafe (unsafePerformEffect) newtype A a = A a @@ -24,20 +27,28 @@ class ArrayEl (a :: ArrayViewType) (t :: Type) where instance arrayElUint8Clamped :: ArrayEl Uint8Clamped UInt where arb _ = genUint8 + instance arrayElUint32 :: ArrayEl Uint32 UInt where arb _ = genUint32 + instance arrayElUint16 :: ArrayEl Uint16 UInt where arb _ = genUint16 + instance arrayElUint8 :: ArrayEl Uint8 UInt where arb _ = genUint8 + instance arrayElInt32 :: ArrayEl Int32 Int where arb _ = genInt32 + instance arrayElInt16 :: ArrayEl Int16 Int where arb _ = genInt16 + instance arrayElInt8 :: ArrayEl Int8 Int where arb _ = genInt8 + instance arrayElFloat32 :: ArrayEl Float32 F.Float32 where arb _ = genFloat32 + instance arrayElFloat64 :: ArrayEl Float64 Number where arb _ = genFloat64 @@ -102,3 +113,37 @@ typedArrayLaws count = do f (Proxy :: Proxy (A (AV Uint32 UInt))) f (Proxy :: Proxy (A (AV Uint8 UInt))) f (Proxy :: Proxy (A (AV Uint8Clamped UInt))) + +newtype AV :: forall k. ArrayViewType -> k -> Type +newtype AV a t = AV (ArrayView a) + +derive instance genericAV :: Generic (AV a t) _ + +instance ordArrayView :: (TypedArray a t, Ord t) => Ord (AV a t) where + compare (AV a) (AV b) = unsafePerformEffect $ TA.compare a b + +instance eqArrayView :: (TypedArray a t, Eq t) => Eq (AV a t) where + eq (AV a) (AV b) = unsafePerformEffect $ TA.eq a b + +instance showArrayView :: (TypedArray a t, Show t) => Show (AV a t) where + show (AV a) = "T[" <> s <> "]" + where + s = unsafePerformEffect $ toString a + +instance semigroupArrayView :: TypedArray a t => Semigroup (AV a t) where + append (AV a) (AV b) = unsafePerformEffect do + let + la = TA.length a + lb = TA.length b + r <- TA.empty $ la + lb + void $ TA.setTyped r (Just 0) a + void $ TA.setTyped r (Just la) b + pure $ AV r + +instance monoidArrayView :: TypedArray a t => Monoid (AV a t) where + mempty = AV $ unsafePerformEffect $ TA.empty 0 + +instance arbitraryArrayView :: (TypedArray a t, Arbitrary t) => Arbitrary (AV a t) where + arbitrary = do + xs <- arbitrary + pure $ unsafePerformEffect $ AV <$> TA.fromArray xs diff --git a/test/Properties/TypedArray.purs b/test/Properties/TypedArray.purs index 449f1a1..36dfc8c 100644 --- a/test/Properties/TypedArray.purs +++ b/test/Properties/TypedArray.purs @@ -1,6 +1,5 @@ module Test.Properties.TypedArray where - import Prelude import Control.Monad.Gen (suchThat) @@ -9,12 +8,11 @@ import Data.Array.Partial (head) as Array import Data.ArrayBuffer.Typed (class TypedArray) import Data.ArrayBuffer.Typed as TA import Data.ArrayBuffer.Typed.Gen (WithIndices(..), genFloat32, genFloat64, genInt16, genInt32, genInt8, genTypedArray, genUint16, genUint32, genUint8, genWithIndices) -import Data.ArrayBuffer.Types (ArrayView, Float32Array, Float64Array, Int16Array, Int32Array, Int8Array, Uint16Array, Uint8Array, Uint8ClampedArray, Uint32Array) -import Data.ArrayBuffer.ValueMapping (class BytesPerValue) +import Data.ArrayBuffer.Types (ArrayView, Float32Array, Float64Array, Int16Array, Int32Array, Int8Array, Uint16Array, Uint32Array, Uint8Array, Uint8ClampedArray) +import Data.ArrayBuffer.ValueMapping (class BytesPerType, byteWidth) import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Traversable (traverse) -import Data.Typelevel.Num (class Nat, D0, D1, D2, D5, toInt') --- import Data.Vec (head, index) as Vec +import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Console (log) import Effect.Ref (Ref) @@ -22,11 +20,9 @@ import Effect.Ref as Ref import Effect.Unsafe (unsafePerformEffect) import Partial.Unsafe (unsafePartial) import Test.QuickCheck (class Testable, Result(..), quickCheckGen, (/==), (), (===)) -import Test.QuickCheck.Combinators ((==>), (|=|)) import Test.QuickCheck.Gen (Gen) import Type.Proxy (Proxy(..)) - typedArrayTests :: Ref Int -> Effect Unit typedArrayTests count = do log " - subarrayBehavesLikeArraySlice" @@ -110,594 +106,617 @@ typedArrayTests count = do log " - copyWithin o x == setTyped x (slice o x)" copyWithinViaSetTypedTests count - - -type TestableArrayF a b n t q = - Show t +type TestableArrayF a t q = + Show t => Eq t => Ord t => Semiring t => TypedArray a t - => BytesPerValue a b - => Nat b - => WithIndices n a + => BytesPerType a + => WithIndices a -> Effect q - -overAll' :: forall q n. Testable q => Nat n => Int -> Ref Int -> (forall a b t. TestableArrayF a b n t q) -> Effect Unit -overAll' mn count f = do +overAll' + :: forall q + . Testable q + => Int -- n + -> Int -- “minimum n”? + -> Ref Int + -> (forall a t. TestableArrayF a t q) + -> Effect Unit +overAll' n mn count f = do void (Ref.modify (_ + 1) count) - let chk :: forall a b t. Show t => Eq t => Ord t => Semiring t => Nat b => BytesPerValue a b => TypedArray a t => String -> Proxy (ArrayView a) -> Gen t -> Effect Unit - chk s _ gen = do - log $ " - " <> s - quickCheckGen $ unsafePerformEffect <<< f <$> genWithIndices arr - where arr :: Gen (ArrayView a) - arr = genTypedArray gen `suchThat` \xs -> mn <= TA.length xs - - chk "Uint8ClampedArray" (Proxy :: Proxy Uint8ClampedArray) genUint8 - chk "Uint32Array" (Proxy :: Proxy Uint32Array) genUint32 - chk "Uint16Array" (Proxy :: Proxy Uint16Array) genUint16 - chk "Uint8Array" (Proxy :: Proxy Uint8Array) genUint8 - chk "Int32Array" (Proxy :: Proxy Int32Array) genInt32 - chk "Int16Array" (Proxy :: Proxy Int16Array) genInt16 - chk "Int8Array" (Proxy :: Proxy Int8Array) genInt8 - chk "Float32Array" (Proxy :: Proxy Float32Array) genFloat32 - chk "Float64Array" (Proxy :: Proxy Float64Array) genFloat64 - - -overAll :: forall q n. Testable q => Nat n => Ref Int -> (forall a b t. TestableArrayF a b n t q) -> Effect Unit -overAll count f = overAll' 0 count f - -overAll1 :: forall q n. Testable q => Nat n => Ref Int -> (forall a b t. TestableArrayF a b n t q) -> Effect Unit -overAll1 count f = overAll' 1 count f + let + chk + :: forall a t + . Show t + => Eq t + => Ord t + => Semiring t + => BytesPerType a + => TypedArray a t + => String + -> Int + -> Proxy (ArrayView a) + -> Gen t + -> Effect Unit + chk s n' _ gen = do + log $ " - " <> s + quickCheckGen $ unsafePerformEffect <<< f <$> genWithIndices n' arr + where + arr :: Gen (ArrayView a) + arr = genTypedArray gen `suchThat` \xs -> mn <= TA.length xs + + chk "Uint8ClampedArray" n (Proxy :: Proxy Uint8ClampedArray) genUint8 + chk "Uint32Array" n (Proxy :: Proxy Uint32Array) genUint32 + chk "Uint16Array" n (Proxy :: Proxy Uint16Array) genUint16 + chk "Uint8Array" n (Proxy :: Proxy Uint8Array) genUint8 + chk "Int32Array" n (Proxy :: Proxy Int32Array) genInt32 + chk "Int16Array" n (Proxy :: Proxy Int16Array) genInt16 + chk "Int8Array" n (Proxy :: Proxy Int8Array) genInt8 + chk "Float32Array" n (Proxy :: Proxy Float32Array) genFloat32 + chk "Float64Array" n (Proxy :: Proxy Float64Array) genFloat64 + +overAll + :: forall q + . Testable q + => Int + -> Ref Int + -> (forall a t. TestableArrayF a t q) + -> Effect Unit +overAll n count f = overAll' n 0 count f + +overAll1 + :: forall q + . Testable q + => Int + -> Ref Int + -> (forall a t. TestableArrayF a t q) + -> Effect Unit +overAll1 n count f = overAll' n 1 count f subarrayBehavesLikeArraySliceTests :: Ref Int -> Effect Unit -subarrayBehavesLikeArraySliceTests count = overAll count f - where - f :: forall a b t. TestableArrayF a b D2 t Result - f (WithIndices os xs) = do - let s = unsafePartial $ os `Array.unsafeIndex` 0 - e = unsafePartial $ os `Array.unsafeIndex` 1 - axs <- TA.toArray xs - let sxs = TA.subArray s e xs - a <- TA.toArray sxs - pure $ Array.slice s e axs === a +subarrayBehavesLikeArraySliceTests count = overAll 2 count f + where + f :: forall a t. TestableArrayF a t Result + f (WithIndices os xs) = do + let + s = unsafePartial $ os `Array.unsafeIndex` 0 + e = unsafePartial $ os `Array.unsafeIndex` 1 + axs <- TA.toArray xs + let sxs = TA.subArray s e xs + a <- TA.toArray sxs + pure $ Array.slice s e axs === a sliceBehavesLikeArraySliceTests :: Ref Int -> Effect Unit -sliceBehavesLikeArraySliceTests count = overAll count f - where - f :: forall a b t. TestableArrayF a b D2 t Result - f (WithIndices os xs) = do - let s = unsafePartial $ os `Array.unsafeIndex` 0 - e = unsafePartial $ os `Array.unsafeIndex` 1 - axs <- TA.toArray xs - sxs <- TA.slice s e xs - a <- TA.toArray sxs - pure $ Array.slice s e axs === a +sliceBehavesLikeArraySliceTests count = overAll 2 count f + where + f :: forall a t. TestableArrayF a t Result + f (WithIndices os xs) = do + let + s = unsafePartial $ os `Array.unsafeIndex` 0 + e = unsafePartial $ os `Array.unsafeIndex` 1 + axs <- TA.toArray xs + sxs <- TA.slice s e xs + a <- TA.toArray sxs + pure $ Array.slice s e axs === a partBehavesLikeTakeDropTests :: Ref Int -> Effect Unit -partBehavesLikeTakeDropTests count = overAll count f +partBehavesLikeTakeDropTests count = overAll 0 count f where - f :: forall a b t. TestableArrayF a b D0 t Result - f (WithIndices _ xs) = do - let n = 2 - axs <- TA.toArray xs - pxs <- TA.part (TA.buffer xs) n n :: Effect (ArrayView a) - aps <- TA.toArray pxs - pure $ Array.take n (Array.drop n axs) === aps + f :: forall a t. TestableArrayF a t Result + f (WithIndices _ xs) = do + let n = 2 + axs <- TA.toArray xs + pxs <- TA.part (TA.buffer xs) n n :: Effect (ArrayView a) + aps <- TA.toArray pxs + pure $ Array.take n (Array.drop n axs) === aps byteLengthDivBytesPerValueTests :: Ref Int -> Effect Unit -byteLengthDivBytesPerValueTests count = overAll count byteLengthDivBytesPerValueEqLength +byteLengthDivBytesPerValueTests count = overAll 0 count byteLengthDivBytesPerValueEqLength where - byteLengthDivBytesPerValueEqLength :: forall a b t. TestableArrayF a b D0 t Result - byteLengthDivBytesPerValueEqLength (WithIndices _ a) = - let b = toInt' (Proxy :: Proxy b) - in pure $ TA.length a === (TA.byteLength a `div` b) + byteLengthDivBytesPerValueEqLength :: forall a t. TestableArrayF a t Result + byteLengthDivBytesPerValueEqLength (WithIndices _ xs) = do + let b = byteWidth (Proxy :: Proxy a) + pure $ TA.length xs === (TA.byteLength xs `div` b) fromArrayToArrayIsoTests :: Ref Int -> Effect Unit -fromArrayToArrayIsoTests count = overAll count fromArrayToArrayIso +fromArrayToArrayIsoTests count = overAll 0 count fromArrayToArrayIso where - fromArrayToArrayIso :: forall a b t. TestableArrayF a b D0 t Result - fromArrayToArrayIso (WithIndices _ xs) = do - axs <- TA.toArray xs - xs' <- TA.fromArray axs :: Effect (ArrayView a) - axs' <- TA.toArray xs' - pure $ axs' === axs - + fromArrayToArrayIso :: forall a t. TestableArrayF a t Result + fromArrayToArrayIso (WithIndices _ xs) = do + axs <- TA.toArray xs + xs' <- TA.fromArray axs :: Effect (ArrayView a) + axs' <- TA.toArray xs' + pure $ axs' === axs allAreFilledTests :: Ref Int -> Effect Unit -allAreFilledTests count = overAll count allAreFilled - where - allAreFilled :: forall a b t. TestableArrayF a b D0 t Result - allAreFilled (WithIndices _ xs) = do - e <- TA.at xs 0 - let x = fromMaybe zero e - l = TA.length xs - TA.fill x 0 l xs - b <- TA.all (_ == x) xs - pure (b "All aren't the filled value") - +allAreFilledTests count = overAll 0 count allAreFilled + where + allAreFilled :: forall a t. TestableArrayF a t Result + allAreFilled (WithIndices _ xs) = do + e <- TA.at xs 0 + let + x = fromMaybe zero e + l = TA.length xs + TA.fill x 0 l xs + b <- TA.all (_ == x) xs + pure (b "All aren't the filled value") setSingletonIsEqTests :: Ref Int -> Effect Unit -setSingletonIsEqTests count = overAll count setSingletonIsEq - where - setSingletonIsEq :: forall a b t. TestableArrayF a b D1 t Result - setSingletonIsEq (WithIndices os xs) = do - e <- TA.at xs 0 - case e of - Nothing -> pure Success - Just x -> do - let o = unsafePartial $ Array.head os - _ <- TA.set xs (Just o) [x] - e' <- TA.at xs o - pure $ e' === Just x - +setSingletonIsEqTests count = overAll 1 count setSingletonIsEq + where + setSingletonIsEq :: forall a t. TestableArrayF a t Result + setSingletonIsEq (WithIndices os xs) = do + e <- TA.at xs 0 + case e of + Nothing -> pure Success + Just x -> do + let o = unsafePartial $ Array.head os + _ <- TA.set xs (Just o) [ x ] + e' <- TA.at xs o + pure $ e' === Just x -- | Should work with any arbitrary predicate, but we can't generate them allImpliesAnyTests :: Ref Int -> Effect Unit -allImpliesAnyTests count = overAll count allImpliesAny +allImpliesAnyTests count = overAll 0 count allImpliesAny where - allImpliesAny :: forall a b t. TestableArrayF a b D0 t Result - allImpliesAny (WithIndices _ xs) = do - let pred x = x /= zero - all'' <- TA.all pred xs - let all' = all'' "All don't satisfy the predicate" - any'' <- TA.any pred xs - let any' = any'' "None satisfy the predicate" - pure $ (TA.length xs === zero) |=| all' ==> any' - + allImpliesAny :: forall a t. TestableArrayF a t Result + allImpliesAny (WithIndices _ xs) = do + let pred x = x /= zero + all'' <- TA.all pred xs + let all' = all'' "All don't satisfy the predicate" + any'' <- TA.any pred xs + let any' = any'' "None satisfy the predicate" + pure $ (TA.length xs === zero) `xor` all' `implies` any' -- | Should work with any arbitrary predicate, but we can't generate them filterImpliesAllTests :: Ref Int -> Effect Unit -filterImpliesAllTests count = overAll count filterImpliesAll +filterImpliesAllTests count = overAll 0 count filterImpliesAll where - filterImpliesAll :: forall a b t. TestableArrayF a b D0 t Result - filterImpliesAll (WithIndices _ xs) = do - let pred x = x /= zero - ys <- TA.filter pred xs - all' <- TA.all pred ys - pure $ all' "Filter doesn't imply all" - + filterImpliesAll :: forall a t. TestableArrayF a t Result + filterImpliesAll (WithIndices _ xs) = do + let pred x = x /= zero + ys <- TA.filter pred xs + all' <- TA.all pred ys + pure $ all' "Filter doesn't imply all" -- | Should work with any arbitrary predicate, but we can't generate them filterIsTotalTests :: Ref Int -> Effect Unit -filterIsTotalTests count = overAll count filterIsTotal +filterIsTotalTests count = overAll 0 count filterIsTotal where - filterIsTotal :: forall a b t. TestableArrayF a b D0 t Result - filterIsTotal (WithIndices _ xs) = do - let pred x = x /= zero - ys <- TA.filter pred xs - zs <- TA.filter (not pred) ys - azs <- TA.toArray zs - pure $ azs === [] - + filterIsTotal :: forall a t. TestableArrayF a t Result + filterIsTotal (WithIndices _ xs) = do + let pred x = x /= zero + ys <- TA.filter pred xs + zs <- TA.filter (not pred) ys + azs <- TA.toArray zs + pure $ azs === [] -- | Should work with any arbitrary predicate, but we can't generate them filterIsIdempotentTests :: Ref Int -> Effect Unit -filterIsIdempotentTests count = overAll count filterIsIdempotent +filterIsIdempotentTests count = overAll 0 count filterIsIdempotent where - filterIsIdempotent :: forall a b t. TestableArrayF a b D0 t Result - filterIsIdempotent (WithIndices _ xs) = do - let pred x = x /= zero - ys <- TA.filter pred xs - zs <- TA.filter pred ys - azs <- TA.toArray zs - ays <- TA.toArray ys - pure $ azs === ays - + filterIsIdempotent :: forall a t. TestableArrayF a t Result + filterIsIdempotent (WithIndices _ xs) = do + let pred x = x /= zero + ys <- TA.filter pred xs + zs <- TA.filter pred ys + azs <- TA.toArray zs + ays <- TA.toArray ys + pure $ azs === ays withIndicesHasIndexTests :: Ref Int -> Effect Unit -withIndicesHasIndexTests count = overAll1 count withIndicesHasIndex +withIndicesHasIndexTests count = overAll1 5 count withIndicesHasIndex where - withIndicesHasIndex :: forall a b t. TestableArrayF a b D5 t Result - withIndicesHasIndex (WithIndices os xs) = pure $ - Array.all (TA.hasIndex xs) os "All doesn't have index of itself" - + withIndicesHasIndex :: forall a t. TestableArrayF a t Result + withIndicesHasIndex (WithIndices os xs) = pure $ + Array.all (TA.hasIndex xs) os "All doesn't have index of itself" withIndicesElemTests :: Ref Int -> Effect Unit -withIndicesElemTests count = overAll1 count withIndicesElem +withIndicesElemTests count = overAll1 5 count withIndicesElem where - withIndicesElem :: forall a b t. TestableArrayF a b D5 t Result - withIndicesElem (WithIndices os xs) = do - let fetch o = TA.at xs o - exs <- traverse fetch os - pure $ Array.all isJust exs "All doesn't have an elem of itself" - + withIndicesElem :: forall a t. TestableArrayF a t Result + withIndicesElem (WithIndices os xs) = do + let fetch o = TA.at xs o + exs <- traverse fetch os + pure $ Array.all isJust exs "All doesn't have an elem of itself" -- | Should work with any arbitrary predicate, but we can't generate them anyImpliesFindTests :: Ref Int -> Effect Unit -anyImpliesFindTests count = overAll count anyImpliesFind - where - anyImpliesFind :: forall a b t. TestableArrayF a b D0 t Result - anyImpliesFind (WithIndices _ xs) = do - let pred x = x /= zero - a <- TA.any pred xs - let p = a "All don't satisfy the predicate" - idx <- TA.find pred xs - let q = case idx of - Nothing -> Failed "Doesn't have a value satisfying the predicate" - Just z -> if pred z - then Success - else Failed "Found value doesn't satisfy the predicate" - pure $ p ==> q - +anyImpliesFindTests count = overAll 0 count anyImpliesFind + where + anyImpliesFind :: forall a t. TestableArrayF a t Result + anyImpliesFind (WithIndices _ xs) = do + let pred x = x /= zero + a <- TA.any pred xs + let p = a "All don't satisfy the predicate" + idx <- TA.find pred xs + let + q = case idx of + Nothing -> Failed "Doesn't have a value satisfying the predicate" + Just z -> + if pred z then Success + else Failed "Found value doesn't satisfy the predicate" + pure $ p `implies` q -- | Should work with any arbitrary predicate, but we can't generate them findIndexImpliesAtTests :: Ref Int -> Effect Unit -findIndexImpliesAtTests count = overAll count findIndexImpliesAt - where - findIndexImpliesAt :: forall a b t. TestableArrayF a b D0 t Result - findIndexImpliesAt (WithIndices _ xs) = do - let pred x _ = x /= zero - mo <- TA.findIndex pred xs - case mo of - Nothing -> pure Success - Just o -> do - e <- TA.at xs o - case e of - Nothing -> pure $ Failed "No value at found index" - Just x -> pure $ pred x o "Find index implies at" - - +findIndexImpliesAtTests count = overAll 0 count findIndexImpliesAt + where + findIndexImpliesAt :: forall a t. TestableArrayF a t Result + findIndexImpliesAt (WithIndices _ xs) = do + let pred x _ = x /= zero + mo <- TA.findIndex pred xs + case mo of + Nothing -> pure Success + Just o -> do + e <- TA.at xs o + case e of + Nothing -> pure $ Failed "No value at found index" + Just x -> pure $ pred x o "Find index implies at" indexOfImpliesAtTests :: Ref Int -> Effect Unit -indexOfImpliesAtTests count = overAll count indexOfImpliesAt - where - indexOfImpliesAt :: forall a b t. TestableArrayF a b D1 t Result - indexOfImpliesAt (WithIndices _ xs) = do - e <- TA.at xs 0 - case e of - Nothing -> pure Success - Just y -> do - idx <- TA.indexOf y Nothing xs - case idx of - Nothing -> pure $ Failed "no index of" - Just o -> do - e' <- TA.at xs o - pure $ e' === Just y - +indexOfImpliesAtTests count = overAll 1 count indexOfImpliesAt + where + indexOfImpliesAt :: forall a t. TestableArrayF a t Result + indexOfImpliesAt (WithIndices _ xs) = do + e <- TA.at xs 0 + case e of + Nothing -> pure Success + Just y -> do + idx <- TA.indexOf y Nothing xs + case idx of + Nothing -> pure $ Failed "no index of" + Just o -> do + e' <- TA.at xs o + pure $ e' === Just y lastIndexOfImpliesAtTests :: Ref Int -> Effect Unit -lastIndexOfImpliesAtTests count = overAll count lastIndexOfImpliesAt - where - lastIndexOfImpliesAt :: forall a b t. TestableArrayF a b D0 t Result - lastIndexOfImpliesAt (WithIndices _ xs) = do - e <- TA.at xs 0 - case e of - Nothing -> pure Success - Just y -> do - idx <- TA.lastIndexOf y Nothing xs - case idx of - Nothing -> pure $ Failed "no lastIndex of" - Just o -> do - e' <- TA.at xs o - pure $ e' === Just y - +lastIndexOfImpliesAtTests count = overAll 0 count lastIndexOfImpliesAt + where + lastIndexOfImpliesAt :: forall a t. TestableArrayF a t Result + lastIndexOfImpliesAt (WithIndices _ xs) = do + e <- TA.at xs 0 + case e of + Nothing -> pure Success + Just y -> do + idx <- TA.lastIndexOf y Nothing xs + case idx of + Nothing -> pure $ Failed "no lastIndex of" + Just o -> do + e' <- TA.at xs o + pure $ e' === Just y foldrConsIsToArrayTests :: Ref Int -> Effect Unit -foldrConsIsToArrayTests count = overAll count foldrConsIsToArray +foldrConsIsToArrayTests count = overAll 0 count foldrConsIsToArray where - foldrConsIsToArray :: forall a b t. TestableArrayF a b D0 t Result - foldrConsIsToArray (WithIndices _ xs) = do - axs <- TA.toArray xs - rxs <- TA.foldr Array.cons [] xs - pure $ rxs === axs - + foldrConsIsToArray :: forall a t. TestableArrayF a t Result + foldrConsIsToArray (WithIndices _ xs) = do + axs <- TA.toArray xs + rxs <- TA.foldr Array.cons [] xs + pure $ rxs === axs foldlSnocIsToArrayTests :: Ref Int -> Effect Unit -foldlSnocIsToArrayTests count = overAll count foldlSnocIsToArray +foldlSnocIsToArrayTests count = overAll 0 count foldlSnocIsToArray where - foldlSnocIsToArray :: forall a b t. TestableArrayF a b D0 t Result - foldlSnocIsToArray (WithIndices _ xs) = do - axs <- TA.toArray xs - rxs <- TA.foldl Array.snoc [] xs - pure $ rxs === axs - + foldlSnocIsToArray :: forall a t. TestableArrayF a t Result + foldlSnocIsToArray (WithIndices _ xs) = do + axs <- TA.toArray xs + rxs <- TA.foldl Array.snoc [] xs + pure $ rxs === axs mapIdentityIsIdentityTests :: Ref Int -> Effect Unit -mapIdentityIsIdentityTests count = overAll count mapIdentityIsIdentity +mapIdentityIsIdentityTests count = overAll 0 count mapIdentityIsIdentity where - mapIdentityIsIdentity :: forall a b t. TestableArrayF a b D0 t Result - mapIdentityIsIdentity (WithIndices _ xs) = do - axs <- TA.toArray xs - mxs <- TA.toArray (TA.map identity xs) - pure $ axs === mxs - + mapIdentityIsIdentity :: forall a t. TestableArrayF a t Result + mapIdentityIsIdentity (WithIndices _ xs) = do + axs <- TA.toArray xs + mxs <- TA.toArray (TA.map identity xs) + pure $ axs === mxs traverseSnocIsToArrayTests :: Ref Int -> Effect Unit -traverseSnocIsToArrayTests count = overAll count traverseSnocIsToArray +traverseSnocIsToArrayTests count = overAll 0 count traverseSnocIsToArray where - traverseSnocIsToArray :: forall a b t. TestableArrayF a b D0 t Result - traverseSnocIsToArray (WithIndices _ xs) = do - ref <- Ref.new [] - TA.traverse_ (\x -> void (Ref.modify (\xs' -> Array.snoc xs' x) ref)) xs - ys <- Ref.read ref - axs <- TA.toArray xs - pure $ axs === ys - + traverseSnocIsToArray :: forall a t. TestableArrayF a t Result + traverseSnocIsToArray (WithIndices _ xs) = do + ref <- Ref.new [] + TA.traverse_ (\x -> void (Ref.modify (\xs' -> Array.snoc xs' x) ref)) xs + ys <- Ref.read ref + axs <- TA.toArray xs + pure $ axs === ys doubleReverseIsIdentityTests :: Ref Int -> Effect Unit -doubleReverseIsIdentityTests count = overAll count doubleReverseIsIdentity +doubleReverseIsIdentityTests count = overAll 0 count doubleReverseIsIdentity where - doubleReverseIsIdentity :: forall a b t. TestableArrayF a b D0 t Result - doubleReverseIsIdentity (WithIndices _ xs) = do - axs <- TA.toArray xs - TA.reverse xs - TA.reverse xs - axs' <- TA.toArray xs - pure $ axs === axs' - + doubleReverseIsIdentity :: forall a t. TestableArrayF a t Result + doubleReverseIsIdentity (WithIndices _ xs) = do + axs <- TA.toArray xs + TA.reverse xs + TA.reverse xs + axs' <- TA.toArray xs + pure $ axs === axs' reverseIsArrayReverseTests :: Ref Int -> Effect Unit -reverseIsArrayReverseTests count = overAll count reverseIsArrayReverse +reverseIsArrayReverseTests count = overAll 0 count reverseIsArrayReverse where - reverseIsArrayReverse :: forall a b t. TestableArrayF a b D0 t Result - reverseIsArrayReverse (WithIndices _ xs) = do - axs <- TA.toArray xs - TA.reverse xs - rxs <- TA.toArray xs - pure $ Array.reverse axs === rxs - + reverseIsArrayReverse :: forall a t. TestableArrayF a t Result + reverseIsArrayReverse (WithIndices _ xs) = do + axs <- TA.toArray xs + TA.reverse xs + rxs <- TA.toArray xs + pure $ Array.reverse axs === rxs sortIsIdempotentTests :: Ref Int -> Effect Unit -sortIsIdempotentTests count = overAll count sortIsIdempotent +sortIsIdempotentTests count = overAll 0 count sortIsIdempotent where - sortIsIdempotent :: forall a b t. TestableArrayF a b D0 t Result - sortIsIdempotent (WithIndices _ xs) = do - TA.sort xs - ys <- TA.toArray xs - TA.sort xs - zs <- TA.toArray xs - pure $ zs === ys - + sortIsIdempotent :: forall a t. TestableArrayF a t Result + sortIsIdempotent (WithIndices _ xs) = do + TA.sort xs + ys <- TA.toArray xs + TA.sort xs + zs <- TA.toArray xs + pure $ zs === ys sortIsArraySortTests :: Ref Int -> Effect Unit -sortIsArraySortTests count = overAll count sortIsArraySort +sortIsArraySortTests count = overAll 0 count sortIsArraySort where - sortIsArraySort :: forall a b t. TestableArrayF a b D0 t Result - sortIsArraySort (WithIndices _ xs) = do - axs <- TA.toArray xs - let ys = Array.sort axs - TA.sort xs - sxs <- TA.toArray xs - pure $ sxs === ys - + sortIsArraySort :: forall a t. TestableArrayF a t Result + sortIsArraySort (WithIndices _ xs) = do + axs <- TA.toArray xs + let ys = Array.sort axs + TA.sort xs + sxs <- TA.toArray xs + pure $ sxs === ys toStringIsJoinWithCommaTests :: Ref Int -> Effect Unit -toStringIsJoinWithCommaTests count = overAll count toStringIsJoinWithComma +toStringIsJoinWithCommaTests count = overAll 0 count toStringIsJoinWithComma where - toStringIsJoinWithComma :: forall a b t. TestableArrayF a b D0 t Result - toStringIsJoinWithComma (WithIndices _ xs) = do - s1 <- TA.join "," xs - s2 <- TA.toString xs - pure $ s1 === s2 - + toStringIsJoinWithComma :: forall a t. TestableArrayF a t Result + toStringIsJoinWithComma (WithIndices _ xs) = do + s1 <- TA.join "," xs + s2 <- TA.toString xs + pure $ s1 === s2 setTypedOfSubArrayIsIdentityTests :: Ref Int -> Effect Unit -setTypedOfSubArrayIsIdentityTests count = overAll count setTypedOfSubArrayIsIdentity - where - setTypedOfSubArrayIsIdentity :: forall a b t. TestableArrayF a b D0 t Result - setTypedOfSubArrayIsIdentity (WithIndices _ xs) = do - ys <- TA.toArray xs - let l = TA.length xs - zsSub = TA.subArray 0 l xs - _ <- TA.setTyped xs Nothing zsSub - zs <- TA.toArray xs - pure $ zs === ys - +setTypedOfSubArrayIsIdentityTests count = overAll 0 count setTypedOfSubArrayIsIdentity + where + setTypedOfSubArrayIsIdentity :: forall a t. TestableArrayF a t Result + setTypedOfSubArrayIsIdentity (WithIndices _ xs) = do + ys <- TA.toArray xs + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + _ <- TA.setTyped xs Nothing zsSub + zs <- TA.toArray xs + pure $ zs === ys modifyingOriginalMutatesSubArrayTests :: Ref Int -> Effect Unit -modifyingOriginalMutatesSubArrayTests count = overAll count modifyingOriginalMutatesSubArray - where - modifyingOriginalMutatesSubArray :: forall a b t. TestableArrayF a b D0 t Result - modifyingOriginalMutatesSubArray (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray zsSub - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs /== ys - +modifyingOriginalMutatesSubArrayTests count = overAll 0 count modifyingOriginalMutatesSubArray + where + modifyingOriginalMutatesSubArray :: forall a t. TestableArrayF a t Result + modifyingOriginalMutatesSubArray (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray zsSub + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs /== ys modifyingSubArrayMutatesOriginalTests :: Ref Int -> Effect Unit -modifyingSubArrayMutatesOriginalTests count = overAll count modifyingOriginalMutatesSubArray - where - modifyingOriginalMutatesSubArray :: forall a b t. TestableArrayF a b D0 t Result - modifyingOriginalMutatesSubArray (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray xs - TA.fill zero 0 l zsSub - ys <- TA.toArray xs - pure $ zs /== ys - +modifyingSubArrayMutatesOriginalTests count = overAll 0 count modifyingOriginalMutatesSubArray + where + modifyingOriginalMutatesSubArray :: forall a t. TestableArrayF a t Result + modifyingOriginalMutatesSubArray (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray xs + TA.fill zero 0 l zsSub + ys <- TA.toArray xs + pure $ zs /== ys modifyingOriginalMutatesSubArrayZeroTests :: Ref Int -> Effect Unit -modifyingOriginalMutatesSubArrayZeroTests count = overAll count modifyingOriginalMutatesSubArrayZero - where - modifyingOriginalMutatesSubArrayZero :: forall a b t. TestableArrayF a b D0 t Result - modifyingOriginalMutatesSubArrayZero (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray zsSub - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs /== ys - +modifyingOriginalMutatesSubArrayZeroTests count = overAll 0 count modifyingOriginalMutatesSubArrayZero + where + modifyingOriginalMutatesSubArrayZero :: forall a t. TestableArrayF a t Result + modifyingOriginalMutatesSubArrayZero (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray zsSub + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs /== ys modifyingSubArrayMutatesOriginalZeroTests :: Ref Int -> Effect Unit -modifyingSubArrayMutatesOriginalZeroTests count = overAll count modifyingSubArrayMutatesOriginalZero - where - modifyingSubArrayMutatesOriginalZero :: forall a b t. TestableArrayF a b D0 t Result - modifyingSubArrayMutatesOriginalZero (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray xs - TA.fill zero 0 l zsSub - ys <- TA.toArray xs - pure $ zs /== ys - +modifyingSubArrayMutatesOriginalZeroTests count = overAll 0 count modifyingSubArrayMutatesOriginalZero + where + modifyingSubArrayMutatesOriginalZero :: forall a t. TestableArrayF a t Result + modifyingSubArrayMutatesOriginalZero (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray xs + TA.fill zero 0 l zsSub + ys <- TA.toArray xs + pure $ zs /== ys modifyingOriginalMutatesSubArrayAllTests :: Ref Int -> Effect Unit -modifyingOriginalMutatesSubArrayAllTests count = overAll count modifyingOriginalMutatesSubArrayAll - where - modifyingOriginalMutatesSubArrayAll :: forall a b t. TestableArrayF a b D0 t Result - modifyingOriginalMutatesSubArrayAll (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray zsSub - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs /== ys - +modifyingOriginalMutatesSubArrayAllTests count = overAll 0 count modifyingOriginalMutatesSubArrayAll + where + modifyingOriginalMutatesSubArrayAll :: forall a t. TestableArrayF a t Result + modifyingOriginalMutatesSubArrayAll (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray zsSub + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs /== ys modifyingSubArrayMutatesOriginalAllTests :: Ref Int -> Effect Unit -modifyingSubArrayMutatesOriginalAllTests count = overAll count modifyingSubArrayMutatesOriginalAll - where - modifyingSubArrayMutatesOriginalAll :: forall a b t. TestableArrayF a b D0 t Result - modifyingSubArrayMutatesOriginalAll (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray xs - TA.fill zero 0 l zsSub - ys <- TA.toArray xs - pure $ zs /== ys - +modifyingSubArrayMutatesOriginalAllTests count = overAll 0 count modifyingSubArrayMutatesOriginalAll + where + modifyingSubArrayMutatesOriginalAll :: forall a t. TestableArrayF a t Result + modifyingSubArrayMutatesOriginalAll (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do + let + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray xs + TA.fill zero 0 l zsSub + ys <- TA.toArray xs + pure $ zs /== ys modifyingOriginalMutatesSubArrayPartTests :: Ref Int -> Effect Unit -modifyingOriginalMutatesSubArrayPartTests count = overAll count modifyingOriginalMutatesSubArrayPart - where - modifyingOriginalMutatesSubArrayPart :: forall a b t. TestableArrayF a b D1 t Result - modifyingOriginalMutatesSubArrayPart (WithIndices os xs) = do - let o = unsafePartial $ Array.head os - l = TA.length xs - zsSub = TA.subArray 0 l xs - zs <- TA.toArray zsSub - if o == 0 || Array.all (eq zero) zs - then pure Success - else do - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs /== ys - +modifyingOriginalMutatesSubArrayPartTests count = overAll 1 count modifyingOriginalMutatesSubArrayPart + where + modifyingOriginalMutatesSubArrayPart :: forall a t. TestableArrayF a t Result + modifyingOriginalMutatesSubArrayPart (WithIndices os xs) = do + let + o = unsafePartial $ Array.head os + l = TA.length xs + zsSub = TA.subArray 0 l xs + zs <- TA.toArray zsSub + if o == 0 || Array.all (eq zero) zs then pure Success + else do + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs /== ys modifyingOriginalDoesntMutateSliceTests :: Ref Int -> Effect Unit -modifyingOriginalDoesntMutateSliceTests count = overAll count modifyingOriginalDoesntMutateSlice - where - modifyingOriginalDoesntMutateSlice :: forall a b t. TestableArrayF a b D0 t Result - modifyingOriginalDoesntMutateSlice (WithIndices _ xs) = do - axs <- TA.toArray xs - if Array.all (eq zero) axs - then pure Success - else do - let l = TA.length xs - zsSub <- TA.slice 0 l xs - zs <- TA.toArray zsSub - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs === ys - - -modifyingOriginalDoesntMutateSlicePartTests :: Ref Int -> Effect Unit -modifyingOriginalDoesntMutateSlicePartTests count = overAll count modifyingOriginalDoesntMutateSlicePart +modifyingOriginalDoesntMutateSliceTests count = overAll 0 count modifyingOriginalDoesntMutateSlice where - modifyingOriginalDoesntMutateSlicePart :: forall a b t. TestableArrayF a b D1 t Result - modifyingOriginalDoesntMutateSlicePart (WithIndices os xs) = do + modifyingOriginalDoesntMutateSlice :: forall a t. TestableArrayF a t Result + modifyingOriginalDoesntMutateSlice (WithIndices _ xs) = do + axs <- TA.toArray xs + if Array.all (eq zero) axs then pure Success + else do let l = TA.length xs - axs <- TA.toArray =<< TA.slice 0 l xs - let o = unsafePartial $ Array.head os - e <- TA.at xs o - if Array.all (eq zero) axs || e == Just zero - then pure Success - else do - zsSub <- TA.slice o l xs - zs <- TA.toArray zsSub - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs === ys + zsSub <- TA.slice 0 l xs + zs <- TA.toArray zsSub + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs === ys +modifyingOriginalDoesntMutateSlicePartTests :: Ref Int -> Effect Unit +modifyingOriginalDoesntMutateSlicePartTests count = overAll 1 count modifyingOriginalDoesntMutateSlicePart + where + modifyingOriginalDoesntMutateSlicePart :: forall a t. TestableArrayF a t Result + modifyingOriginalDoesntMutateSlicePart (WithIndices os xs) = do + let l = TA.length xs + axs <- TA.toArray =<< TA.slice 0 l xs + let o = unsafePartial $ Array.head os + e <- TA.at xs o + if Array.all (eq zero) axs || e == Just zero then pure Success + else do + zsSub <- TA.slice o l xs + zs <- TA.toArray zsSub + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs === ys modifyingOriginalDoesntMutateSlicePart2Tests :: Ref Int -> Effect Unit -modifyingOriginalDoesntMutateSlicePart2Tests count = overAll count modifyingOriginalDoesntMutateSlicePart2 - where - modifyingOriginalDoesntMutateSlicePart2 :: forall a b t. TestableArrayF a b D1 t Result - modifyingOriginalDoesntMutateSlicePart2 (WithIndices os xs) = do - let o = unsafePartial $ Array.head os - l = TA.length xs - axs <- TA.toArray =<< TA.slice o l xs - e <- TA.at xs o - if Array.all (eq zero) axs || e == Just zero - then pure Success - else do - zsSub <- TA.slice o l xs - zs <- TA.toArray zsSub - TA.fill zero 0 l xs - ys <- TA.toArray zsSub - pure $ zs === ys - +modifyingOriginalDoesntMutateSlicePart2Tests count = overAll 1 count modifyingOriginalDoesntMutateSlicePart2 + where + modifyingOriginalDoesntMutateSlicePart2 :: forall a t. TestableArrayF a t Result + modifyingOriginalDoesntMutateSlicePart2 (WithIndices os xs) = do + let + o = unsafePartial $ Array.head os + l = TA.length xs + axs <- TA.toArray =<< TA.slice o l xs + e <- TA.at xs o + if Array.all (eq zero) axs || e == Just zero then pure Success + else do + zsSub <- TA.slice o l xs + zs <- TA.toArray zsSub + TA.fill zero 0 l xs + ys <- TA.toArray zsSub + pure $ zs === ys copyWithinSelfIsIdentityTests :: Ref Int -> Effect Unit -copyWithinSelfIsIdentityTests count = overAll count copyWithinSelfIsIdentity +copyWithinSelfIsIdentityTests count = overAll 0 count copyWithinSelfIsIdentity where - copyWithinSelfIsIdentity :: forall a b t. TestableArrayF a b D0 t Result - copyWithinSelfIsIdentity (WithIndices _ xs) = do - ys <- TA.toArray xs - TA.copyWithin xs 0 0 (Just (TA.length xs)) - zs <- TA.toArray xs - pure $ zs === ys - + copyWithinSelfIsIdentity :: forall a t. TestableArrayF a t Result + copyWithinSelfIsIdentity (WithIndices _ xs) = do + ys <- TA.toArray xs + TA.copyWithin xs 0 0 (Just (TA.length xs)) + zs <- TA.toArray xs + pure $ zs === ys copyWithinIsSliceTests :: Ref Int -> Effect Unit -copyWithinIsSliceTests count = overAll count copyWithinIsSlice - where - copyWithinIsSlice :: forall a b t. TestableArrayF a b D1 t Result - copyWithinIsSlice (WithIndices os xs) = do - let o = unsafePartial $ Array.head os - l = TA.length xs - ys <- TA.toArray =<< TA.slice o l xs - TA.copyWithin xs 0 o Nothing - axs <- TA.toArray xs - zs <- pure $ Array.drop (Array.length ys) axs - pure $ axs === ys <> zs - +copyWithinIsSliceTests count = overAll 1 count copyWithinIsSlice + where + copyWithinIsSlice :: forall a t. TestableArrayF a t Result + copyWithinIsSlice (WithIndices os xs) = do + let + o = unsafePartial $ Array.head os + l = TA.length xs + ys <- TA.toArray =<< TA.slice o l xs + TA.copyWithin xs 0 o Nothing + axs <- TA.toArray xs + zs <- pure $ Array.drop (Array.length ys) axs + pure $ axs === ys <> zs copyWithinViaSetTypedTests :: Ref Int -> Effect Unit -copyWithinViaSetTypedTests count = overAll count copyWithinViaSetTyped - where - copyWithinViaSetTyped :: forall a b t. TestableArrayF a b D1 t Result - copyWithinViaSetTyped (WithIndices os xs) = do - let o = unsafePartial $ Array.head os - txs <- TA.toArray xs - xs' <- TA.fromArray txs :: Effect (ArrayView a) - let l = TA.length xs' - ys <- TA.slice o l xs' - _ <- TA.setTyped xs' Nothing ys - TA.copyWithin xs 0 o Nothing - axs <- TA.toArray xs - axs' <- TA.toArray xs' - pure $ axs === axs' +copyWithinViaSetTypedTests count = overAll 1 count copyWithinViaSetTyped + where + copyWithinViaSetTyped :: forall a t. TestableArrayF a t Result + copyWithinViaSetTyped (WithIndices os xs) = do + let o = unsafePartial $ Array.head os + txs <- TA.toArray xs + xs' <- TA.fromArray txs :: Effect (ArrayView a) + let l = TA.length xs' + ys <- TA.slice o l xs' + _ <- TA.setTyped xs' Nothing ys + TA.copyWithin xs 0 o Nothing + axs <- TA.toArray xs + axs' <- TA.toArray xs' + pure $ axs === axs' + +-- | Uses the second failure message as the result failure message +-- | https://github.com/athanclark/purescript-quickcheck-combinators/blob/293e5af07ae47b61d4eae5defef4c0f472bfa9ca/src/Test/QuickCheck/Combinators.purs#L62 +implies :: Result -> Result -> Result +implies x y = case y of + Failed y' -> case x of + Success -> Failed ("Implied failure: " <> y') + _ -> Success + _ -> Success + +-- | Combine two results with "Exclusive Or" logic, and with `", xor "` as the failure message separator, and "XOR" as the failure message if they are both `Success` +-- | https://github.com/athanclark/purescript-quickcheck-combinators/blob/293e5af07ae47b61d4eae5defef4c0f472bfa9ca/src/Test/QuickCheck/Combinators.purs#L44 +xor :: Result -> Result -> Result +xor = xor' ", xor " "XOR" + where + -- Combine two results with "Exclusive Or" logic, and with a failure message separator and failure message if they are both `Success` + xor' + :: String -- ^ Separator + -> String -- ^ Success failure message + -> Result + -> Result + -> Result + xor' m s x y = case Tuple x y of + Tuple (Failed x') (Failed y') -> Failed (x' <> m <> y') + Tuple Success Success -> Failed s + Tuple Success y' -> y' + Tuple x' Success -> x'