diff --git a/.eslintrc.json b/.eslintrc.json index 84cef4f..1c6afb9 100644 --- a/.eslintrc.json +++ b/.eslintrc.json @@ -1,11 +1,9 @@ { "parserOptions": { - "ecmaVersion": 5 + "ecmaVersion": 6, + "sourceType": "module" }, "extends": "eslint:recommended", - "env": { - "commonjs": true - }, "rules": { "strict": [2, "global"], "block-scoped-var": 2, diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..4435abb --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,12 @@ +**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 reference to this PR (e.g. "- Made a change (#0000)") +- [ ] Linked any existing issues or proposals that this pull request should close +- [ ] Updated or added relevant documentation +- [ ] Added a test for the contribution (if applicable) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e2972ba..c69237a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,6 +1,10 @@ name: CI -on: push +on: + push: + branches: [master] + pull_request: + branches: [master] jobs: build: @@ -10,11 +14,11 @@ jobs: - uses: purescript-contrib/setup-purescript@main with: - purescript: "0.14.0-rc3" + purescript: "unstable" - - uses: actions/setup-node@v1 + - uses: actions/setup-node@v2 with: - node-version: "12" + node-version: "14.x" - name: Install dependencies run: | diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..542cb0c --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,224 @@ +# 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: +- Make `foldrDefault` and `foldlDefault` stack safe (#148) + +## [v6.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v6.0.0) - 2022-04-27 + +Breaking changes: +- Migrate FFI to ES modules (#146 by @kl0tl and @JordanMartinez) +- Drop deprecated `foldMap1Default` (#147 by @JordanMartinez) + +New features: + +Bugfixes: + +Other improvements: +- Narrow down unnecessarily imprecise type of `mapWithIndexArray` (#145) + +## [v5.0.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v5.0.1) - 2021-04-20 + +Other improvements: +- Fix warnings revealed by v0.14.1 PureScript release (#135 by @JordanMartinez) + +## [v5.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v5.0.0) - 2021-02-26 + +Breaking changes: +- Added support for PureScript 0.14 and dropped support for all previous versions (#120) +- Removed `fold1Default` and deprecated `foldMap1Default` (#128) + +New features: +- Added `findMapWithIndex` (#119) +- Added `foldr1`, `foldl1`, `foldr1Default`, `foldl1Default`, `foldMap1DefaultR`, `foldMap1DefaultL` (#121, #128) +- Added `maximumBy` and `minimumBy` to `Data.Semigroup.Foldable` (#123) +- Added `lookup` to `Data.Foldable`; this function previously lived in `Data.Tuple` in the `purescript-tuples` package (#131) + +Bugfixes: + +Other improvements: +- Migrated CI to GitHub Actions and updated installation instructions to use Spago (#127) +- Added a CHANGELOG.md file and pull request template (#129, #130) +- Wrapped `traverseArrayImpl` IIFE in parentheses (#52) +- Added examples for `sequence` and `traverse` (#115) +- Changed `foldM` type signature to more closely match `foldl` (#111) +- This package now depends on the `purescript-const`, `purescript-either`, `purescript-functors`, `purescript-identity`, and `purescript-tuples` packages, and contains instances previously in those packages or the `purescript-bifunctors` or `purescript-profunctor` packages (#131) + +## [v4.1.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.1.1) - 2018-11-23 + +Added examples to documentation for `intercalate` (@shmish111) + +## [v4.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.1.0) - 2018-10-05 + +- Added missing exports for `minimum` and `maximum` from `Data.Semigroup.Foldable` (@paluh) + +## [v4.0.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.0.1) - 2018-09-19 + +- Fixed totally wrong example in the documentation for `scanr`! (@ewaldgrusk) + +## [v4.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.0.0) - 2018-05-23 + +- Updated for PureScript 0.12 +- `traverse` for `Array` is now divide-and-conquer (@S11001001) +- `findWithIndex` returns both index and value of the found item (@mbid) +- Added `Traversable1` instances for `Dual` and `Multiplicative` (@matthewleon) +- Added `minimum` and `maximum` for `Foldable1` (@colehaus) +- Added functions for default `Foldable` implementations based on `FoldableWithIndex` (@matthewleon) +- Added `intercalate` and `intercalateMap` for `Foldable1` (@matthewleon) + +## [v3.7.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.7.1) - 2018-01-10 + +- Fixed shadowed name warnings + +## [v3.7.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.7.0) - 2018-01-09 + +- Added `indexl` and `indexr` for `Foldable`s (@safareli) + +## [v3.6.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.6.1) - 2017-09-18 + +Fix test for `foldrDefault` (@tekerson) + +## [v3.6.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.6.0) - 2017-08-18 + +Export `oneOfMap` (@natefaubion) + +## [v3.5.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.5.0) - 2017-08-18 + +Add `oneOfMap` (@natefaubion) + +## [v3.4.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.4.0) - 2017-07-10 + +Add `FunctorWithIndex`, `FoldableWithIndex` and `TraversableWithIndex` classes (@mbid) + +## [v3.3.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.3.1) - 2017-06-21 + +Fix `foldMapDefaultL` (@mbid) + +## [v3.3.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.3.0) - 2017-06-04 + +Add `Foldable1` and `Traversable1` (@LukaJCB) + +## [v3.2.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.2.0) - 2017-06-03 + +Add a generic `foldM` which works with any `Foldable`. (@clayrat) + +## [v3.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.1.0) - 2017-06-03 + +Add `surroundMap` and `surround` (@LiamGoodacre) + +## [v3.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.0.0) - 2017-03-26 + +- Updated for PureScript 0.11 +- Added `null` for `Foldable` (@matthewleon) +- Added `length` for `Foldable` (@matthewleon) +- Eta-reduced some functions (@mlang) + +## [v2.2.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v2.2.0) - 2017-02-06 + +- Added instances for the `Bifunctor` newtypes (@LiamGoodacre) + +## [v2.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v2.1.0) - 2017-01-16 + +- Added left-only and right-only varieties of `bitraverse`/`bifor` + +## [v2.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v2.0.0) - 2016-10-02 + +- Added `findMap` (@LiamGoodacre) +- Relaxed `and`, `or`, `any`, `all` to `HeytingAlgebra` from `BooleanAlgebra` +- Updated dependencies + +## [v1.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0) - 2016-06-01 + +This release is intended for the PureScript 0.9.1 compiler and newer. + +**Note**: The v1.0.0 tag is not meant to indicate the library is “finished”, the core libraries are all being bumped to this for the 0.9 compiler release so as to use semver more correctly. + +## [v1.0.0-rc.3](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0-rc.3) - 2016-05-24 + +- Fixes for the upcoming psc 0.9.1 + +## [v1.0.0-rc.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0-rc.2) - 2016-05-20 + +- Updated dependencies +- `find` now returns the first value matching the predicate + +## [v1.0.0-rc.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0-rc.1) - 2016-03-13 + +- Release candidate for the psc 0.8+ core libraries + +## [v0.4.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.2) - 2015-11-30 + +- `maximum`, `minimum`, `maximumBy`, `minimumBy` (@hdgarrood) + +## [v0.4.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.1) - 2015-11-01 + +- Removed unused imports + +## [v0.4.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.0) - 2015-06-30 + +This release works with versions 0.7.\* of the PureScript compiler. It will not work with older versions. If you are using an older version, you should require an older, compatible version of this library. + +## [v0.4.0-rc.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.0-rc.2) - 2015-06-06 + +- Fixed behaviour of `foldr` for `Array`. + +## [v0.4.0-rc.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.0-rc.1) - 2015-06-06 + +Initial release candidate of the library intended for the 0.7 compiler. + +## [v0.3.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.3.1) - 2015-03-19 + +Updated docs + +## [v0.3.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.3.0) - 2015-02-21 + +**This release requires PureScript v0.6.8 or later** +- Updated dependencies +- Added `Foldable` and `Traversable` instances for the `Additive`, `Dual`, `First`, `Last`, and `Multiplicative` monoids + +## [v0.2.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.2.1) - 2014-12-18 + +- Added `scanl` and `scanr` (@paf31) + +## [v0.2.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.2.0) - 2014-12-17 + +- Removed instance for deprecated `Ref` type + +## [v0.1.6](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.6) - 2014-12-11 + + + +## [v0.1.5](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.5) - 2014-12-02 + +- Added `mapAccumL` and `mapAccumR`. + +## [v0.1.4](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.4) - 2014-10-24 + +- Added `intercalate` to `Data.Foldable` (@garyb) + +## [v0.1.3](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.3) - 2014-07-14 + + + +## [v0.1.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.2) - 2014-06-14 + +- Now uses "proper" `Unit` type instead of `{}` (garyb) +- Removed implied `Functor` constraint from some types that are `Applicative` (garyb) + +## [v0.1.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.1) - 2014-05-24 + +- Added `lookup` (paf31) + +## [v0.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.0) - 2014-04-25 + + + diff --git a/README.md b/README.md index 3552b6e..b1344d4 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,7 @@ [![Latest release](http://img.shields.io/github/release/purescript/purescript-foldable-traversable.svg)](https://github.com/purescript/purescript-foldable-traversable/releases) [![Build status](https://github.com/purescript/purescript-foldable-traversable/workflows/CI/badge.svg?branch=master)](https://github.com/purescript/purescript-foldable-traversable/actions?query=workflow%3ACI+branch%3Amaster) +[![Pursuit](https://pursuit.purescript.org/packages/purescript-foldable-traversable/badge)](https://pursuit.purescript.org/packages/purescript-foldable-traversable) Classes for foldable and traversable data structures. diff --git a/bower.json b/bower.json index fa33d12..e9496ae 100644 --- a/bower.json +++ b/bower.json @@ -5,7 +5,7 @@ "license": "BSD-3-Clause", "repository": { "type": "git", - "url": "git://github.com/purescript/purescript-foldable-traversable.git" + "url": "https://github.com/purescript/purescript-foldable-traversable.git" }, "ignore": [ "**/.*", @@ -17,18 +17,23 @@ "package.json" ], "dependencies": { - "purescript-bifunctors": "master", - "purescript-control": "master", - "purescript-maybe": "master", - "purescript-newtype": "master", - "purescript-orders": "master", - "purescript-prelude": "master" + "purescript-bifunctors": "^6.0.0", + "purescript-const": "^6.0.0", + "purescript-control": "^6.0.0", + "purescript-either": "^6.0.0", + "purescript-functors": "^5.0.0", + "purescript-identity": "^6.0.0", + "purescript-maybe": "^6.0.0", + "purescript-newtype": "^5.0.0", + "purescript-orders": "^6.0.0", + "purescript-prelude": "^6.0.0", + "purescript-tuples": "^7.0.0" }, "devDependencies": { - "purescript-assert": "master", - "purescript-console": "master", - "purescript-integers": "master", - "purescript-math": "master", - "purescript-unsafe-coerce": "master" + "purescript-assert": "^6.0.0", + "purescript-console": "^6.0.0", + "purescript-integers": "^6.0.0", + "purescript-unsafe-coerce": "^6.0.0", + "purescript-minibench": "^4.0.0" } } diff --git a/package.json b/package.json index 8985bcf..a1d6811 100644 --- a/package.json +++ b/package.json @@ -6,9 +6,9 @@ "test": "pulp test" }, "devDependencies": { - "eslint": "^4.19.1", - "pulp": "^15.0.0", - "purescript-psa": "^0.8.0", - "rimraf": "^2.6.2" + "eslint": "^7.15.0", + "pulp": "16.0.0-0", + "purescript-psa": "^0.8.2", + "rimraf": "^3.0.2" } } diff --git a/src/Data/Bifoldable.purs b/src/Data/Bifoldable.purs index c0cc6e0..9b18723 100644 --- a/src/Data/Bifoldable.purs +++ b/src/Data/Bifoldable.purs @@ -3,17 +3,19 @@ module Data.Bifoldable where import Prelude import Control.Apply (applySecond) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, foldr, foldl, foldMap) +import Data.Functor.Clown (Clown(..)) +import Data.Functor.Flip (Flip(..)) +import Data.Functor.Joker (Joker(..)) +import Data.Functor.Product2 (Product2(..)) import Data.Monoid.Conj (Conj(..)) import Data.Monoid.Disj (Disj(..)) import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Endo (Endo(..)) import Data.Newtype (unwrap) -import Data.Foldable (class Foldable, foldr, foldl, foldMap) -import Data.Bifunctor.Clown (Clown(..)) -import Data.Bifunctor.Joker (Joker(..)) -import Data.Bifunctor.Flip (Flip(..)) -import Data.Bifunctor.Product (Product(..)) -import Data.Bifunctor.Wrap (Wrap(..)) +import Data.Tuple (Tuple(..)) -- | `Bifoldable` represents data structures with two type arguments which can be -- | folded. @@ -52,15 +54,28 @@ instance bifoldableFlip :: Bifoldable p => Bifoldable (Flip p) where bifoldl r l u (Flip p) = bifoldl l r u p bifoldMap r l (Flip p) = bifoldMap l r p -instance bifoldableProduct :: (Bifoldable f, Bifoldable g) => Bifoldable (Product f g) where +instance bifoldableProduct2 :: (Bifoldable f, Bifoldable g) => Bifoldable (Product2 f g) where bifoldr l r u m = bifoldrDefault l r u m bifoldl l r u m = bifoldlDefault l r u m - bifoldMap l r (Product f g) = bifoldMap l r f <> bifoldMap l r g - -instance bifoldableWrap :: Bifoldable p => Bifoldable (Wrap p) where - bifoldr l r u (Wrap p) = bifoldr l r u p - bifoldl l r u (Wrap p) = bifoldl l r u p - bifoldMap l r (Wrap p) = bifoldMap l r p + bifoldMap l r (Product2 f g) = bifoldMap l r f <> bifoldMap l r g + +instance bifoldableEither :: Bifoldable Either where + bifoldr f _ z (Left a) = f a z + bifoldr _ g z (Right b) = g b z + bifoldl f _ z (Left a) = f z a + bifoldl _ g z (Right b) = g z b + bifoldMap f _ (Left a) = f a + bifoldMap _ g (Right b) = g b + +instance bifoldableTuple :: Bifoldable Tuple where + bifoldMap f g (Tuple a b) = f a <> g b + bifoldr f g z (Tuple a b) = f a (g b z) + bifoldl f g z (Tuple a b) = g (f z a) b + +instance bifoldableConst :: Bifoldable Const where + bifoldr f _ z (Const a) = f a z + bifoldl f _ z (Const a) = f z a + bifoldMap f _ (Const a) = f a -- | A default implementation of `bifoldr` using `bifoldMap`. -- | diff --git a/src/Data/Bitraversable.purs b/src/Data/Bitraversable.purs index 77ce7ff..6760549 100644 --- a/src/Data/Bitraversable.purs +++ b/src/Data/Bitraversable.purs @@ -15,11 +15,13 @@ import Prelude import Data.Bifoldable (class Bifoldable, biall, biany, bifold, bifoldMap, bifoldMapDefaultL, bifoldMapDefaultR, bifoldl, bifoldlDefault, bifoldr, bifoldrDefault, bifor_, bisequence_, bitraverse_) import Data.Traversable (class Traversable, traverse, sequence) import Data.Bifunctor (class Bifunctor, bimap) -import Data.Bifunctor.Clown (Clown(..)) -import Data.Bifunctor.Joker (Joker(..)) -import Data.Bifunctor.Flip (Flip(..)) -import Data.Bifunctor.Product (Product(..)) -import Data.Bifunctor.Wrap (Wrap(..)) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Functor.Clown (Clown(..)) +import Data.Functor.Flip (Flip(..)) +import Data.Functor.Joker (Joker(..)) +import Data.Functor.Product2 (Product2(..)) +import Data.Tuple (Tuple(..)) -- | `Bitraversable` represents data structures with two type arguments which can be -- | traversed. @@ -48,13 +50,23 @@ instance bitraversableFlip :: Bitraversable p => Bitraversable (Flip p) where bitraverse r l (Flip p) = Flip <$> bitraverse l r p bisequence (Flip p) = Flip <$> bisequence p -instance bitraversableProduct :: (Bitraversable f, Bitraversable g) => Bitraversable (Product f g) where - bitraverse l r (Product f g) = Product <$> bitraverse l r f <*> bitraverse l r g - bisequence (Product f g) = Product <$> bisequence f <*> bisequence g +instance bitraversableProduct2 :: (Bitraversable f, Bitraversable g) => Bitraversable (Product2 f g) where + bitraverse l r (Product2 f g) = Product2 <$> bitraverse l r f <*> bitraverse l r g + bisequence (Product2 f g) = Product2 <$> bisequence f <*> bisequence g -instance bitraversableWrap :: Bitraversable p => Bitraversable (Wrap p) where - bitraverse l r (Wrap p) = Wrap <$> bitraverse l r p - bisequence (Wrap p) = Wrap <$> bisequence p +instance bitraversableEither :: Bitraversable Either where + bitraverse f _ (Left a) = Left <$> f a + bitraverse _ g (Right b) = Right <$> g b + bisequence (Left a) = Left <$> a + bisequence (Right b) = Right <$> b + +instance bitraversableTuple :: Bitraversable Tuple where + bitraverse f g (Tuple a b) = Tuple <$> f a <*> g b + bisequence (Tuple a b) = Tuple <$> a <*> b + +instance bitraversableConst :: Bitraversable Const where + bitraverse f _ (Const a) = Const <$> f a + bisequence (Const a) = Const <$> a ltraverse :: forall t b c a f diff --git a/src/Data/Foldable.js b/src/Data/Foldable.js index bbdf340..8c5cbe4 100644 --- a/src/Data/Foldable.js +++ b/src/Data/Foldable.js @@ -1,6 +1,4 @@ -"use strict"; - -exports.foldrArray = function (f) { +export const foldrArray = function (f) { return function (init) { return function (xs) { var acc = init; @@ -13,7 +11,7 @@ exports.foldrArray = function (f) { }; }; -exports.foldlArray = function (f) { +export const foldlArray = function (f) { return function (init) { return function (xs) { var acc = init; diff --git a/src/Data/Foldable.purs b/src/Data/Foldable.purs index d6d0935..b98cc1e 100644 --- a/src/Data/Foldable.purs +++ b/src/Data/Foldable.purs @@ -29,11 +29,19 @@ module Data.Foldable , minimumBy , null , length + , lookup ) where import Prelude import Control.Plus (class Plus, alt, empty) +import Data.Const (Const) +import Data.Either (Either(..)) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct, coproduct) +import Data.Functor.Product (Product(..)) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Maybe.First (First(..)) import Data.Maybe.Last (Last(..)) @@ -44,6 +52,7 @@ import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Endo (Endo(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Newtype (alaF, unwrap) +import Data.Tuple (Tuple(..)) -- | `Foldable` represents data structures which can be _folded_. -- | @@ -66,6 +75,54 @@ class Foldable f where foldl :: forall a b. (b -> a -> b) -> b -> f a -> b foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m + +-- | This internal type is used just to implement a stack-safe and performant foldrDefault and foldlDefault. +-- | It has O(1) append (because foldrDefault and foldlDefault are implemented in terms of foldMap), and +-- | an amortized O(1) uncons/unsnoc. It behaves similarly to a CatList +data FreeMonoidTree a = Empty | Node a | Append (FreeMonoidTree a) (FreeMonoidTree a) + +instance Foldable FreeMonoidTree where + -- these folding implementations could be written more plainly, but are optimized to minimize conditionals. + foldl fn = (\a b -> go a b Empty) + where + go acc lhs rhs = + case lhs of + Node a -> go (fn acc a) rhs Empty + Append xs ys -> + case ys of + Empty -> go acc xs rhs + _ -> + case rhs of + Empty -> go acc xs ys + _ -> go acc xs (Append ys rhs) + Empty -> + case rhs of + Empty -> acc + _ -> go acc rhs Empty + + foldr fn = (\a b -> go a Empty b) + where + go acc lhs rhs = + case rhs of + Node a -> go (fn a acc) Empty lhs + Append xs ys -> + case xs of + Empty -> go acc lhs ys + _ -> + case lhs of + Empty -> go acc xs ys + _ -> go acc (Append lhs xs) ys + Empty -> + case lhs of + Empty -> acc + _ -> go acc Empty lhs + + + foldMap = foldMapDefaultR + +instance Semigroup (FreeMonoidTree a) where append = Append +instance Monoid (FreeMonoidTree a) where mempty = Empty + -- | A default implementation of `foldr` using `foldMap`. -- | -- | Note: when defining a `Foldable` instance, this function is unsafe to use @@ -77,7 +134,7 @@ foldrDefault -> b -> f a -> b -foldrDefault c u xs = unwrap (foldMap (Endo <<< c) xs) u +foldrDefault c u xs = foldr c u $ foldMap Node xs -- | A default implementation of `foldl` using `foldMap`. -- | @@ -90,7 +147,7 @@ foldlDefault -> b -> f a -> b -foldlDefault c u xs = unwrap (unwrap (foldMap (Dual <<< Endo <<< flip c) xs)) u +foldlDefault c u xs = foldl c u $ foldMap Node xs -- | A default implementation of `foldMap` using `foldr`. -- | @@ -131,7 +188,7 @@ instance foldableMaybe :: Foldable Maybe where foldr f z (Just x) = x `f` z foldl _ z Nothing = z foldl f z (Just x) = z `f` x - foldMap f Nothing = mempty + foldMap _ Nothing = mempty foldMap f (Just x) = f x instance foldableFirst :: Foldable First where @@ -169,6 +226,49 @@ instance foldableMultiplicative :: Foldable Multiplicative where foldl f z (Multiplicative x) = z `f` x foldMap f (Multiplicative x) = f x +instance foldableEither :: Foldable (Either a) where + foldr _ z (Left _) = z + foldr f z (Right x) = f x z + foldl _ z (Left _) = z + foldl f z (Right x) = f z x + foldMap _ (Left _) = mempty + foldMap f (Right x) = f x + +instance foldableTuple :: Foldable (Tuple a) where + foldr f z (Tuple _ x) = f x z + foldl f z (Tuple _ x) = f z x + foldMap f (Tuple _ x) = f x + +instance foldableIdentity :: Foldable Identity where + foldr f z (Identity x) = f x z + foldl f z (Identity x) = f z x + foldMap f (Identity x) = f x + +instance foldableConst :: Foldable (Const a) where + foldr _ z _ = z + foldl _ z _ = z + foldMap _ _ = mempty + +instance foldableProduct :: (Foldable f, Foldable g) => Foldable (Product f g) where + foldr f z (Product (Tuple fa ga)) = foldr f (foldr f z ga) fa + foldl f z (Product (Tuple fa ga)) = foldl f (foldl f z fa) ga + foldMap f (Product (Tuple fa ga)) = foldMap f fa <> foldMap f ga + +instance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f g) where + foldr f z = coproduct (foldr f z) (foldr f z) + foldl f z = coproduct (foldl f z) (foldl f z) + foldMap f = coproduct (foldMap f) (foldMap f) + +instance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) where + foldr f i (Compose fga) = foldr (flip (foldr f)) i fga + foldl f i (Compose fga) = foldl (foldl f) i fga + foldMap f (Compose fga) = foldMap (foldMap f) fga + +instance foldableApp :: Foldable f => Foldable (App f) where + foldr f i (App x) = foldr f i x + foldl f i (App x) = foldl f i x + foldMap f (App x) = foldMap f x + -- | Fold a data structure, accumulating values in some `Monoid`. fold :: forall f m. Foldable f => Monoid m => f m -> m fold = foldMap identity @@ -413,3 +513,7 @@ null = foldr (\_ _ -> false) true -- | is no general way to do better. length :: forall a b f. Foldable f => Semiring b => f a -> b length = foldl (\c _ -> add one c) zero + +-- | Lookup a value in a data structure of `Tuple`s, generalizing association lists. +lookup :: forall a b f. Foldable f => Eq a => a -> f (Tuple a b) -> Maybe b +lookup a = unwrap <<< foldMap \(Tuple a' b) -> First (if a == a' then Just b else Nothing) diff --git a/src/Data/FoldableWithIndex.purs b/src/Data/FoldableWithIndex.purs index 40bbf09..258fe1e 100644 --- a/src/Data/FoldableWithIndex.purs +++ b/src/Data/FoldableWithIndex.purs @@ -19,8 +19,15 @@ module Data.FoldableWithIndex import Prelude +import Data.Const (Const) +import Data.Either (Either(..)) import Data.Foldable (class Foldable, foldMap, foldl, foldr) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct, coproduct) +import Data.Functor.Product (Product(..)) import Data.FunctorWithIndex (mapWithIndex) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Maybe.First (First) import Data.Maybe.Last (Last) @@ -31,6 +38,7 @@ import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Endo (Endo(..)) import Data.Monoid.Multiplicative (Multiplicative) import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..), curry) -- | A `Foldable` with an additional index. -- | A `FoldableWithIndex` instance must be compatible with its `Foldable` @@ -108,8 +116,6 @@ foldMapWithIndexDefaultL -> m foldMapWithIndexDefaultL f = foldlWithIndex (\i acc x -> acc <> f i x) mempty -data Tuple a b = Tuple a b - instance foldableWithIndexArray :: FoldableWithIndex Int Array where foldrWithIndex f z = foldr (\(Tuple i x) y -> f i x y) z <<< mapWithIndex Tuple foldlWithIndex f z = foldl (\y (Tuple i x) -> f i y x) z <<< mapWithIndex Tuple @@ -155,6 +161,49 @@ instance foldableWithIndexMultiplicative :: FoldableWithIndex Unit Multiplicativ foldlWithIndex f = foldl $ f unit foldMapWithIndex f = foldMap $ f unit +instance foldableWithIndexEither :: FoldableWithIndex Unit (Either a) where + foldrWithIndex _ z (Left _) = z + foldrWithIndex f z (Right x) = f unit x z + foldlWithIndex _ z (Left _) = z + foldlWithIndex f z (Right x) = f unit z x + foldMapWithIndex _ (Left _) = mempty + foldMapWithIndex f (Right x) = f unit x + +instance foldableWithIndexTuple :: FoldableWithIndex Unit (Tuple a) where + foldrWithIndex f z (Tuple _ x) = f unit x z + foldlWithIndex f z (Tuple _ x) = f unit z x + foldMapWithIndex f (Tuple _ x) = f unit x + +instance foldableWithIndexIdentity :: FoldableWithIndex Unit Identity where + foldrWithIndex f z (Identity x) = f unit x z + foldlWithIndex f z (Identity x) = f unit z x + foldMapWithIndex f (Identity x) = f unit x + +instance foldableWithIndexConst :: FoldableWithIndex Void (Const a) where + foldrWithIndex _ z _ = z + foldlWithIndex _ z _ = z + foldMapWithIndex _ _ = mempty + +instance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where + foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa + foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga + foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga + +instance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where + foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z) + foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z) + foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right)) + +instance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where + foldrWithIndex f i (Compose fga) = foldrWithIndex (\a -> flip (foldrWithIndex (curry f a))) i fga + foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga + foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga + +instance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f) where + foldrWithIndex f z (App x) = foldrWithIndex f z x + foldlWithIndex f z (App x) = foldlWithIndex f z x + foldMapWithIndex f (App x) = foldMapWithIndex f x + -- | Similar to 'foldlWithIndex', but the result is encapsulated in a monad. -- | diff --git a/src/Data/FunctorWithIndex.js b/src/Data/FunctorWithIndex.js index 65b2816..884e842 100644 --- a/src/Data/FunctorWithIndex.js +++ b/src/Data/FunctorWithIndex.js @@ -1,6 +1,4 @@ -"use strict"; - -exports.mapWithIndexArray = function (f) { +export const mapWithIndexArray = function (f) { return function (xs) { var l = xs.length; var result = Array(l); diff --git a/src/Data/FunctorWithIndex.purs b/src/Data/FunctorWithIndex.purs index 0167a41..9d9a48d 100644 --- a/src/Data/FunctorWithIndex.purs +++ b/src/Data/FunctorWithIndex.purs @@ -4,6 +4,14 @@ module Data.FunctorWithIndex import Prelude +import Data.Bifunctor (bimap) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..)) +import Data.Functor.Product (Product(..)) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe) import Data.Maybe.First (First) import Data.Maybe.Last (Last) @@ -12,6 +20,7 @@ import Data.Monoid.Conj (Conj) import Data.Monoid.Disj (Disj) import Data.Monoid.Dual (Dual) import Data.Monoid.Multiplicative (Multiplicative) +import Data.Tuple (Tuple, curry) -- | A `Functor` with an additional index. -- | Instances must satisfy a modified form of the `Functor` laws @@ -26,7 +35,7 @@ import Data.Monoid.Multiplicative (Multiplicative) class Functor f <= FunctorWithIndex i f | f -> i where mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b -foreign import mapWithIndexArray :: forall i a b. (i -> a -> b) -> Array a -> Array b +foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b instance functorWithIndexArray :: FunctorWithIndex Int Array where mapWithIndex = mapWithIndexArray @@ -55,6 +64,30 @@ instance functorWithIndexDisj :: FunctorWithIndex Unit Disj where instance functorWithIndexMultiplicative :: FunctorWithIndex Unit Multiplicative where mapWithIndex f = map $ f unit +instance functorWithIndexEither :: FunctorWithIndex Unit (Either a) where + mapWithIndex f = map $ f unit + +instance functorWithIndexTuple :: FunctorWithIndex Unit (Tuple a) where + mapWithIndex f = map $ f unit + +instance functorWithIndexIdentity :: FunctorWithIndex Unit Identity where + mapWithIndex f (Identity a) = Identity (f unit a) + +instance functorWithIndexConst :: FunctorWithIndex Void (Const a) where + mapWithIndex _ (Const x) = Const x + +instance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where + mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga) + +instance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where + mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e) + +instance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where + mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga + +instance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f) where + mapWithIndex f (App x) = App $ mapWithIndex f x + -- | A default implementation of Functor's `map` in terms of `mapWithIndex` mapDefault :: forall i f a b. FunctorWithIndex i f => (a -> b) -> f a -> f b mapDefault f = mapWithIndex (const f) diff --git a/src/Data/Semigroup/Foldable.purs b/src/Data/Semigroup/Foldable.purs index 2a06b62..a7fdf36 100644 --- a/src/Data/Semigroup/Foldable.purs +++ b/src/Data/Semigroup/Foldable.purs @@ -7,87 +7,101 @@ module Data.Semigroup.Foldable , traverse1_ , for1_ , sequence1_ - , foldMap1Default - , fold1Default - , fold1DefaultR - , fold1DefaultL , foldr1Default , foldl1Default + , foldMap1DefaultR + , foldMap1DefaultL , intercalate , intercalateMap , maximum + , maximumBy , minimum + , minimumBy ) where import Prelude import Data.Foldable (class Foldable) +import Data.Identity (Identity(..)) import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Newtype (ala, alaF) import Data.Ord.Max (Max(..)) import Data.Ord.Min (Min(..)) +import Data.Tuple (Tuple(..)) -- | `Foldable1` represents data structures with a minimum of one element that can be _folded_. -- | --- | - `fold1` folds a structure using a `Semigroup` instance --- | - `foldMap1` folds a structure by accumulating values in a `Semigroup` -- | - `foldr1` folds a structure from the right -- | - `foldl1` folds a structure from the left +-- | - `foldMap1` folds a structure by accumulating values in a `Semigroup` -- | -- | Default implementations are provided by the following functions: -- | --- | - `fold1Default` --- | - `fold1DefaultR` --- | - `fold1DefaultL` --- | - `foldMap1Default` -- | - `foldr1Default` -- | - `foldl1Default` +-- | - `foldMap1DefaultR` +-- | - `foldMap1DefaultL` -- | -- | Note: some combinations of the default implementations are unsafe to -- | use together - causing a non-terminating mutually recursive cycle. -- | These combinations are documented per function. class Foldable t <= Foldable1 t where - foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m - fold1 :: forall m. Semigroup m => t m -> m foldr1 :: forall a. (a -> a -> a) -> t a -> a foldl1 :: forall a. (a -> a -> a) -> t a -> a - --- | A default implementation of `fold1` using `foldMap1`. -fold1Default :: forall t m. Foldable1 t => Semigroup m => t m -> m -fold1Default = foldMap1 identity - --- | A default implementation of `fold1` using `foldr1`. -fold1DefaultR :: forall t m. Foldable1 t => Semigroup m => t m -> m -fold1DefaultR = foldr1 append - --- | A default implementation of `fold1` using `foldl1`. -fold1DefaultL :: forall t m. Foldable1 t => Semigroup m => t m -> m -fold1DefaultL = foldl1 append - --- | A default implementation of `foldMap1` using `fold1`. -foldMap1Default :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m -foldMap1Default f = (map f) >>> fold1 + foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m -- | A default implementation of `foldr1` using `foldMap1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldMap1DefaultR`. foldr1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a foldr1Default = flip (runFoldRight1 <<< foldMap1 mkFoldRight1) -- | A default implementation of `foldl1` using `foldMap1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldMap1DefaultL`. foldl1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a foldl1Default = flip (runFoldRight1 <<< alaF Dual foldMap1 mkFoldRight1) <<< flip +-- | A default implementation of `foldMap1` using `foldr1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldr1Default`. +foldMap1DefaultR :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m +foldMap1DefaultR f = map f >>> foldr1 (<>) + +-- | A default implementation of `foldMap1` using `foldl1`. +-- | +-- | Note: when defining a `Foldable1` instance, this function is unsafe to use +-- | in combination with `foldl1Default`. +foldMap1DefaultL :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m +foldMap1DefaultL f = map f >>> foldl1 (<>) + instance foldableDual :: Foldable1 Dual where - foldMap1 f (Dual x) = f x - fold1 = fold1Default foldr1 _ (Dual x) = x foldl1 _ (Dual x) = x + foldMap1 f (Dual x) = f x instance foldableMultiplicative :: Foldable1 Multiplicative where - foldMap1 f (Multiplicative x) = f x - fold1 = fold1Default foldr1 _ (Multiplicative x) = x foldl1 _ (Multiplicative x) = x + foldMap1 f (Multiplicative x) = f x + +instance foldableTuple :: Foldable1 (Tuple a) where + foldMap1 f (Tuple _ x) = f x + foldr1 _ (Tuple _ x) = x + foldl1 _ (Tuple _ x) = x + +instance foldableIdentity :: Foldable1 Identity where + foldMap1 f (Identity x) = f x + foldl1 _ (Identity x) = x + foldr1 _ (Identity x) = x + +-- | Fold a data structure, accumulating values in some `Semigroup`. +fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m +fold1 = foldMap1 identity newtype Act :: forall k. (k -> Type) -> k -> Type newtype Act f a = Act (f a) @@ -118,9 +132,15 @@ sequence1_ = traverse1_ identity maximum :: forall f a. Ord a => Foldable1 f => f a -> a maximum = ala Max foldMap1 +maximumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a +maximumBy cmp = foldl1 \x y -> if cmp x y == GT then x else y + minimum :: forall f a. Ord a => Foldable1 f => f a -> a minimum = ala Min foldMap1 +minimumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a +minimumBy cmp = foldl1 \x y -> if cmp x y == LT then x else y + -- | Internal. Used by intercalation functions. newtype JoinWith a = JoinWith (a -> a) diff --git a/src/Data/Semigroup/Traversable.purs b/src/Data/Semigroup/Traversable.purs index e0dce56..c01c671 100644 --- a/src/Data/Semigroup/Traversable.purs +++ b/src/Data/Semigroup/Traversable.purs @@ -2,10 +2,12 @@ module Data.Semigroup.Traversable where import Prelude +import Data.Identity (Identity(..)) import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Semigroup.Foldable (class Foldable1) import Data.Traversable (class Traversable) +import Data.Tuple (Tuple(..)) -- | `Traversable1` represents data structures with a minimum of one element that can be _traversed_, -- | accumulating results and effects in some `Applicative` functor. @@ -42,6 +44,14 @@ instance traversableMultiplicative :: Traversable1 Multiplicative where traverse1 f (Multiplicative x) = Multiplicative <$> f x sequence1 = sequence1Default +instance traversableTuple :: Traversable1 (Tuple a) where + traverse1 f (Tuple x y) = Tuple x <$> f y + sequence1 (Tuple x y) = Tuple x <$> y + +instance traversableIdentity :: Traversable1 Identity where + traverse1 f (Identity x) = Identity <$> f x + sequence1 (Identity x) = Identity <$> x + -- | A default implementation of `traverse1` using `sequence1`. traverse1Default :: forall t a b m diff --git a/src/Data/Traversable.js b/src/Data/Traversable.js index 269ebe1..9f4248c 100644 --- a/src/Data/Traversable.js +++ b/src/Data/Traversable.js @@ -1,8 +1,6 @@ -"use strict"; - // jshint maxparams: 3 -exports.traverseArrayImpl = (function () { +export const traverseArrayImpl = (function () { function array1(a) { return [a]; } diff --git a/src/Data/Traversable.purs b/src/Data/Traversable.purs index 18c8fa4..180bf2f 100644 --- a/src/Data/Traversable.purs +++ b/src/Data/Traversable.purs @@ -12,7 +12,15 @@ module Data.Traversable import Prelude -import Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, product, sequence_, sum, traverse_) +import Control.Apply (lift2) +import Data.Const (Const(..)) +import Data.Either (Either(..)) +import Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, sequence_, sum, traverse_) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Functor.Product (Product(..), product) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..)) import Data.Maybe.First (First(..)) import Data.Maybe.Last (Last(..)) @@ -23,6 +31,7 @@ import Data.Monoid.Dual (Dual(..)) import Data.Monoid.Multiplicative (Multiplicative(..)) import Data.Traversable.Accum (Accum) import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) +import Data.Tuple (Tuple(..)) -- | `Traversable` represents data structures which can be _traversed_, -- | accumulating results and effects in some `Applicative` functor. @@ -96,9 +105,9 @@ instance traversableArray :: Traversable Array where foreign import traverseArrayImpl :: forall m a b - . (m (a -> b) -> m a -> m b) - -> ((a -> b) -> m a -> m b) - -> (a -> m a) + . (forall x y. m (x -> y) -> m x -> m y) + -> (forall x y. (x -> y) -> m x -> m y) + -> (forall x. x -> m x) -> (a -> m b) -> Array a -> m (Array b) @@ -137,6 +146,44 @@ instance traversableMultiplicative :: Traversable Multiplicative where traverse f (Multiplicative x) = Multiplicative <$> f x sequence (Multiplicative x) = Multiplicative <$> x +instance traversableEither :: Traversable (Either a) where + traverse _ (Left x) = pure (Left x) + traverse f (Right x) = Right <$> f x + sequence (Left x) = pure (Left x) + sequence (Right x) = Right <$> x + +instance traversableTuple :: Traversable (Tuple a) where + traverse f (Tuple x y) = Tuple x <$> f y + sequence (Tuple x y) = Tuple x <$> y + +instance traversableIdentity :: Traversable Identity where + traverse f (Identity x) = Identity <$> f x + sequence (Identity x) = Identity <$> x + +instance traversableConst :: Traversable (Const a) where + traverse _ (Const x) = pure (Const x) + sequence (Const x) = pure (Const x) + +instance traversableProduct :: (Traversable f, Traversable g) => Traversable (Product f g) where + traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga) + sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga) + +instance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where + traverse f = coproduct + (map (Coproduct <<< Left) <<< traverse f) + (map (Coproduct <<< Right) <<< traverse f) + sequence = coproduct + (map (Coproduct <<< Left) <<< sequence) + (map (Coproduct <<< Right) <<< sequence) + +instance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where + traverse f (Compose fga) = map Compose $ traverse (traverse f) fga + sequence = traverse identity + +instance traversableApp :: Traversable f => Traversable (App f) where + traverse f (App x) = App <$> traverse f x + sequence (App x) = App <$> sequence x + -- | A version of `traverse` with its arguments flipped. -- | -- | diff --git a/src/Data/TraversableWithIndex.purs b/src/Data/TraversableWithIndex.purs index e8e26de..f09d5e7 100644 --- a/src/Data/TraversableWithIndex.purs +++ b/src/Data/TraversableWithIndex.purs @@ -12,8 +12,16 @@ module Data.TraversableWithIndex import Prelude +import Control.Apply (lift2) +import Data.Const (Const(..)) +import Data.Either (Either(..)) import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.Functor.App (App(..)) +import Data.Functor.Compose (Compose(..)) +import Data.Functor.Coproduct (Coproduct(..), coproduct) +import Data.Functor.Product (Product(..), product) import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) +import Data.Identity (Identity(..)) import Data.Maybe (Maybe) import Data.Maybe.First (First) import Data.Maybe.Last (Last) @@ -25,6 +33,7 @@ import Data.Monoid.Multiplicative (Multiplicative) import Data.Traversable (class Traversable, sequence, traverse) import Data.Traversable.Accum (Accum) import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) +import Data.Tuple (Tuple(..), curry) -- | A `Traversable` with an additional index. @@ -83,6 +92,33 @@ instance traversableWithIndexDisj :: TraversableWithIndex Unit Disj where instance traversableWithIndexMultiplicative :: TraversableWithIndex Unit Multiplicative where traverseWithIndex f = traverse $ f unit +instance traversableWithIndexEither :: TraversableWithIndex Unit (Either a) where + traverseWithIndex _ (Left x) = pure (Left x) + traverseWithIndex f (Right x) = Right <$> f unit x + +instance traversableWithIndexTuple :: TraversableWithIndex Unit (Tuple a) where + traverseWithIndex f (Tuple x y) = Tuple x <$> f unit y + +instance traversableWithIndexIdentity :: TraversableWithIndex Unit Identity where + traverseWithIndex f (Identity x) = Identity <$> f unit x + +instance traversableWithIndexConst :: TraversableWithIndex Void (Const a) where + traverseWithIndex _ (Const x) = pure (Const x) + +instance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where + traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga) + +instance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where + traverseWithIndex f = coproduct + (map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left)) + (map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right)) + +instance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where + traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga + +instance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f) where + traverseWithIndex f (App x) = App <$> traverseWithIndex f x + -- | A version of `traverseWithIndex` with its arguments flipped. -- | -- | diff --git a/test/Main.js b/test/Main.js index f7661fb..fc3b2ff 100644 --- a/test/Main.js +++ b/test/Main.js @@ -1,14 +1,12 @@ -"use strict"; - -exports.arrayFrom1UpTo = function (n) { +export function arrayFrom1UpTo(n) { var result = []; for (var i = 1; i <= n; i++) { result.push(i); } return result; -}; +} -exports.arrayReplicate = function (n) { +export function arrayReplicate(n) { return function (x) { var result = []; for (var i = 1; i <= n; i++) { @@ -16,17 +14,17 @@ exports.arrayReplicate = function (n) { } return result; }; -}; +} -exports.mkNEArray = function (nothing) { +export function mkNEArray(nothing) { return function (just) { return function (arr) { return arr.length > 0 ? just(arr) : nothing; }; }; -}; +} -exports.foldMap1NEArray = function (append) { +export function foldMap1NEArray(append) { return function (f) { return function (arr) { var acc = f(arr[0]); @@ -37,4 +35,4 @@ exports.foldMap1NEArray = function (append) { return acc; }; }; -}; +} diff --git a/test/Main.purs b/test/Main.purs index 5f7da7b..3e9d914 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -13,12 +13,14 @@ import Data.Int (toNumber, pow) import Data.Maybe (Maybe(..)) import Data.Monoid.Additive (Additive(..)) import Data.Newtype (unwrap) -import Data.Semigroup.Foldable (class Foldable1, foldr1, foldl1, fold1Default, foldr1Default, foldl1Default) +import Data.Number (abs) +import Data.Semigroup.Foldable (class Foldable1, foldr1, foldl1, foldr1Default, foldl1Default) +import Data.Semigroup.Foldable as Foldable1 import Data.Traversable (class Traversable, sequenceDefault, traverse, sequence, traverseDefault) import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Effect (Effect, foreachE) import Effect.Console (log) -import Math (abs) +import Performance.Minibench (benchWith) import Test.Assert (assert, assert') import Unsafe.Coerce (unsafeCoerce) @@ -35,10 +37,9 @@ instance foldableNEArray :: Foldable NEArray where foldr f = foldrDefault f instance foldable1NEArray :: Foldable1 NEArray where - foldMap1 = foldMap1NEArray append - fold1 = fold1Default foldr1 f = foldr1Default f foldl1 f = foldl1Default f + foldMap1 = foldMap1NEArray append maybeMkNEArray :: forall a. Array a -> Maybe (NEArray a) maybeMkNEArray = mkNEArray Nothing Just @@ -58,26 +59,38 @@ main = do assert $ foldMapDefaultL (\x -> [x]) [1, 2] == [1, 2] log "Test foldableArray instance is stack safe" - testFoldableArrayWith 20000 + testFoldableArrayWith 20_000 log "Test foldMapDefaultL" testFoldableFoldMapDefaultL 20 + log "Test foldMapDefaultL is stack safe" + testFoldableFoldMapDefaultL 20_000 + log "Test foldMapDefaultR" testFoldableFoldMapDefaultR 20 + log "Test foldMapDefaultR is stack safe" + testFoldableFoldMapDefaultR 20_000 + log "Test foldlDefault" testFoldableFoldlDefault 20 + log "Test foldlDefault is stack safe" + testFoldableFoldlDefault 20_000 + log "Test foldrDefault" testFoldableFoldrDefault 20 + log "Test foldrDefault is stack safe" + testFoldableFoldrDefault 20_000 + foreachE [1,2,3,4,5,10,20] \i -> do log $ "Test traversableArray instance with an array of size: " <> show i testTraversableArrayWith i log "Test traversableArray instance is stack safe" - testTraversableArrayWith 20000 + testTraversableArrayWith 20_000 log "Test traverseDefault" testTraverseDefault 20 @@ -89,7 +102,7 @@ main = do testFoldableWithIndexArrayWith 20 log "Test foldableWithIndexArray instance is stack safe" - testFoldableWithIndexArrayWith 20000 + testFoldableWithIndexArrayWith 20_000 log "Test FoldableWithIndex laws for array instance" testFoldableWithIndexLawsOn @@ -200,6 +213,18 @@ main = do assert $ "(a(b(cd)))" == foldMap (foldr1 (\x y -> "(" <> x <> y <> ")")) (maybeMkNEArray ["a", "b", "c", "d"]) assert $ "(((ab)c)d)" == foldMap (foldl1 (\x y -> "(" <> x <> y <> ")")) (maybeMkNEArray ["a", "b", "c", "d"]) + log "Test maximumBy" + assert $ + (Foldable1.maximumBy (compare `on` abs) <$> + (maybeMkNEArray (negate <<< toNumber <$> arrayFrom1UpTo 10))) + == Just (-10.0) + + log "Test minimumBy" + assert $ + (Foldable1.minimumBy (compare `on` abs) <$> + (maybeMkNEArray (negate <<< toNumber <$> arrayFrom1UpTo 10))) + == Just (-1.0) + log "All done!" @@ -425,26 +450,26 @@ instance eqIOr :: (Eq l, Eq r) => Eq (IOr l r) where instance bifoldableIOr :: Bifoldable IOr where bifoldr l r u (Both fst snd) = l fst (r snd u) - bifoldr l r u (Fst fst) = l fst u - bifoldr l r u (Snd snd) = r snd u + bifoldr l _ u (Fst fst) = l fst u + bifoldr _ r u (Snd snd) = r snd u bifoldl l r u (Both fst snd) = r (l u fst) snd - bifoldl l r u (Fst fst) = l u fst - bifoldl l r u (Snd snd) = r u snd + bifoldl l _ u (Fst fst) = l u fst + bifoldl _ r u (Snd snd) = r u snd bifoldMap l r (Both fst snd) = l fst <> r snd - bifoldMap l r (Fst fst) = l fst - bifoldMap l r (Snd snd) = r snd + bifoldMap l _ (Fst fst) = l fst + bifoldMap _ r (Snd snd) = r snd instance bifunctorIOr :: Bifunctor IOr where bimap f g (Both fst snd) = Both (f fst) (g snd) - bimap f g (Fst fst) = Fst (f fst) - bimap f g (Snd snd) = Snd (g snd) + bimap f _ (Fst fst) = Fst (f fst) + bimap _ g (Snd snd) = Snd (g snd) instance bitraversableIOr :: Bitraversable IOr where bitraverse f g (Both fst snd) = Both <$> f fst <*> g snd - bitraverse f g (Fst fst) = Fst <$> f fst - bitraverse f g (Snd snd) = Snd <$> g snd + bitraverse f _ (Fst fst) = Fst <$> f fst + bitraverse _ g (Snd snd) = Snd <$> g snd bisequence (Both fst snd) = Both <$> fst <*> snd bisequence (Fst fst) = Fst <$> fst @@ -549,3 +574,22 @@ instance bitraversableBTD :: Bitraversable BitraverseDefault where instance bitraversableBSD :: Bitraversable BisequenceDefault where bitraverse f g (BSD m) = map BSD (bitraverse f g m) bisequence m = bisequenceDefault m + + +benchmarkDefaultFolds :: Effect Unit +benchmarkDefaultFolds = do + let + sm = arrayFrom1UpTo 1_000 + m = arrayFrom1UpTo 10_000 + lg = arrayFrom1UpTo 100_000 + xl = arrayFrom1UpTo 1_000_000 + + log "\nbenching 1,000" + benchWith 1000 $ \_ -> foldrDefault (+) 0 sm + log "\nbenching 10,000" + benchWith 1000 $ \_ -> foldrDefault (+) 0 m + log "\nbenching 100,000" + benchWith 100 $ \_ -> foldrDefault (+) 0 lg + log "\nbenching 1,000,000" + benchWith 50 $ \_ -> foldrDefault (+) 0 xl +