├── .eslintrc.json ├── .github ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bower.json ├── package.json ├── src └── Data │ ├── Bifoldable.purs │ ├── Bitraversable.purs │ ├── Foldable.js │ ├── Foldable.purs │ ├── FoldableWithIndex.purs │ ├── FunctorWithIndex.js │ ├── FunctorWithIndex.purs │ ├── Semigroup │ ├── Foldable.purs │ └── Traversable.purs │ ├── Traversable.js │ ├── Traversable.purs │ ├── Traversable │ ├── Accum.purs │ └── Accum │ │ └── Internal.purs │ └── TraversableWithIndex.purs └── test ├── Main.js └── Main.purs /.eslintrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "parserOptions": { 3 | "ecmaVersion": 6, 4 | "sourceType": "module" 5 | }, 6 | "extends": "eslint:recommended", 7 | "rules": { 8 | "strict": [2, "global"], 9 | "block-scoped-var": 2, 10 | "consistent-return": 2, 11 | "eqeqeq": [2, "smart"], 12 | "guard-for-in": 2, 13 | "no-caller": 2, 14 | "no-extend-native": 2, 15 | "no-loop-func": 2, 16 | "no-new": 2, 17 | "no-param-reassign": 2, 18 | "no-return-assign": 2, 19 | "no-unused-expressions": 2, 20 | "no-use-before-define": 2, 21 | "radix": [2, "always"], 22 | "indent": [2, 2], 23 | "quotes": [2, "double"], 24 | "semi": [2, "always"] 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | 3 | 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. 4 | 5 | --- 6 | 7 | **Checklist:** 8 | 9 | - [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") 10 | - [ ] Linked any existing issues or proposals that this pull request should close 11 | - [ ] Updated or added relevant documentation 12 | - [ ] Added a test for the contribution (if applicable) 13 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | branches: [master] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@main 16 | with: 17 | purescript: "unstable" 18 | 19 | - uses: actions/setup-node@v2 20 | with: 21 | node-version: "14.x" 22 | 23 | - name: Install dependencies 24 | run: | 25 | npm install -g bower 26 | npm install 27 | bower install --production 28 | 29 | - name: Build source 30 | run: npm run-script build 31 | 32 | - name: Run tests 33 | run: | 34 | bower install 35 | npm run-script test --if-present 36 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.* 2 | !/.gitignore 3 | !/.eslintrc.json 4 | !/.github/ 5 | /bower_components/ 6 | /node_modules/ 7 | /output/ 8 | package-lock.json 9 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | 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). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | - Make `foldrDefault` and `foldlDefault` stack safe (#148) 15 | 16 | ## [v6.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v6.0.0) - 2022-04-27 17 | 18 | Breaking changes: 19 | - Migrate FFI to ES modules (#146 by @kl0tl and @JordanMartinez) 20 | - Drop deprecated `foldMap1Default` (#147 by @JordanMartinez) 21 | 22 | New features: 23 | 24 | Bugfixes: 25 | 26 | Other improvements: 27 | - Narrow down unnecessarily imprecise type of `mapWithIndexArray` (#145) 28 | 29 | ## [v5.0.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v5.0.1) - 2021-04-20 30 | 31 | Other improvements: 32 | - Fix warnings revealed by v0.14.1 PureScript release (#135 by @JordanMartinez) 33 | 34 | ## [v5.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v5.0.0) - 2021-02-26 35 | 36 | Breaking changes: 37 | - Added support for PureScript 0.14 and dropped support for all previous versions (#120) 38 | - Removed `fold1Default` and deprecated `foldMap1Default` (#128) 39 | 40 | New features: 41 | - Added `findMapWithIndex` (#119) 42 | - Added `foldr1`, `foldl1`, `foldr1Default`, `foldl1Default`, `foldMap1DefaultR`, `foldMap1DefaultL` (#121, #128) 43 | - Added `maximumBy` and `minimumBy` to `Data.Semigroup.Foldable` (#123) 44 | - Added `lookup` to `Data.Foldable`; this function previously lived in `Data.Tuple` in the `purescript-tuples` package (#131) 45 | 46 | Bugfixes: 47 | 48 | Other improvements: 49 | - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#127) 50 | - Added a CHANGELOG.md file and pull request template (#129, #130) 51 | - Wrapped `traverseArrayImpl` IIFE in parentheses (#52) 52 | - Added examples for `sequence` and `traverse` (#115) 53 | - Changed `foldM` type signature to more closely match `foldl` (#111) 54 | - 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) 55 | 56 | ## [v4.1.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.1.1) - 2018-11-23 57 | 58 | Added examples to documentation for `intercalate` (@shmish111) 59 | 60 | ## [v4.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.1.0) - 2018-10-05 61 | 62 | - Added missing exports for `minimum` and `maximum` from `Data.Semigroup.Foldable` (@paluh) 63 | 64 | ## [v4.0.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.0.1) - 2018-09-19 65 | 66 | - Fixed totally wrong example in the documentation for `scanr`! (@ewaldgrusk) 67 | 68 | ## [v4.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v4.0.0) - 2018-05-23 69 | 70 | - Updated for PureScript 0.12 71 | - `traverse` for `Array` is now divide-and-conquer (@S11001001) 72 | - `findWithIndex` returns both index and value of the found item (@mbid) 73 | - Added `Traversable1` instances for `Dual` and `Multiplicative` (@matthewleon) 74 | - Added `minimum` and `maximum` for `Foldable1` (@colehaus) 75 | - Added functions for default `Foldable` implementations based on `FoldableWithIndex` (@matthewleon) 76 | - Added `intercalate` and `intercalateMap` for `Foldable1` (@matthewleon) 77 | 78 | ## [v3.7.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.7.1) - 2018-01-10 79 | 80 | - Fixed shadowed name warnings 81 | 82 | ## [v3.7.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.7.0) - 2018-01-09 83 | 84 | - Added `indexl` and `indexr` for `Foldable`s (@safareli) 85 | 86 | ## [v3.6.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.6.1) - 2017-09-18 87 | 88 | Fix test for `foldrDefault` (@tekerson) 89 | 90 | ## [v3.6.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.6.0) - 2017-08-18 91 | 92 | Export `oneOfMap` (@natefaubion) 93 | 94 | ## [v3.5.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.5.0) - 2017-08-18 95 | 96 | Add `oneOfMap` (@natefaubion) 97 | 98 | ## [v3.4.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.4.0) - 2017-07-10 99 | 100 | Add `FunctorWithIndex`, `FoldableWithIndex` and `TraversableWithIndex` classes (@mbid) 101 | 102 | ## [v3.3.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.3.1) - 2017-06-21 103 | 104 | Fix `foldMapDefaultL` (@mbid) 105 | 106 | ## [v3.3.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.3.0) - 2017-06-04 107 | 108 | Add `Foldable1` and `Traversable1` (@LukaJCB) 109 | 110 | ## [v3.2.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.2.0) - 2017-06-03 111 | 112 | Add a generic `foldM` which works with any `Foldable`. (@clayrat) 113 | 114 | ## [v3.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.1.0) - 2017-06-03 115 | 116 | Add `surroundMap` and `surround` (@LiamGoodacre) 117 | 118 | ## [v3.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v3.0.0) - 2017-03-26 119 | 120 | - Updated for PureScript 0.11 121 | - Added `null` for `Foldable` (@matthewleon) 122 | - Added `length` for `Foldable` (@matthewleon) 123 | - Eta-reduced some functions (@mlang) 124 | 125 | ## [v2.2.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v2.2.0) - 2017-02-06 126 | 127 | - Added instances for the `Bifunctor` newtypes (@LiamGoodacre) 128 | 129 | ## [v2.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v2.1.0) - 2017-01-16 130 | 131 | - Added left-only and right-only varieties of `bitraverse`/`bifor` 132 | 133 | ## [v2.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v2.0.0) - 2016-10-02 134 | 135 | - Added `findMap` (@LiamGoodacre) 136 | - Relaxed `and`, `or`, `any`, `all` to `HeytingAlgebra` from `BooleanAlgebra` 137 | - Updated dependencies 138 | 139 | ## [v1.0.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0) - 2016-06-01 140 | 141 | This release is intended for the PureScript 0.9.1 compiler and newer. 142 | 143 | **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. 144 | 145 | ## [v1.0.0-rc.3](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0-rc.3) - 2016-05-24 146 | 147 | - Fixes for the upcoming psc 0.9.1 148 | 149 | ## [v1.0.0-rc.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0-rc.2) - 2016-05-20 150 | 151 | - Updated dependencies 152 | - `find` now returns the first value matching the predicate 153 | 154 | ## [v1.0.0-rc.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v1.0.0-rc.1) - 2016-03-13 155 | 156 | - Release candidate for the psc 0.8+ core libraries 157 | 158 | ## [v0.4.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.2) - 2015-11-30 159 | 160 | - `maximum`, `minimum`, `maximumBy`, `minimumBy` (@hdgarrood) 161 | 162 | ## [v0.4.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.1) - 2015-11-01 163 | 164 | - Removed unused imports 165 | 166 | ## [v0.4.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.0) - 2015-06-30 167 | 168 | 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. 169 | 170 | ## [v0.4.0-rc.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.0-rc.2) - 2015-06-06 171 | 172 | - Fixed behaviour of `foldr` for `Array`. 173 | 174 | ## [v0.4.0-rc.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.4.0-rc.1) - 2015-06-06 175 | 176 | Initial release candidate of the library intended for the 0.7 compiler. 177 | 178 | ## [v0.3.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.3.1) - 2015-03-19 179 | 180 | Updated docs 181 | 182 | ## [v0.3.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.3.0) - 2015-02-21 183 | 184 | **This release requires PureScript v0.6.8 or later** 185 | - Updated dependencies 186 | - Added `Foldable` and `Traversable` instances for the `Additive`, `Dual`, `First`, `Last`, and `Multiplicative` monoids 187 | 188 | ## [v0.2.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.2.1) - 2014-12-18 189 | 190 | - Added `scanl` and `scanr` (@paf31) 191 | 192 | ## [v0.2.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.2.0) - 2014-12-17 193 | 194 | - Removed instance for deprecated `Ref` type 195 | 196 | ## [v0.1.6](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.6) - 2014-12-11 197 | 198 | 199 | 200 | ## [v0.1.5](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.5) - 2014-12-02 201 | 202 | - Added `mapAccumL` and `mapAccumR`. 203 | 204 | ## [v0.1.4](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.4) - 2014-10-24 205 | 206 | - Added `intercalate` to `Data.Foldable` (@garyb) 207 | 208 | ## [v0.1.3](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.3) - 2014-07-14 209 | 210 | 211 | 212 | ## [v0.1.2](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.2) - 2014-06-14 213 | 214 | - Now uses "proper" `Unit` type instead of `{}` (garyb) 215 | - Removed implied `Functor` constraint from some types that are `Applicative` (garyb) 216 | 217 | ## [v0.1.1](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.1) - 2014-05-24 218 | 219 | - Added `lookup` (paf31) 220 | 221 | ## [v0.1.0](https://github.com/purescript/purescript-foldable-traversable/releases/tag/v0.1.0) - 2014-04-25 222 | 223 | 224 | 225 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2018 PureScript 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation and/or 11 | other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-foldable-traversable 2 | 3 | [![Latest release](http://img.shields.io/github/release/purescript/purescript-foldable-traversable.svg)](https://github.com/purescript/purescript-foldable-traversable/releases) 4 | [![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) 5 | [![Pursuit](https://pursuit.purescript.org/packages/purescript-foldable-traversable/badge)](https://pursuit.purescript.org/packages/purescript-foldable-traversable) 6 | 7 | Classes for foldable and traversable data structures. 8 | 9 | ## Installation 10 | 11 | ``` 12 | spago install foldable-traversable 13 | ``` 14 | 15 | ## Documentation 16 | 17 | Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-foldable-traversable). 18 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-foldable-traversable", 3 | "homepage": "https://github.com/purescript/purescript-foldable-traversable", 4 | "description": "Classes for foldable and traversable data structures", 5 | "license": "BSD-3-Clause", 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/purescript/purescript-foldable-traversable.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "bower_components", 13 | "node_modules", 14 | "output", 15 | "test", 16 | "bower.json", 17 | "package.json" 18 | ], 19 | "dependencies": { 20 | "purescript-bifunctors": "^6.0.0", 21 | "purescript-const": "^6.0.0", 22 | "purescript-control": "^6.0.0", 23 | "purescript-either": "^6.0.0", 24 | "purescript-functors": "^5.0.0", 25 | "purescript-identity": "^6.0.0", 26 | "purescript-maybe": "^6.0.0", 27 | "purescript-newtype": "^5.0.0", 28 | "purescript-orders": "^6.0.0", 29 | "purescript-prelude": "^6.0.0", 30 | "purescript-tuples": "^7.0.0" 31 | }, 32 | "devDependencies": { 33 | "purescript-assert": "^6.0.0", 34 | "purescript-console": "^6.0.0", 35 | "purescript-integers": "^6.0.0", 36 | "purescript-unsafe-coerce": "^6.0.0", 37 | "purescript-minibench": "^4.0.0" 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "eslint src && pulp build -- --censor-lib --strict", 6 | "test": "pulp test" 7 | }, 8 | "devDependencies": { 9 | "eslint": "^7.15.0", 10 | "pulp": "16.0.0-0", 11 | "purescript-psa": "^0.8.2", 12 | "rimraf": "^3.0.2" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /src/Data/Bifoldable.purs: -------------------------------------------------------------------------------- 1 | module Data.Bifoldable where 2 | 3 | import Prelude 4 | 5 | import Control.Apply (applySecond) 6 | import Data.Const (Const(..)) 7 | import Data.Either (Either(..)) 8 | import Data.Foldable (class Foldable, foldr, foldl, foldMap) 9 | import Data.Functor.Clown (Clown(..)) 10 | import Data.Functor.Flip (Flip(..)) 11 | import Data.Functor.Joker (Joker(..)) 12 | import Data.Functor.Product2 (Product2(..)) 13 | import Data.Monoid.Conj (Conj(..)) 14 | import Data.Monoid.Disj (Disj(..)) 15 | import Data.Monoid.Dual (Dual(..)) 16 | import Data.Monoid.Endo (Endo(..)) 17 | import Data.Newtype (unwrap) 18 | import Data.Tuple (Tuple(..)) 19 | 20 | -- | `Bifoldable` represents data structures with two type arguments which can be 21 | -- | folded. 22 | -- | 23 | -- | A fold for such a structure requires two step functions, one for each type 24 | -- | argument. Type class instances should choose the appropriate step function based 25 | -- | on the type of the element encountered at each point of the fold. 26 | -- | 27 | -- | Default implementations are provided by the following functions: 28 | -- | 29 | -- | - `bifoldrDefault` 30 | -- | - `bifoldlDefault` 31 | -- | - `bifoldMapDefaultR` 32 | -- | - `bifoldMapDefaultL` 33 | -- | 34 | -- | Note: some combinations of the default implementations are unsafe to 35 | -- | use together - causing a non-terminating mutually recursive cycle. 36 | -- | These combinations are documented per function. 37 | class Bifoldable p where 38 | bifoldr :: forall a b c. (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c 39 | bifoldl :: forall a b c. (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c 40 | bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> p a b -> m 41 | 42 | instance bifoldableClown :: Foldable f => Bifoldable (Clown f) where 43 | bifoldr l _ u (Clown f) = foldr l u f 44 | bifoldl l _ u (Clown f) = foldl l u f 45 | bifoldMap l _ (Clown f) = foldMap l f 46 | 47 | instance bifoldableJoker :: Foldable f => Bifoldable (Joker f) where 48 | bifoldr _ r u (Joker f) = foldr r u f 49 | bifoldl _ r u (Joker f) = foldl r u f 50 | bifoldMap _ r (Joker f) = foldMap r f 51 | 52 | instance bifoldableFlip :: Bifoldable p => Bifoldable (Flip p) where 53 | bifoldr r l u (Flip p) = bifoldr l r u p 54 | bifoldl r l u (Flip p) = bifoldl l r u p 55 | bifoldMap r l (Flip p) = bifoldMap l r p 56 | 57 | instance bifoldableProduct2 :: (Bifoldable f, Bifoldable g) => Bifoldable (Product2 f g) where 58 | bifoldr l r u m = bifoldrDefault l r u m 59 | bifoldl l r u m = bifoldlDefault l r u m 60 | bifoldMap l r (Product2 f g) = bifoldMap l r f <> bifoldMap l r g 61 | 62 | instance bifoldableEither :: Bifoldable Either where 63 | bifoldr f _ z (Left a) = f a z 64 | bifoldr _ g z (Right b) = g b z 65 | bifoldl f _ z (Left a) = f z a 66 | bifoldl _ g z (Right b) = g z b 67 | bifoldMap f _ (Left a) = f a 68 | bifoldMap _ g (Right b) = g b 69 | 70 | instance bifoldableTuple :: Bifoldable Tuple where 71 | bifoldMap f g (Tuple a b) = f a <> g b 72 | bifoldr f g z (Tuple a b) = f a (g b z) 73 | bifoldl f g z (Tuple a b) = g (f z a) b 74 | 75 | instance bifoldableConst :: Bifoldable Const where 76 | bifoldr f _ z (Const a) = f a z 77 | bifoldl f _ z (Const a) = f z a 78 | bifoldMap f _ (Const a) = f a 79 | 80 | -- | A default implementation of `bifoldr` using `bifoldMap`. 81 | -- | 82 | -- | Note: when defining a `Bifoldable` instance, this function is unsafe to 83 | -- | use in combination with `bifoldMapDefaultR`. 84 | bifoldrDefault 85 | :: forall p a b c 86 | . Bifoldable p 87 | => (a -> c -> c) 88 | -> (b -> c -> c) 89 | -> c 90 | -> p a b 91 | -> c 92 | bifoldrDefault f g z p = unwrap (bifoldMap (Endo <<< f) (Endo <<< g) p) z 93 | 94 | -- | A default implementation of `bifoldl` using `bifoldMap`. 95 | -- | 96 | -- | Note: when defining a `Bifoldable` instance, this function is unsafe to 97 | -- | use in combination with `bifoldMapDefaultL`. 98 | bifoldlDefault 99 | :: forall p a b c 100 | . Bifoldable p 101 | => (c -> a -> c) 102 | -> (c -> b -> c) 103 | -> c 104 | -> p a b 105 | -> c 106 | bifoldlDefault f g z p = 107 | unwrap 108 | (unwrap 109 | (bifoldMap (Dual <<< Endo <<< flip f) (Dual <<< Endo <<< flip g) p)) 110 | z 111 | 112 | -- | A default implementation of `bifoldMap` using `bifoldr`. 113 | -- | 114 | -- | Note: when defining a `Bifoldable` instance, this function is unsafe to 115 | -- | use in combination with `bifoldrDefault`. 116 | bifoldMapDefaultR 117 | :: forall p m a b 118 | . Bifoldable p 119 | => Monoid m 120 | => (a -> m) 121 | -> (b -> m) 122 | -> p a b 123 | -> m 124 | bifoldMapDefaultR f g = bifoldr (append <<< f) (append <<< g) mempty 125 | 126 | -- | A default implementation of `bifoldMap` using `bifoldl`. 127 | -- | 128 | -- | Note: when defining a `Bifoldable` instance, this function is unsafe to 129 | -- | use in combination with `bifoldlDefault`. 130 | bifoldMapDefaultL 131 | :: forall p m a b 132 | . Bifoldable p 133 | => Monoid m 134 | => (a -> m) 135 | -> (b -> m) 136 | -> p a b 137 | -> m 138 | bifoldMapDefaultL f g = bifoldl (\m a -> m <> f a) (\m b -> m <> g b) mempty 139 | 140 | 141 | -- | Fold a data structure, accumulating values in a monoidal type. 142 | bifold :: forall t m. Bifoldable t => Monoid m => t m m -> m 143 | bifold = bifoldMap identity identity 144 | 145 | -- | Traverse a data structure, accumulating effects using an `Applicative` functor, 146 | -- | ignoring the final result. 147 | bitraverse_ 148 | :: forall t f a b c d 149 | . Bifoldable t 150 | => Applicative f 151 | => (a -> f c) 152 | -> (b -> f d) 153 | -> t a b 154 | -> f Unit 155 | bitraverse_ f g = bifoldr (applySecond <<< f) (applySecond <<< g) (pure unit) 156 | 157 | -- | A version of `bitraverse_` with the data structure as the first argument. 158 | bifor_ 159 | :: forall t f a b c d 160 | . Bifoldable t 161 | => Applicative f 162 | => t a b 163 | -> (a -> f c) 164 | -> (b -> f d) 165 | -> f Unit 166 | bifor_ t f g = bitraverse_ f g t 167 | 168 | -- | Collapse a data structure, collecting effects using an `Applicative` functor, 169 | -- | ignoring the final result. 170 | bisequence_ 171 | :: forall t f a b 172 | . Bifoldable t 173 | => Applicative f 174 | => t (f a) (f b) 175 | -> f Unit 176 | bisequence_ = bitraverse_ identity identity 177 | 178 | -- | Test whether a predicate holds at any position in a data structure. 179 | biany 180 | :: forall t a b c 181 | . Bifoldable t 182 | => BooleanAlgebra c 183 | => (a -> c) 184 | -> (b -> c) 185 | -> t a b 186 | -> c 187 | biany p q = unwrap <<< bifoldMap (Disj <<< p) (Disj <<< q) 188 | 189 | -- | Test whether a predicate holds at all positions in a data structure. 190 | biall 191 | :: forall t a b c 192 | . Bifoldable t 193 | => BooleanAlgebra c 194 | => (a -> c) 195 | -> (b -> c) 196 | -> t a b 197 | -> c 198 | biall p q = unwrap <<< bifoldMap (Conj <<< p) (Conj <<< q) 199 | -------------------------------------------------------------------------------- /src/Data/Bitraversable.purs: -------------------------------------------------------------------------------- 1 | module Data.Bitraversable 2 | ( class Bitraversable, bitraverse, bisequence 3 | , bitraverseDefault 4 | , bisequenceDefault 5 | , ltraverse 6 | , rtraverse 7 | , bifor 8 | , lfor 9 | , rfor 10 | , module Data.Bifoldable 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Data.Bifoldable (class Bifoldable, biall, biany, bifold, bifoldMap, bifoldMapDefaultL, bifoldMapDefaultR, bifoldl, bifoldlDefault, bifoldr, bifoldrDefault, bifor_, bisequence_, bitraverse_) 16 | import Data.Traversable (class Traversable, traverse, sequence) 17 | import Data.Bifunctor (class Bifunctor, bimap) 18 | import Data.Const (Const(..)) 19 | import Data.Either (Either(..)) 20 | import Data.Functor.Clown (Clown(..)) 21 | import Data.Functor.Flip (Flip(..)) 22 | import Data.Functor.Joker (Joker(..)) 23 | import Data.Functor.Product2 (Product2(..)) 24 | import Data.Tuple (Tuple(..)) 25 | 26 | -- | `Bitraversable` represents data structures with two type arguments which can be 27 | -- | traversed. 28 | -- | 29 | -- | A traversal for such a structure requires two functions, one for each type 30 | -- | argument. Type class instances should choose the appropriate function based 31 | -- | on the type of the element encountered at each point of the traversal. 32 | -- | 33 | -- | Default implementations are provided by the following functions: 34 | -- | 35 | -- | - `bitraverseDefault` 36 | -- | - `bisequenceDefault` 37 | class (Bifunctor t, Bifoldable t) <= Bitraversable t where 38 | bitraverse :: forall f a b c d. Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) 39 | bisequence :: forall f a b. Applicative f => t (f a) (f b) -> f (t a b) 40 | 41 | instance bitraversableClown :: Traversable f => Bitraversable (Clown f) where 42 | bitraverse l _ (Clown f) = Clown <$> traverse l f 43 | bisequence (Clown f) = Clown <$> sequence f 44 | 45 | instance bitraversableJoker :: Traversable f => Bitraversable (Joker f) where 46 | bitraverse _ r (Joker f) = Joker <$> traverse r f 47 | bisequence (Joker f) = Joker <$> sequence f 48 | 49 | instance bitraversableFlip :: Bitraversable p => Bitraversable (Flip p) where 50 | bitraverse r l (Flip p) = Flip <$> bitraverse l r p 51 | bisequence (Flip p) = Flip <$> bisequence p 52 | 53 | instance bitraversableProduct2 :: (Bitraversable f, Bitraversable g) => Bitraversable (Product2 f g) where 54 | bitraverse l r (Product2 f g) = Product2 <$> bitraverse l r f <*> bitraverse l r g 55 | bisequence (Product2 f g) = Product2 <$> bisequence f <*> bisequence g 56 | 57 | instance bitraversableEither :: Bitraversable Either where 58 | bitraverse f _ (Left a) = Left <$> f a 59 | bitraverse _ g (Right b) = Right <$> g b 60 | bisequence (Left a) = Left <$> a 61 | bisequence (Right b) = Right <$> b 62 | 63 | instance bitraversableTuple :: Bitraversable Tuple where 64 | bitraverse f g (Tuple a b) = Tuple <$> f a <*> g b 65 | bisequence (Tuple a b) = Tuple <$> a <*> b 66 | 67 | instance bitraversableConst :: Bitraversable Const where 68 | bitraverse f _ (Const a) = Const <$> f a 69 | bisequence (Const a) = Const <$> a 70 | 71 | ltraverse 72 | :: forall t b c a f 73 | . Bitraversable t 74 | => Applicative f 75 | => (a -> f c) 76 | -> t a b 77 | -> f (t c b) 78 | ltraverse f = bitraverse f pure 79 | 80 | rtraverse 81 | :: forall t b c a f 82 | . Bitraversable t 83 | => Applicative f 84 | => (b -> f c) 85 | -> t a b 86 | -> f (t a c) 87 | rtraverse = bitraverse pure 88 | 89 | -- | A default implementation of `bitraverse` using `bisequence` and `bimap`. 90 | bitraverseDefault 91 | :: forall t f a b c d 92 | . Bitraversable t 93 | => Applicative f 94 | => (a -> f c) 95 | -> (b -> f d) 96 | -> t a b 97 | -> f (t c d) 98 | bitraverseDefault f g t = bisequence (bimap f g t) 99 | 100 | -- | A default implementation of `bisequence` using `bitraverse`. 101 | bisequenceDefault 102 | :: forall t f a b 103 | . Bitraversable t 104 | => Applicative f 105 | => t (f a) (f b) 106 | -> f (t a b) 107 | bisequenceDefault = bitraverse identity identity 108 | 109 | -- | Traverse a data structure, accumulating effects and results using an `Applicative` functor. 110 | bifor 111 | :: forall t f a b c d 112 | . Bitraversable t 113 | => Applicative f 114 | => t a b 115 | -> (a -> f c) 116 | -> (b -> f d) 117 | -> f (t c d) 118 | bifor t f g = bitraverse f g t 119 | 120 | lfor 121 | :: forall t b c a f 122 | . Bitraversable t 123 | => Applicative f 124 | => t a b 125 | -> (a -> f c) 126 | -> f (t c b) 127 | lfor t f = bitraverse f pure t 128 | 129 | rfor 130 | :: forall t b c a f 131 | . Bitraversable t 132 | => Applicative f 133 | => t a b 134 | -> (b -> f c) 135 | -> f (t a c) 136 | rfor t f = bitraverse pure f t 137 | -------------------------------------------------------------------------------- /src/Data/Foldable.js: -------------------------------------------------------------------------------- 1 | export const foldrArray = function (f) { 2 | return function (init) { 3 | return function (xs) { 4 | var acc = init; 5 | var len = xs.length; 6 | for (var i = len - 1; i >= 0; i--) { 7 | acc = f(xs[i])(acc); 8 | } 9 | return acc; 10 | }; 11 | }; 12 | }; 13 | 14 | export const foldlArray = function (f) { 15 | return function (init) { 16 | return function (xs) { 17 | var acc = init; 18 | var len = xs.length; 19 | for (var i = 0; i < len; i++) { 20 | acc = f(acc)(xs[i]); 21 | } 22 | return acc; 23 | }; 24 | }; 25 | }; 26 | -------------------------------------------------------------------------------- /src/Data/Foldable.purs: -------------------------------------------------------------------------------- 1 | module Data.Foldable 2 | ( class Foldable, foldr, foldl, foldMap 3 | , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR 4 | , fold 5 | , foldM 6 | , traverse_ 7 | , for_ 8 | , sequence_ 9 | , oneOf 10 | , oneOfMap 11 | , intercalate 12 | , surroundMap 13 | , surround 14 | , and 15 | , or 16 | , all 17 | , any 18 | , sum 19 | , product 20 | , elem 21 | , notElem 22 | , indexl 23 | , indexr 24 | , find 25 | , findMap 26 | , maximum 27 | , maximumBy 28 | , minimum 29 | , minimumBy 30 | , null 31 | , length 32 | , lookup 33 | ) where 34 | 35 | import Prelude 36 | 37 | import Control.Plus (class Plus, alt, empty) 38 | import Data.Const (Const) 39 | import Data.Either (Either(..)) 40 | import Data.Functor.App (App(..)) 41 | import Data.Functor.Compose (Compose(..)) 42 | import Data.Functor.Coproduct (Coproduct, coproduct) 43 | import Data.Functor.Product (Product(..)) 44 | import Data.Identity (Identity(..)) 45 | import Data.Maybe (Maybe(..)) 46 | import Data.Maybe.First (First(..)) 47 | import Data.Maybe.Last (Last(..)) 48 | import Data.Monoid.Additive (Additive(..)) 49 | import Data.Monoid.Conj (Conj(..)) 50 | import Data.Monoid.Disj (Disj(..)) 51 | import Data.Monoid.Dual (Dual(..)) 52 | import Data.Monoid.Endo (Endo(..)) 53 | import Data.Monoid.Multiplicative (Multiplicative(..)) 54 | import Data.Newtype (alaF, unwrap) 55 | import Data.Tuple (Tuple(..)) 56 | 57 | -- | `Foldable` represents data structures which can be _folded_. 58 | -- | 59 | -- | - `foldr` folds a structure from the right 60 | -- | - `foldl` folds a structure from the left 61 | -- | - `foldMap` folds a structure by accumulating values in a `Monoid` 62 | -- | 63 | -- | Default implementations are provided by the following functions: 64 | -- | 65 | -- | - `foldrDefault` 66 | -- | - `foldlDefault` 67 | -- | - `foldMapDefaultR` 68 | -- | - `foldMapDefaultL` 69 | -- | 70 | -- | Note: some combinations of the default implementations are unsafe to 71 | -- | use together - causing a non-terminating mutually recursive cycle. 72 | -- | These combinations are documented per function. 73 | class Foldable f where 74 | foldr :: forall a b. (a -> b -> b) -> b -> f a -> b 75 | foldl :: forall a b. (b -> a -> b) -> b -> f a -> b 76 | foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m 77 | 78 | 79 | -- | This internal type is used just to implement a stack-safe and performant foldrDefault and foldlDefault. 80 | -- | It has O(1) append (because foldrDefault and foldlDefault are implemented in terms of foldMap), and 81 | -- | an amortized O(1) uncons/unsnoc. It behaves similarly to a CatList 82 | data FreeMonoidTree a = Empty | Node a | Append (FreeMonoidTree a) (FreeMonoidTree a) 83 | 84 | instance Foldable FreeMonoidTree where 85 | -- these folding implementations could be written more plainly, but are optimized to minimize conditionals. 86 | foldl fn = (\a b -> go a b Empty) 87 | where 88 | go acc lhs rhs = 89 | case lhs of 90 | Node a -> go (fn acc a) rhs Empty 91 | Append xs ys -> 92 | case ys of 93 | Empty -> go acc xs rhs 94 | _ -> 95 | case rhs of 96 | Empty -> go acc xs ys 97 | _ -> go acc xs (Append ys rhs) 98 | Empty -> 99 | case rhs of 100 | Empty -> acc 101 | _ -> go acc rhs Empty 102 | 103 | foldr fn = (\a b -> go a Empty b) 104 | where 105 | go acc lhs rhs = 106 | case rhs of 107 | Node a -> go (fn a acc) Empty lhs 108 | Append xs ys -> 109 | case xs of 110 | Empty -> go acc lhs ys 111 | _ -> 112 | case lhs of 113 | Empty -> go acc xs ys 114 | _ -> go acc (Append lhs xs) ys 115 | Empty -> 116 | case lhs of 117 | Empty -> acc 118 | _ -> go acc Empty lhs 119 | 120 | 121 | foldMap = foldMapDefaultR 122 | 123 | instance Semigroup (FreeMonoidTree a) where append = Append 124 | instance Monoid (FreeMonoidTree a) where mempty = Empty 125 | 126 | -- | A default implementation of `foldr` using `foldMap`. 127 | -- | 128 | -- | Note: when defining a `Foldable` instance, this function is unsafe to use 129 | -- | in combination with `foldMapDefaultR`. 130 | foldrDefault 131 | :: forall f a b 132 | . Foldable f 133 | => (a -> b -> b) 134 | -> b 135 | -> f a 136 | -> b 137 | foldrDefault c u xs = foldr c u $ foldMap Node xs 138 | 139 | -- | A default implementation of `foldl` using `foldMap`. 140 | -- | 141 | -- | Note: when defining a `Foldable` instance, this function is unsafe to use 142 | -- | in combination with `foldMapDefaultL`. 143 | foldlDefault 144 | :: forall f a b 145 | . Foldable f 146 | => (b -> a -> b) 147 | -> b 148 | -> f a 149 | -> b 150 | foldlDefault c u xs = foldl c u $ foldMap Node xs 151 | 152 | -- | A default implementation of `foldMap` using `foldr`. 153 | -- | 154 | -- | Note: when defining a `Foldable` instance, this function is unsafe to use 155 | -- | in combination with `foldrDefault`. 156 | foldMapDefaultR 157 | :: forall f a m 158 | . Foldable f 159 | => Monoid m 160 | => (a -> m) 161 | -> f a 162 | -> m 163 | foldMapDefaultR f = foldr (\x acc -> f x <> acc) mempty 164 | 165 | -- | A default implementation of `foldMap` using `foldl`. 166 | -- | 167 | -- | Note: when defining a `Foldable` instance, this function is unsafe to use 168 | -- | in combination with `foldlDefault`. 169 | foldMapDefaultL 170 | :: forall f a m 171 | . Foldable f 172 | => Monoid m 173 | => (a -> m) 174 | -> f a 175 | -> m 176 | foldMapDefaultL f = foldl (\acc x -> acc <> f x) mempty 177 | 178 | instance foldableArray :: Foldable Array where 179 | foldr = foldrArray 180 | foldl = foldlArray 181 | foldMap = foldMapDefaultR 182 | 183 | foreign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b 184 | foreign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b 185 | 186 | instance foldableMaybe :: Foldable Maybe where 187 | foldr _ z Nothing = z 188 | foldr f z (Just x) = x `f` z 189 | foldl _ z Nothing = z 190 | foldl f z (Just x) = z `f` x 191 | foldMap _ Nothing = mempty 192 | foldMap f (Just x) = f x 193 | 194 | instance foldableFirst :: Foldable First where 195 | foldr f z (First x) = foldr f z x 196 | foldl f z (First x) = foldl f z x 197 | foldMap f (First x) = foldMap f x 198 | 199 | instance foldableLast :: Foldable Last where 200 | foldr f z (Last x) = foldr f z x 201 | foldl f z (Last x) = foldl f z x 202 | foldMap f (Last x) = foldMap f x 203 | 204 | instance foldableAdditive :: Foldable Additive where 205 | foldr f z (Additive x) = x `f` z 206 | foldl f z (Additive x) = z `f` x 207 | foldMap f (Additive x) = f x 208 | 209 | instance foldableDual :: Foldable Dual where 210 | foldr f z (Dual x) = x `f` z 211 | foldl f z (Dual x) = z `f` x 212 | foldMap f (Dual x) = f x 213 | 214 | instance foldableDisj :: Foldable Disj where 215 | foldr f z (Disj x) = f x z 216 | foldl f z (Disj x) = f z x 217 | foldMap f (Disj x) = f x 218 | 219 | instance foldableConj :: Foldable Conj where 220 | foldr f z (Conj x) = f x z 221 | foldl f z (Conj x) = f z x 222 | foldMap f (Conj x) = f x 223 | 224 | instance foldableMultiplicative :: Foldable Multiplicative where 225 | foldr f z (Multiplicative x) = x `f` z 226 | foldl f z (Multiplicative x) = z `f` x 227 | foldMap f (Multiplicative x) = f x 228 | 229 | instance foldableEither :: Foldable (Either a) where 230 | foldr _ z (Left _) = z 231 | foldr f z (Right x) = f x z 232 | foldl _ z (Left _) = z 233 | foldl f z (Right x) = f z x 234 | foldMap _ (Left _) = mempty 235 | foldMap f (Right x) = f x 236 | 237 | instance foldableTuple :: Foldable (Tuple a) where 238 | foldr f z (Tuple _ x) = f x z 239 | foldl f z (Tuple _ x) = f z x 240 | foldMap f (Tuple _ x) = f x 241 | 242 | instance foldableIdentity :: Foldable Identity where 243 | foldr f z (Identity x) = f x z 244 | foldl f z (Identity x) = f z x 245 | foldMap f (Identity x) = f x 246 | 247 | instance foldableConst :: Foldable (Const a) where 248 | foldr _ z _ = z 249 | foldl _ z _ = z 250 | foldMap _ _ = mempty 251 | 252 | instance foldableProduct :: (Foldable f, Foldable g) => Foldable (Product f g) where 253 | foldr f z (Product (Tuple fa ga)) = foldr f (foldr f z ga) fa 254 | foldl f z (Product (Tuple fa ga)) = foldl f (foldl f z fa) ga 255 | foldMap f (Product (Tuple fa ga)) = foldMap f fa <> foldMap f ga 256 | 257 | instance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f g) where 258 | foldr f z = coproduct (foldr f z) (foldr f z) 259 | foldl f z = coproduct (foldl f z) (foldl f z) 260 | foldMap f = coproduct (foldMap f) (foldMap f) 261 | 262 | instance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) where 263 | foldr f i (Compose fga) = foldr (flip (foldr f)) i fga 264 | foldl f i (Compose fga) = foldl (foldl f) i fga 265 | foldMap f (Compose fga) = foldMap (foldMap f) fga 266 | 267 | instance foldableApp :: Foldable f => Foldable (App f) where 268 | foldr f i (App x) = foldr f i x 269 | foldl f i (App x) = foldl f i x 270 | foldMap f (App x) = foldMap f x 271 | 272 | -- | Fold a data structure, accumulating values in some `Monoid`. 273 | fold :: forall f m. Foldable f => Monoid m => f m -> m 274 | fold = foldMap identity 275 | 276 | -- | Similar to 'foldl', but the result is encapsulated in a monad. 277 | -- | 278 | -- | Note: this function is not generally stack-safe, e.g., for monads which 279 | -- | build up thunks a la `Eff`. 280 | foldM :: forall f m a b. Foldable f => Monad m => (b -> a -> m b) -> b -> f a -> m b 281 | foldM f b0 = foldl (\b a -> b >>= flip f a) (pure b0) 282 | 283 | -- | Traverse a data structure, performing some effects encoded by an 284 | -- | `Applicative` functor at each value, ignoring the final result. 285 | -- | 286 | -- | For example: 287 | -- | 288 | -- | ```purescript 289 | -- | traverse_ print [1, 2, 3] 290 | -- | ``` 291 | traverse_ 292 | :: forall a b f m 293 | . Applicative m 294 | => Foldable f 295 | => (a -> m b) 296 | -> f a 297 | -> m Unit 298 | traverse_ f = foldr ((*>) <<< f) (pure unit) 299 | 300 | -- | A version of `traverse_` with its arguments flipped. 301 | -- | 302 | -- | This can be useful when running an action written using do notation 303 | -- | for every element in a data structure: 304 | -- | 305 | -- | For example: 306 | -- | 307 | -- | ```purescript 308 | -- | for_ [1, 2, 3] \n -> do 309 | -- | print n 310 | -- | trace "squared is" 311 | -- | print (n * n) 312 | -- | ``` 313 | for_ 314 | :: forall a b f m 315 | . Applicative m 316 | => Foldable f 317 | => f a 318 | -> (a -> m b) 319 | -> m Unit 320 | for_ = flip traverse_ 321 | 322 | -- | Perform all of the effects in some data structure in the order 323 | -- | given by the `Foldable` instance, ignoring the final result. 324 | -- | 325 | -- | For example: 326 | -- | 327 | -- | ```purescript 328 | -- | sequence_ [ trace "Hello, ", trace " world!" ] 329 | -- | ``` 330 | sequence_ :: forall a f m. Applicative m => Foldable f => f (m a) -> m Unit 331 | sequence_ = traverse_ identity 332 | 333 | -- | Combines a collection of elements using the `Alt` operation. 334 | oneOf :: forall f g a. Foldable f => Plus g => f (g a) -> g a 335 | oneOf = foldr alt empty 336 | 337 | -- | Folds a structure into some `Plus`. 338 | oneOfMap :: forall f g a b. Foldable f => Plus g => (a -> g b) -> f a -> g b 339 | oneOfMap f = foldr (alt <<< f) empty 340 | 341 | -- | Fold a data structure, accumulating values in some `Monoid`, 342 | -- | combining adjacent elements using the specified separator. 343 | -- | 344 | -- | For example: 345 | -- | 346 | -- | ```purescript 347 | -- | > intercalate ", " ["Lorem", "ipsum", "dolor"] 348 | -- | = "Lorem, ipsum, dolor" 349 | -- | 350 | -- | > intercalate "*" ["a", "b", "c"] 351 | -- | = "a*b*c" 352 | -- | 353 | -- | > intercalate [1] [[2, 3], [4, 5], [6, 7]] 354 | -- | = [2, 3, 1, 4, 5, 1, 6, 7] 355 | -- | ``` 356 | intercalate :: forall f m. Foldable f => Monoid m => m -> f m -> m 357 | intercalate sep xs = (foldl go { init: true, acc: mempty } xs).acc 358 | where 359 | go { init: true } x = { init: false, acc: x } 360 | go { acc: acc } x = { init: false, acc: acc <> sep <> x } 361 | 362 | -- | `foldMap` but with each element surrounded by some fixed value. 363 | -- | 364 | -- | For example: 365 | -- | 366 | -- | ```purescript 367 | -- | > surroundMap "*" show [] 368 | -- | = "*" 369 | -- | 370 | -- | > surroundMap "*" show [1] 371 | -- | = "*1*" 372 | -- | 373 | -- | > surroundMap "*" show [1, 2] 374 | -- | = "*1*2*" 375 | -- | 376 | -- | > surroundMap "*" show [1, 2, 3] 377 | -- | = "*1*2*3*" 378 | -- | ``` 379 | surroundMap :: forall f a m. Foldable f => Semigroup m => m -> (a -> m) -> f a -> m 380 | surroundMap d t f = unwrap (foldMap joined f) d 381 | where joined a = Endo \m -> d <> t a <> m 382 | 383 | -- | `fold` but with each element surrounded by some fixed value. 384 | -- | 385 | -- | For example: 386 | -- | 387 | -- | ```purescript 388 | -- | > surround "*" [] 389 | -- | = "*" 390 | -- | 391 | -- | > surround "*" ["1"] 392 | -- | = "*1*" 393 | -- | 394 | -- | > surround "*" ["1", "2"] 395 | -- | = "*1*2*" 396 | -- | 397 | -- | > surround "*" ["1", "2", "3"] 398 | -- | = "*1*2*3*" 399 | -- | ``` 400 | surround :: forall f m. Foldable f => Semigroup m => m -> f m -> m 401 | surround d = surroundMap d identity 402 | 403 | -- | The conjunction of all the values in a data structure. When specialized 404 | -- | to `Boolean`, this function will test whether all of the values in a data 405 | -- | structure are `true`. 406 | and :: forall a f. Foldable f => HeytingAlgebra a => f a -> a 407 | and = all identity 408 | 409 | -- | The disjunction of all the values in a data structure. When specialized 410 | -- | to `Boolean`, this function will test whether any of the values in a data 411 | -- | structure is `true`. 412 | or :: forall a f. Foldable f => HeytingAlgebra a => f a -> a 413 | or = any identity 414 | 415 | -- | `all f` is the same as `and <<< map f`; map a function over the structure, 416 | -- | and then get the conjunction of the results. 417 | all :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b 418 | all = alaF Conj foldMap 419 | 420 | -- | `any f` is the same as `or <<< map f`; map a function over the structure, 421 | -- | and then get the disjunction of the results. 422 | any :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b 423 | any = alaF Disj foldMap 424 | 425 | -- | Find the sum of the numeric values in a data structure. 426 | sum :: forall a f. Foldable f => Semiring a => f a -> a 427 | sum = foldl (+) zero 428 | 429 | -- | Find the product of the numeric values in a data structure. 430 | product :: forall a f. Foldable f => Semiring a => f a -> a 431 | product = foldl (*) one 432 | 433 | -- | Test whether a value is an element of a data structure. 434 | elem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean 435 | elem = any <<< (==) 436 | 437 | -- | Test whether a value is not an element of a data structure. 438 | notElem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean 439 | notElem x = not <<< elem x 440 | 441 | -- | Try to get nth element from the left in a data structure 442 | indexl :: forall a f. Foldable f => Int -> f a -> Maybe a 443 | indexl idx = _.elem <<< foldl go { elem: Nothing, pos: 0 } 444 | where 445 | go cursor a = 446 | case cursor.elem of 447 | Just _ -> cursor 448 | _ -> 449 | if cursor.pos == idx 450 | then { elem: Just a, pos: cursor.pos } 451 | else { pos: cursor.pos + 1, elem: cursor.elem } 452 | 453 | -- | Try to get nth element from the right in a data structure 454 | indexr :: forall a f. Foldable f => Int -> f a -> Maybe a 455 | indexr idx = _.elem <<< foldr go { elem: Nothing, pos: 0 } 456 | where 457 | go a cursor = 458 | case cursor.elem of 459 | Just _ -> cursor 460 | _ -> 461 | if cursor.pos == idx 462 | then { elem: Just a, pos: cursor.pos } 463 | else { pos: cursor.pos + 1, elem: cursor.elem } 464 | 465 | -- | Try to find an element in a data structure which satisfies a predicate. 466 | find :: forall a f. Foldable f => (a -> Boolean) -> f a -> Maybe a 467 | find p = foldl go Nothing 468 | where 469 | go Nothing x | p x = Just x 470 | go r _ = r 471 | 472 | -- | Try to find an element in a data structure which satisfies a predicate mapping. 473 | findMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b 474 | findMap p = foldl go Nothing 475 | where 476 | go Nothing x = p x 477 | go r _ = r 478 | 479 | -- | Find the largest element of a structure, according to its `Ord` instance. 480 | maximum :: forall a f. Ord a => Foldable f => f a -> Maybe a 481 | maximum = maximumBy compare 482 | 483 | -- | Find the largest element of a structure, according to a given comparison 484 | -- | function. The comparison function should represent a total ordering (see 485 | -- | the `Ord` type class laws); if it does not, the behaviour is undefined. 486 | maximumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a 487 | maximumBy cmp = foldl max' Nothing 488 | where 489 | max' Nothing x = Just x 490 | max' (Just x) y = Just (if cmp x y == GT then x else y) 491 | 492 | -- | Find the smallest element of a structure, according to its `Ord` instance. 493 | minimum :: forall a f. Ord a => Foldable f => f a -> Maybe a 494 | minimum = minimumBy compare 495 | 496 | -- | Find the smallest element of a structure, according to a given comparison 497 | -- | function. The comparison function should represent a total ordering (see 498 | -- | the `Ord` type class laws); if it does not, the behaviour is undefined. 499 | minimumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a 500 | minimumBy cmp = foldl min' Nothing 501 | where 502 | min' Nothing x = Just x 503 | min' (Just x) y = Just (if cmp x y == LT then x else y) 504 | 505 | -- | Test whether the structure is empty. 506 | -- | Optimized for structures that are similar to cons-lists, because there 507 | -- | is no general way to do better. 508 | null :: forall a f. Foldable f => f a -> Boolean 509 | null = foldr (\_ _ -> false) true 510 | 511 | -- | Returns the size/length of a finite structure. 512 | -- | Optimized for structures that are similar to cons-lists, because there 513 | -- | is no general way to do better. 514 | length :: forall a b f. Foldable f => Semiring b => f a -> b 515 | length = foldl (\c _ -> add one c) zero 516 | 517 | -- | Lookup a value in a data structure of `Tuple`s, generalizing association lists. 518 | lookup :: forall a b f. Foldable f => Eq a => a -> f (Tuple a b) -> Maybe b 519 | lookup a = unwrap <<< foldMap \(Tuple a' b) -> First (if a == a' then Just b else Nothing) 520 | -------------------------------------------------------------------------------- /src/Data/FoldableWithIndex.purs: -------------------------------------------------------------------------------- 1 | module Data.FoldableWithIndex 2 | ( class FoldableWithIndex, foldrWithIndex, foldlWithIndex, foldMapWithIndex 3 | , foldrWithIndexDefault 4 | , foldlWithIndexDefault 5 | , foldMapWithIndexDefaultR 6 | , foldMapWithIndexDefaultL 7 | , foldWithIndexM 8 | , traverseWithIndex_ 9 | , forWithIndex_ 10 | , surroundMapWithIndex 11 | , allWithIndex 12 | , anyWithIndex 13 | , findWithIndex 14 | , findMapWithIndex 15 | , foldrDefault 16 | , foldlDefault 17 | , foldMapDefault 18 | ) where 19 | 20 | import Prelude 21 | 22 | import Data.Const (Const) 23 | import Data.Either (Either(..)) 24 | import Data.Foldable (class Foldable, foldMap, foldl, foldr) 25 | import Data.Functor.App (App(..)) 26 | import Data.Functor.Compose (Compose(..)) 27 | import Data.Functor.Coproduct (Coproduct, coproduct) 28 | import Data.Functor.Product (Product(..)) 29 | import Data.FunctorWithIndex (mapWithIndex) 30 | import Data.Identity (Identity(..)) 31 | import Data.Maybe (Maybe(..)) 32 | import Data.Maybe.First (First) 33 | import Data.Maybe.Last (Last) 34 | import Data.Monoid.Additive (Additive) 35 | import Data.Monoid.Conj (Conj(..)) 36 | import Data.Monoid.Disj (Disj(..)) 37 | import Data.Monoid.Dual (Dual(..)) 38 | import Data.Monoid.Endo (Endo(..)) 39 | import Data.Monoid.Multiplicative (Multiplicative) 40 | import Data.Newtype (unwrap) 41 | import Data.Tuple (Tuple(..), curry) 42 | 43 | -- | A `Foldable` with an additional index. 44 | -- | A `FoldableWithIndex` instance must be compatible with its `Foldable` 45 | -- | instance 46 | -- | ```purescript 47 | -- | foldr f = foldrWithIndex (const f) 48 | -- | foldl f = foldlWithIndex (const f) 49 | -- | foldMap f = foldMapWithIndex (const f) 50 | -- | ``` 51 | -- | 52 | -- | Default implementations are provided by the following functions: 53 | -- | 54 | -- | - `foldrWithIndexDefault` 55 | -- | - `foldlWithIndexDefault` 56 | -- | - `foldMapWithIndexDefaultR` 57 | -- | - `foldMapWithIndexDefaultL` 58 | -- | 59 | -- | Note: some combinations of the default implementations are unsafe to 60 | -- | use together - causing a non-terminating mutually recursive cycle. 61 | -- | These combinations are documented per function. 62 | class Foldable f <= FoldableWithIndex i f | f -> i where 63 | foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b 64 | foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b 65 | foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m 66 | 67 | -- | A default implementation of `foldrWithIndex` using `foldMapWithIndex`. 68 | -- | 69 | -- | Note: when defining a `FoldableWithIndex` instance, this function is 70 | -- | unsafe to use in combination with `foldMapWithIndexDefaultR`. 71 | foldrWithIndexDefault 72 | :: forall i f a b 73 | . FoldableWithIndex i f 74 | => (i -> a -> b -> b) 75 | -> b 76 | -> f a 77 | -> b 78 | foldrWithIndexDefault c u xs = unwrap (foldMapWithIndex (\i -> Endo <<< c i) xs) u 79 | 80 | -- | A default implementation of `foldlWithIndex` using `foldMapWithIndex`. 81 | -- | 82 | -- | Note: when defining a `FoldableWithIndex` instance, this function is 83 | -- | unsafe to use in combination with `foldMapWithIndexDefaultL`. 84 | foldlWithIndexDefault 85 | :: forall i f a b 86 | . FoldableWithIndex i f 87 | => (i -> b -> a -> b) 88 | -> b 89 | -> f a 90 | -> b 91 | foldlWithIndexDefault c u xs = unwrap (unwrap (foldMapWithIndex (\i -> Dual <<< Endo <<< flip (c i)) xs)) u 92 | 93 | -- | A default implementation of `foldMapWithIndex` using `foldrWithIndex`. 94 | -- | 95 | -- | Note: when defining a `FoldableWithIndex` instance, this function is 96 | -- | unsafe to use in combination with `foldrWithIndexDefault`. 97 | foldMapWithIndexDefaultR 98 | :: forall i f a m 99 | . FoldableWithIndex i f 100 | => Monoid m 101 | => (i -> a -> m) 102 | -> f a 103 | -> m 104 | foldMapWithIndexDefaultR f = foldrWithIndex (\i x acc -> f i x <> acc) mempty 105 | 106 | -- | A default implementation of `foldMapWithIndex` using `foldlWithIndex`. 107 | -- | 108 | -- | Note: when defining a `FoldableWithIndex` instance, this function is 109 | -- | unsafe to use in combination with `foldlWithIndexDefault`. 110 | foldMapWithIndexDefaultL 111 | :: forall i f a m 112 | . FoldableWithIndex i f 113 | => Monoid m 114 | => (i -> a -> m) 115 | -> f a 116 | -> m 117 | foldMapWithIndexDefaultL f = foldlWithIndex (\i acc x -> acc <> f i x) mempty 118 | 119 | instance foldableWithIndexArray :: FoldableWithIndex Int Array where 120 | foldrWithIndex f z = foldr (\(Tuple i x) y -> f i x y) z <<< mapWithIndex Tuple 121 | foldlWithIndex f z = foldl (\y (Tuple i x) -> f i y x) z <<< mapWithIndex Tuple 122 | foldMapWithIndex = foldMapWithIndexDefaultR 123 | 124 | instance foldableWithIndexMaybe :: FoldableWithIndex Unit Maybe where 125 | foldrWithIndex f = foldr $ f unit 126 | foldlWithIndex f = foldl $ f unit 127 | foldMapWithIndex f = foldMap $ f unit 128 | 129 | instance foldableWithIndexFirst :: FoldableWithIndex Unit First where 130 | foldrWithIndex f = foldr $ f unit 131 | foldlWithIndex f = foldl $ f unit 132 | foldMapWithIndex f = foldMap $ f unit 133 | 134 | instance foldableWithIndexLast :: FoldableWithIndex Unit Last where 135 | foldrWithIndex f = foldr $ f unit 136 | foldlWithIndex f = foldl $ f unit 137 | foldMapWithIndex f = foldMap $ f unit 138 | 139 | instance foldableWithIndexAdditive :: FoldableWithIndex Unit Additive where 140 | foldrWithIndex f = foldr $ f unit 141 | foldlWithIndex f = foldl $ f unit 142 | foldMapWithIndex f = foldMap $ f unit 143 | 144 | instance foldableWithIndexDual :: FoldableWithIndex Unit Dual where 145 | foldrWithIndex f = foldr $ f unit 146 | foldlWithIndex f = foldl $ f unit 147 | foldMapWithIndex f = foldMap $ f unit 148 | 149 | instance foldableWithIndexDisj :: FoldableWithIndex Unit Disj where 150 | foldrWithIndex f = foldr $ f unit 151 | foldlWithIndex f = foldl $ f unit 152 | foldMapWithIndex f = foldMap $ f unit 153 | 154 | instance foldableWithIndexConj :: FoldableWithIndex Unit Conj where 155 | foldrWithIndex f = foldr $ f unit 156 | foldlWithIndex f = foldl $ f unit 157 | foldMapWithIndex f = foldMap $ f unit 158 | 159 | instance foldableWithIndexMultiplicative :: FoldableWithIndex Unit Multiplicative where 160 | foldrWithIndex f = foldr $ f unit 161 | foldlWithIndex f = foldl $ f unit 162 | foldMapWithIndex f = foldMap $ f unit 163 | 164 | instance foldableWithIndexEither :: FoldableWithIndex Unit (Either a) where 165 | foldrWithIndex _ z (Left _) = z 166 | foldrWithIndex f z (Right x) = f unit x z 167 | foldlWithIndex _ z (Left _) = z 168 | foldlWithIndex f z (Right x) = f unit z x 169 | foldMapWithIndex _ (Left _) = mempty 170 | foldMapWithIndex f (Right x) = f unit x 171 | 172 | instance foldableWithIndexTuple :: FoldableWithIndex Unit (Tuple a) where 173 | foldrWithIndex f z (Tuple _ x) = f unit x z 174 | foldlWithIndex f z (Tuple _ x) = f unit z x 175 | foldMapWithIndex f (Tuple _ x) = f unit x 176 | 177 | instance foldableWithIndexIdentity :: FoldableWithIndex Unit Identity where 178 | foldrWithIndex f z (Identity x) = f unit x z 179 | foldlWithIndex f z (Identity x) = f unit z x 180 | foldMapWithIndex f (Identity x) = f unit x 181 | 182 | instance foldableWithIndexConst :: FoldableWithIndex Void (Const a) where 183 | foldrWithIndex _ z _ = z 184 | foldlWithIndex _ z _ = z 185 | foldMapWithIndex _ _ = mempty 186 | 187 | instance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where 188 | foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa 189 | foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga 190 | foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga 191 | 192 | instance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where 193 | foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z) 194 | foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z) 195 | foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right)) 196 | 197 | instance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where 198 | foldrWithIndex f i (Compose fga) = foldrWithIndex (\a -> flip (foldrWithIndex (curry f a))) i fga 199 | foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga 200 | foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga 201 | 202 | instance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f) where 203 | foldrWithIndex f z (App x) = foldrWithIndex f z x 204 | foldlWithIndex f z (App x) = foldlWithIndex f z x 205 | foldMapWithIndex f (App x) = foldMapWithIndex f x 206 | 207 | 208 | -- | Similar to 'foldlWithIndex', but the result is encapsulated in a monad. 209 | -- | 210 | -- | Note: this function is not generally stack-safe, e.g., for monads which 211 | -- | build up thunks a la `Eff`. 212 | foldWithIndexM 213 | :: forall i f m a b 214 | . FoldableWithIndex i f 215 | => Monad m 216 | => (i -> a -> b -> m a) 217 | -> a 218 | -> f b 219 | -> m a 220 | foldWithIndexM f a0 = foldlWithIndex (\i ma b -> ma >>= flip (f i) b) (pure a0) 221 | 222 | -- | Traverse a data structure with access to the index, performing some 223 | -- | effects encoded by an `Applicative` functor at each value, ignoring the 224 | -- | final result. 225 | -- | 226 | -- | For example: 227 | -- | 228 | -- | ```purescript 229 | -- | > traverseWithIndex_ (curry logShow) ["a", "b", "c"] 230 | -- | (Tuple 0 "a") 231 | -- | (Tuple 1 "b") 232 | -- | (Tuple 2 "c") 233 | -- | ``` 234 | traverseWithIndex_ 235 | :: forall i a b f m 236 | . Applicative m 237 | => FoldableWithIndex i f 238 | => (i -> a -> m b) 239 | -> f a 240 | -> m Unit 241 | traverseWithIndex_ f = foldrWithIndex (\i -> (*>) <<< f i) (pure unit) 242 | 243 | -- | A version of `traverseWithIndex_` with its arguments flipped. 244 | -- | 245 | -- | This can be useful when running an action written using do notation 246 | -- | for every element in a data structure: 247 | -- | 248 | -- | For example: 249 | -- | 250 | -- | ```purescript 251 | -- | forWithIndex_ ["a", "b", "c"] \i x -> do 252 | -- | logShow i 253 | -- | log x 254 | -- | ``` 255 | forWithIndex_ 256 | :: forall i a b f m 257 | . Applicative m 258 | => FoldableWithIndex i f 259 | => f a 260 | -> (i -> a -> m b) 261 | -> m Unit 262 | forWithIndex_ = flip traverseWithIndex_ 263 | 264 | -- | `foldMapWithIndex` but with each element surrounded by some fixed value. 265 | -- | 266 | -- | For example: 267 | -- | 268 | -- | ```purescript 269 | -- | > surroundMapWithIndex "*" (\i x -> show i <> x) [] 270 | -- | = "*" 271 | -- | 272 | -- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a"] 273 | -- | = "*0a*" 274 | -- | 275 | -- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b"] 276 | -- | = "*0a*1b*" 277 | -- | 278 | -- | > surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b", "c"] 279 | -- | = "*0a*1b*2c*" 280 | -- | ``` 281 | surroundMapWithIndex 282 | :: forall i f a m 283 | . FoldableWithIndex i f 284 | => Semigroup m 285 | => m 286 | -> (i -> a -> m) 287 | -> f a 288 | -> m 289 | surroundMapWithIndex d t f = unwrap (foldMapWithIndex joined f) d 290 | where joined i a = Endo \m -> d <> t i a <> m 291 | 292 | -- | `allWithIndex f` is the same as `and <<< mapWithIndex f`; map a function over the 293 | -- | structure, and then get the conjunction of the results. 294 | allWithIndex 295 | :: forall i a b f 296 | . FoldableWithIndex i f 297 | => HeytingAlgebra b 298 | => (i -> a -> b) 299 | -> f a 300 | -> b 301 | allWithIndex t = unwrap <<< foldMapWithIndex (\i -> Conj <<< t i) 302 | 303 | -- | `anyWithIndex f` is the same as `or <<< mapWithIndex f`; map a function over the 304 | -- | structure, and then get the disjunction of the results. 305 | anyWithIndex 306 | :: forall i a b f 307 | . FoldableWithIndex i f 308 | => HeytingAlgebra b 309 | => (i -> a -> b) 310 | -> f a 311 | -> b 312 | anyWithIndex t = unwrap <<< foldMapWithIndex (\i -> Disj <<< t i) 313 | 314 | -- | Try to find an element in a data structure which satisfies a predicate 315 | -- | with access to the index. 316 | findWithIndex 317 | :: forall i a f 318 | . FoldableWithIndex i f 319 | => (i -> a -> Boolean) 320 | -> f a 321 | -> Maybe { index :: i, value :: a } 322 | findWithIndex p = foldlWithIndex go Nothing 323 | where 324 | go 325 | :: i 326 | -> Maybe { index :: i, value :: a } 327 | -> a 328 | -> Maybe { index :: i, value :: a } 329 | go i Nothing x | p i x = Just { index: i, value: x } 330 | go _ r _ = r 331 | 332 | -- | Try to find an element in a data structure which satisfies a predicate mapping 333 | -- | with access to the index. 334 | findMapWithIndex 335 | :: forall i a b f 336 | . FoldableWithIndex i f 337 | => (i -> a -> Maybe b) 338 | -> f a 339 | -> Maybe b 340 | findMapWithIndex f = foldlWithIndex go Nothing 341 | where 342 | go 343 | :: i 344 | -> Maybe b 345 | -> a 346 | -> Maybe b 347 | go i Nothing x = f i x 348 | go _ r _ = r 349 | 350 | -- | A default implementation of `foldr` using `foldrWithIndex` 351 | foldrDefault 352 | :: forall i f a b 353 | . FoldableWithIndex i f 354 | => (a -> b -> b) -> b -> f a -> b 355 | foldrDefault f = foldrWithIndex (const f) 356 | 357 | -- | A default implementation of `foldl` using `foldlWithIndex` 358 | foldlDefault 359 | :: forall i f a b 360 | . FoldableWithIndex i f 361 | => (b -> a -> b) -> b -> f a -> b 362 | foldlDefault f = foldlWithIndex (const f) 363 | 364 | -- | A default implementation of `foldMap` using `foldMapWithIndex` 365 | foldMapDefault 366 | :: forall i f a m 367 | . FoldableWithIndex i f 368 | => Monoid m 369 | => (a -> m) -> f a -> m 370 | foldMapDefault f = foldMapWithIndex (const f) 371 | -------------------------------------------------------------------------------- /src/Data/FunctorWithIndex.js: -------------------------------------------------------------------------------- 1 | export const mapWithIndexArray = function (f) { 2 | return function (xs) { 3 | var l = xs.length; 4 | var result = Array(l); 5 | for (var i = 0; i < l; i++) { 6 | result[i] = f(i)(xs[i]); 7 | } 8 | return result; 9 | }; 10 | }; 11 | -------------------------------------------------------------------------------- /src/Data/FunctorWithIndex.purs: -------------------------------------------------------------------------------- 1 | module Data.FunctorWithIndex 2 | ( class FunctorWithIndex, mapWithIndex, mapDefault 3 | ) where 4 | 5 | import Prelude 6 | 7 | import Data.Bifunctor (bimap) 8 | import Data.Const (Const(..)) 9 | import Data.Either (Either(..)) 10 | import Data.Functor.App (App(..)) 11 | import Data.Functor.Compose (Compose(..)) 12 | import Data.Functor.Coproduct (Coproduct(..)) 13 | import Data.Functor.Product (Product(..)) 14 | import Data.Identity (Identity(..)) 15 | import Data.Maybe (Maybe) 16 | import Data.Maybe.First (First) 17 | import Data.Maybe.Last (Last) 18 | import Data.Monoid.Additive (Additive) 19 | import Data.Monoid.Conj (Conj) 20 | import Data.Monoid.Disj (Disj) 21 | import Data.Monoid.Dual (Dual) 22 | import Data.Monoid.Multiplicative (Multiplicative) 23 | import Data.Tuple (Tuple, curry) 24 | 25 | -- | A `Functor` with an additional index. 26 | -- | Instances must satisfy a modified form of the `Functor` laws 27 | -- | ```purescript 28 | -- | mapWithIndex (\_ a -> a) = identity 29 | -- | mapWithIndex f . mapWithIndex g = mapWithIndex (\i -> f i <<< g i) 30 | -- | ``` 31 | -- | and be compatible with the `Functor` instance 32 | -- | ```purescript 33 | -- | map f = mapWithIndex (const f) 34 | -- | ``` 35 | class Functor f <= FunctorWithIndex i f | f -> i where 36 | mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b 37 | 38 | foreign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b 39 | 40 | instance functorWithIndexArray :: FunctorWithIndex Int Array where 41 | mapWithIndex = mapWithIndexArray 42 | 43 | instance functorWithIndexMaybe :: FunctorWithIndex Unit Maybe where 44 | mapWithIndex f = map $ f unit 45 | 46 | instance functorWithIndexFirst :: FunctorWithIndex Unit First where 47 | mapWithIndex f = map $ f unit 48 | 49 | instance functorWithIndexLast :: FunctorWithIndex Unit Last where 50 | mapWithIndex f = map $ f unit 51 | 52 | instance functorWithIndexAdditive :: FunctorWithIndex Unit Additive where 53 | mapWithIndex f = map $ f unit 54 | 55 | instance functorWithIndexDual :: FunctorWithIndex Unit Dual where 56 | mapWithIndex f = map $ f unit 57 | 58 | instance functorWithIndexConj :: FunctorWithIndex Unit Conj where 59 | mapWithIndex f = map $ f unit 60 | 61 | instance functorWithIndexDisj :: FunctorWithIndex Unit Disj where 62 | mapWithIndex f = map $ f unit 63 | 64 | instance functorWithIndexMultiplicative :: FunctorWithIndex Unit Multiplicative where 65 | mapWithIndex f = map $ f unit 66 | 67 | instance functorWithIndexEither :: FunctorWithIndex Unit (Either a) where 68 | mapWithIndex f = map $ f unit 69 | 70 | instance functorWithIndexTuple :: FunctorWithIndex Unit (Tuple a) where 71 | mapWithIndex f = map $ f unit 72 | 73 | instance functorWithIndexIdentity :: FunctorWithIndex Unit Identity where 74 | mapWithIndex f (Identity a) = Identity (f unit a) 75 | 76 | instance functorWithIndexConst :: FunctorWithIndex Void (Const a) where 77 | mapWithIndex _ (Const x) = Const x 78 | 79 | instance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where 80 | mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga) 81 | 82 | instance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where 83 | mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e) 84 | 85 | instance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where 86 | mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga 87 | 88 | instance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f) where 89 | mapWithIndex f (App x) = App $ mapWithIndex f x 90 | 91 | -- | A default implementation of Functor's `map` in terms of `mapWithIndex` 92 | mapDefault :: forall i f a b. FunctorWithIndex i f => (a -> b) -> f a -> f b 93 | mapDefault f = mapWithIndex (const f) 94 | -------------------------------------------------------------------------------- /src/Data/Semigroup/Foldable.purs: -------------------------------------------------------------------------------- 1 | module Data.Semigroup.Foldable 2 | ( class Foldable1 3 | , foldMap1 4 | , fold1 5 | , foldr1 6 | , foldl1 7 | , traverse1_ 8 | , for1_ 9 | , sequence1_ 10 | , foldr1Default 11 | , foldl1Default 12 | , foldMap1DefaultR 13 | , foldMap1DefaultL 14 | , intercalate 15 | , intercalateMap 16 | , maximum 17 | , maximumBy 18 | , minimum 19 | , minimumBy 20 | ) where 21 | 22 | import Prelude 23 | 24 | import Data.Foldable (class Foldable) 25 | import Data.Identity (Identity(..)) 26 | import Data.Monoid.Dual (Dual(..)) 27 | import Data.Monoid.Multiplicative (Multiplicative(..)) 28 | import Data.Newtype (ala, alaF) 29 | import Data.Ord.Max (Max(..)) 30 | import Data.Ord.Min (Min(..)) 31 | import Data.Tuple (Tuple(..)) 32 | 33 | -- | `Foldable1` represents data structures with a minimum of one element that can be _folded_. 34 | -- | 35 | -- | - `foldr1` folds a structure from the right 36 | -- | - `foldl1` folds a structure from the left 37 | -- | - `foldMap1` folds a structure by accumulating values in a `Semigroup` 38 | -- | 39 | -- | Default implementations are provided by the following functions: 40 | -- | 41 | -- | - `foldr1Default` 42 | -- | - `foldl1Default` 43 | -- | - `foldMap1DefaultR` 44 | -- | - `foldMap1DefaultL` 45 | -- | 46 | -- | Note: some combinations of the default implementations are unsafe to 47 | -- | use together - causing a non-terminating mutually recursive cycle. 48 | -- | These combinations are documented per function. 49 | class Foldable t <= Foldable1 t where 50 | foldr1 :: forall a. (a -> a -> a) -> t a -> a 51 | foldl1 :: forall a. (a -> a -> a) -> t a -> a 52 | foldMap1 :: forall a m. Semigroup m => (a -> m) -> t a -> m 53 | 54 | -- | A default implementation of `foldr1` using `foldMap1`. 55 | -- | 56 | -- | Note: when defining a `Foldable1` instance, this function is unsafe to use 57 | -- | in combination with `foldMap1DefaultR`. 58 | foldr1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a 59 | foldr1Default = flip (runFoldRight1 <<< foldMap1 mkFoldRight1) 60 | 61 | -- | A default implementation of `foldl1` using `foldMap1`. 62 | -- | 63 | -- | Note: when defining a `Foldable1` instance, this function is unsafe to use 64 | -- | in combination with `foldMap1DefaultL`. 65 | foldl1Default :: forall t a. Foldable1 t => (a -> a -> a) -> t a -> a 66 | foldl1Default = flip (runFoldRight1 <<< alaF Dual foldMap1 mkFoldRight1) <<< flip 67 | 68 | -- | A default implementation of `foldMap1` using `foldr1`. 69 | -- | 70 | -- | Note: when defining a `Foldable1` instance, this function is unsafe to use 71 | -- | in combination with `foldr1Default`. 72 | foldMap1DefaultR :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m 73 | foldMap1DefaultR f = map f >>> foldr1 (<>) 74 | 75 | -- | A default implementation of `foldMap1` using `foldl1`. 76 | -- | 77 | -- | Note: when defining a `Foldable1` instance, this function is unsafe to use 78 | -- | in combination with `foldl1Default`. 79 | foldMap1DefaultL :: forall t m a. Foldable1 t => Functor t => Semigroup m => (a -> m) -> t a -> m 80 | foldMap1DefaultL f = map f >>> foldl1 (<>) 81 | 82 | instance foldableDual :: Foldable1 Dual where 83 | foldr1 _ (Dual x) = x 84 | foldl1 _ (Dual x) = x 85 | foldMap1 f (Dual x) = f x 86 | 87 | instance foldableMultiplicative :: Foldable1 Multiplicative where 88 | foldr1 _ (Multiplicative x) = x 89 | foldl1 _ (Multiplicative x) = x 90 | foldMap1 f (Multiplicative x) = f x 91 | 92 | instance foldableTuple :: Foldable1 (Tuple a) where 93 | foldMap1 f (Tuple _ x) = f x 94 | foldr1 _ (Tuple _ x) = x 95 | foldl1 _ (Tuple _ x) = x 96 | 97 | instance foldableIdentity :: Foldable1 Identity where 98 | foldMap1 f (Identity x) = f x 99 | foldl1 _ (Identity x) = x 100 | foldr1 _ (Identity x) = x 101 | 102 | -- | Fold a data structure, accumulating values in some `Semigroup`. 103 | fold1 :: forall t m. Foldable1 t => Semigroup m => t m -> m 104 | fold1 = foldMap1 identity 105 | 106 | newtype Act :: forall k. (k -> Type) -> k -> Type 107 | newtype Act f a = Act (f a) 108 | 109 | getAct :: forall f a. Act f a -> f a 110 | getAct (Act f) = f 111 | 112 | instance semigroupAct :: Apply f => Semigroup (Act f a) where 113 | append (Act a) (Act b) = Act (a *> b) 114 | 115 | -- | Traverse a data structure, performing some effects encoded by an 116 | -- | `Apply` instance at each value, ignoring the final result. 117 | traverse1_ :: forall t f a b. Foldable1 t => Apply f => (a -> f b) -> t a -> f Unit 118 | traverse1_ f t = unit <$ getAct (foldMap1 (Act <<< f) t) 119 | 120 | -- | A version of `traverse1_` with its arguments flipped. 121 | -- | 122 | -- | This can be useful when running an action written using do notation 123 | -- | for every element in a data structure: 124 | for1_ :: forall t f a b. Foldable1 t => Apply f => t a -> (a -> f b) -> f Unit 125 | for1_ = flip traverse1_ 126 | 127 | -- | Perform all of the effects in some data structure in the order 128 | -- | given by the `Foldable1` instance, ignoring the final result. 129 | sequence1_ :: forall t f a. Foldable1 t => Apply f => t (f a) -> f Unit 130 | sequence1_ = traverse1_ identity 131 | 132 | maximum :: forall f a. Ord a => Foldable1 f => f a -> a 133 | maximum = ala Max foldMap1 134 | 135 | maximumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a 136 | maximumBy cmp = foldl1 \x y -> if cmp x y == GT then x else y 137 | 138 | minimum :: forall f a. Ord a => Foldable1 f => f a -> a 139 | minimum = ala Min foldMap1 140 | 141 | minimumBy :: forall f a. Foldable1 f => (a -> a -> Ordering) -> f a -> a 142 | minimumBy cmp = foldl1 \x y -> if cmp x y == LT then x else y 143 | 144 | -- | Internal. Used by intercalation functions. 145 | newtype JoinWith a = JoinWith (a -> a) 146 | 147 | joinee :: forall a. JoinWith a -> a -> a 148 | joinee (JoinWith x) = x 149 | 150 | instance semigroupJoinWith :: Semigroup a => Semigroup (JoinWith a) where 151 | append (JoinWith a) (JoinWith b) = JoinWith $ \j -> a j <> j <> b j 152 | 153 | -- | Fold a data structure using a `Semigroup` instance, 154 | -- | combining adjacent elements using the specified separator. 155 | intercalate :: forall f m. Foldable1 f => Semigroup m => m -> f m -> m 156 | intercalate = flip intercalateMap identity 157 | 158 | -- | Fold a data structure, accumulating values in some `Semigroup`, 159 | -- | combining adjacent elements using the specified separator. 160 | intercalateMap 161 | :: forall f m a 162 | . Foldable1 f 163 | => Semigroup m 164 | => m -> (a -> m) -> f a -> m 165 | intercalateMap j f foldable = 166 | joinee (foldMap1 (JoinWith <<< const <<< f) foldable) j 167 | 168 | -- | Internal. Used by foldr1Default and foldl1Default. 169 | data FoldRight1 a = FoldRight1 (a -> (a -> a -> a) -> a) a 170 | 171 | instance foldRight1Semigroup :: Semigroup (FoldRight1 a) where 172 | append (FoldRight1 lf lr) (FoldRight1 rf rr) = FoldRight1 (\a f -> lf (f lr (rf a f)) f) rr 173 | 174 | mkFoldRight1 :: forall a. a -> FoldRight1 a 175 | mkFoldRight1 = FoldRight1 const 176 | 177 | runFoldRight1 :: forall a. FoldRight1 a -> (a -> a -> a) -> a 178 | runFoldRight1 (FoldRight1 f a) = f a 179 | -------------------------------------------------------------------------------- /src/Data/Semigroup/Traversable.purs: -------------------------------------------------------------------------------- 1 | module Data.Semigroup.Traversable where 2 | 3 | import Prelude 4 | 5 | import Data.Identity (Identity(..)) 6 | import Data.Monoid.Dual (Dual(..)) 7 | import Data.Monoid.Multiplicative (Multiplicative(..)) 8 | import Data.Semigroup.Foldable (class Foldable1) 9 | import Data.Traversable (class Traversable) 10 | import Data.Tuple (Tuple(..)) 11 | 12 | -- | `Traversable1` represents data structures with a minimum of one element that can be _traversed_, 13 | -- | accumulating results and effects in some `Applicative` functor. 14 | -- | 15 | -- | - `traverse1` runs an action for every element in a data structure, 16 | -- | and accumulates the results. 17 | -- | - `sequence1` runs the actions _contained_ in a data structure, 18 | -- | and accumulates the results. 19 | -- | 20 | -- | The `traverse1` and `sequence1` functions should be compatible in the 21 | -- | following sense: 22 | -- | 23 | -- | - `traverse1 f xs = sequence1 (f <$> xs)` 24 | -- | - `sequence1 = traverse1 identity` 25 | -- | 26 | -- | `Traversable1` instances should also be compatible with the corresponding 27 | -- | `Foldable1` instances, in the following sense: 28 | -- | 29 | -- | - `foldMap1 f = runConst <<< traverse1 (Const <<< f)` 30 | -- | 31 | -- | Default implementations are provided by the following functions: 32 | -- | 33 | -- | - `traverse1Default` 34 | -- | - `sequence1Default` 35 | class (Foldable1 t, Traversable t) <= Traversable1 t where 36 | traverse1 :: forall a b f. Apply f => (a -> f b) -> t a -> f (t b) 37 | sequence1 :: forall b f. Apply f => t (f b) -> f (t b) 38 | 39 | instance traversableDual :: Traversable1 Dual where 40 | traverse1 f (Dual x) = Dual <$> f x 41 | sequence1 = sequence1Default 42 | 43 | instance traversableMultiplicative :: Traversable1 Multiplicative where 44 | traverse1 f (Multiplicative x) = Multiplicative <$> f x 45 | sequence1 = sequence1Default 46 | 47 | instance traversableTuple :: Traversable1 (Tuple a) where 48 | traverse1 f (Tuple x y) = Tuple x <$> f y 49 | sequence1 (Tuple x y) = Tuple x <$> y 50 | 51 | instance traversableIdentity :: Traversable1 Identity where 52 | traverse1 f (Identity x) = Identity <$> f x 53 | sequence1 (Identity x) = Identity <$> x 54 | 55 | -- | A default implementation of `traverse1` using `sequence1`. 56 | traverse1Default 57 | :: forall t a b m 58 | . Traversable1 t 59 | => Apply m 60 | => (a -> m b) 61 | -> t a 62 | -> m (t b) 63 | traverse1Default f ta = sequence1 (f <$> ta) 64 | 65 | -- | A default implementation of `sequence1` using `traverse1`. 66 | sequence1Default 67 | :: forall t a m 68 | . Traversable1 t 69 | => Apply m 70 | => t (m a) 71 | -> m (t a) 72 | sequence1Default = traverse1 identity 73 | -------------------------------------------------------------------------------- /src/Data/Traversable.js: -------------------------------------------------------------------------------- 1 | // jshint maxparams: 3 2 | 3 | export const traverseArrayImpl = (function () { 4 | function array1(a) { 5 | return [a]; 6 | } 7 | 8 | function array2(a) { 9 | return function (b) { 10 | return [a, b]; 11 | }; 12 | } 13 | 14 | function array3(a) { 15 | return function (b) { 16 | return function (c) { 17 | return [a, b, c]; 18 | }; 19 | }; 20 | } 21 | 22 | function concat2(xs) { 23 | return function (ys) { 24 | return xs.concat(ys); 25 | }; 26 | } 27 | 28 | return function (apply) { 29 | return function (map) { 30 | return function (pure) { 31 | return function (f) { 32 | return function (array) { 33 | function go(bot, top) { 34 | switch (top - bot) { 35 | case 0: return pure([]); 36 | case 1: return map(array1)(f(array[bot])); 37 | case 2: return apply(map(array2)(f(array[bot])))(f(array[bot + 1])); 38 | case 3: return apply(apply(map(array3)(f(array[bot])))(f(array[bot + 1])))(f(array[bot + 2])); 39 | default: 40 | // This slightly tricky pivot selection aims to produce two 41 | // even-length partitions where possible. 42 | var pivot = bot + Math.floor((top - bot) / 4) * 2; 43 | return apply(map(concat2)(go(bot, pivot)))(go(pivot, top)); 44 | } 45 | } 46 | return go(0, array.length); 47 | }; 48 | }; 49 | }; 50 | }; 51 | }; 52 | })(); 53 | -------------------------------------------------------------------------------- /src/Data/Traversable.purs: -------------------------------------------------------------------------------- 1 | module Data.Traversable 2 | ( class Traversable, traverse, sequence 3 | , traverseDefault, sequenceDefault 4 | , for 5 | , scanl 6 | , scanr 7 | , mapAccumL 8 | , mapAccumR 9 | , module Data.Foldable 10 | , module Data.Traversable.Accum 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Apply (lift2) 16 | import Data.Const (Const(..)) 17 | import Data.Either (Either(..)) 18 | 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_) 19 | import Data.Functor.App (App(..)) 20 | import Data.Functor.Compose (Compose(..)) 21 | import Data.Functor.Coproduct (Coproduct(..), coproduct) 22 | import Data.Functor.Product (Product(..), product) 23 | import Data.Identity (Identity(..)) 24 | import Data.Maybe (Maybe(..)) 25 | import Data.Maybe.First (First(..)) 26 | import Data.Maybe.Last (Last(..)) 27 | import Data.Monoid.Additive (Additive(..)) 28 | import Data.Monoid.Conj (Conj(..)) 29 | import Data.Monoid.Disj (Disj(..)) 30 | import Data.Monoid.Dual (Dual(..)) 31 | import Data.Monoid.Multiplicative (Multiplicative(..)) 32 | import Data.Traversable.Accum (Accum) 33 | import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) 34 | import Data.Tuple (Tuple(..)) 35 | 36 | -- | `Traversable` represents data structures which can be _traversed_, 37 | -- | accumulating results and effects in some `Applicative` functor. 38 | -- | 39 | -- | - `traverse` runs an action for every element in a data structure, 40 | -- | and accumulates the results. 41 | -- | - `sequence` runs the actions _contained_ in a data structure, 42 | -- | and accumulates the results. 43 | -- | 44 | -- | ```purescript 45 | -- | import Data.Traversable 46 | -- | import Data.Maybe 47 | -- | import Data.Int (fromNumber) 48 | -- | 49 | -- | sequence [Just 1, Just 2, Just 3] == Just [1,2,3] 50 | -- | sequence [Nothing, Just 2, Just 3] == Nothing 51 | -- | 52 | -- | traverse fromNumber [1.0, 2.0, 3.0] == Just [1,2,3] 53 | -- | traverse fromNumber [1.5, 2.0, 3.0] == Nothing 54 | -- | 55 | -- | traverse logShow [1,2,3] 56 | -- | -- prints: 57 | -- | 1 58 | -- | 2 59 | -- | 3 60 | -- | 61 | -- | traverse (\x -> [x, 0]) [1,2,3] == [[1,2,3],[1,2,0],[1,0,3],[1,0,0],[0,2,3],[0,2,0],[0,0,3],[0,0,0]] 62 | -- | ``` 63 | -- | 64 | -- | The `traverse` and `sequence` functions should be compatible in the 65 | -- | following sense: 66 | -- | 67 | -- | - `traverse f xs = sequence (f <$> xs)` 68 | -- | - `sequence = traverse identity` 69 | -- | 70 | -- | `Traversable` instances should also be compatible with the corresponding 71 | -- | `Foldable` instances, in the following sense: 72 | -- | 73 | -- | - `foldMap f = runConst <<< traverse (Const <<< f)` 74 | -- | 75 | -- | Default implementations are provided by the following functions: 76 | -- | 77 | -- | - `traverseDefault` 78 | -- | - `sequenceDefault` 79 | class (Functor t, Foldable t) <= Traversable t where 80 | traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b) 81 | sequence :: forall a m. Applicative m => t (m a) -> m (t a) 82 | 83 | -- | A default implementation of `traverse` using `sequence` and `map`. 84 | traverseDefault 85 | :: forall t a b m 86 | . Traversable t 87 | => Applicative m 88 | => (a -> m b) 89 | -> t a 90 | -> m (t b) 91 | traverseDefault f ta = sequence (f <$> ta) 92 | 93 | -- | A default implementation of `sequence` using `traverse`. 94 | sequenceDefault 95 | :: forall t a m 96 | . Traversable t 97 | => Applicative m 98 | => t (m a) 99 | -> m (t a) 100 | sequenceDefault = traverse identity 101 | 102 | instance traversableArray :: Traversable Array where 103 | traverse = traverseArrayImpl apply map pure 104 | sequence = sequenceDefault 105 | 106 | foreign import traverseArrayImpl 107 | :: forall m a b 108 | . (forall x y. m (x -> y) -> m x -> m y) 109 | -> (forall x y. (x -> y) -> m x -> m y) 110 | -> (forall x. x -> m x) 111 | -> (a -> m b) 112 | -> Array a 113 | -> m (Array b) 114 | 115 | instance traversableMaybe :: Traversable Maybe where 116 | traverse _ Nothing = pure Nothing 117 | traverse f (Just x) = Just <$> f x 118 | sequence Nothing = pure Nothing 119 | sequence (Just x) = Just <$> x 120 | 121 | instance traversableFirst :: Traversable First where 122 | traverse f (First x) = First <$> traverse f x 123 | sequence (First x) = First <$> sequence x 124 | 125 | instance traversableLast :: Traversable Last where 126 | traverse f (Last x) = Last <$> traverse f x 127 | sequence (Last x) = Last <$> sequence x 128 | 129 | instance traversableAdditive :: Traversable Additive where 130 | traverse f (Additive x) = Additive <$> f x 131 | sequence (Additive x) = Additive <$> x 132 | 133 | instance traversableDual :: Traversable Dual where 134 | traverse f (Dual x) = Dual <$> f x 135 | sequence (Dual x) = Dual <$> x 136 | 137 | instance traversableConj :: Traversable Conj where 138 | traverse f (Conj x) = Conj <$> f x 139 | sequence (Conj x) = Conj <$> x 140 | 141 | instance traversableDisj :: Traversable Disj where 142 | traverse f (Disj x) = Disj <$> f x 143 | sequence (Disj x) = Disj <$> x 144 | 145 | instance traversableMultiplicative :: Traversable Multiplicative where 146 | traverse f (Multiplicative x) = Multiplicative <$> f x 147 | sequence (Multiplicative x) = Multiplicative <$> x 148 | 149 | instance traversableEither :: Traversable (Either a) where 150 | traverse _ (Left x) = pure (Left x) 151 | traverse f (Right x) = Right <$> f x 152 | sequence (Left x) = pure (Left x) 153 | sequence (Right x) = Right <$> x 154 | 155 | instance traversableTuple :: Traversable (Tuple a) where 156 | traverse f (Tuple x y) = Tuple x <$> f y 157 | sequence (Tuple x y) = Tuple x <$> y 158 | 159 | instance traversableIdentity :: Traversable Identity where 160 | traverse f (Identity x) = Identity <$> f x 161 | sequence (Identity x) = Identity <$> x 162 | 163 | instance traversableConst :: Traversable (Const a) where 164 | traverse _ (Const x) = pure (Const x) 165 | sequence (Const x) = pure (Const x) 166 | 167 | instance traversableProduct :: (Traversable f, Traversable g) => Traversable (Product f g) where 168 | traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga) 169 | sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga) 170 | 171 | instance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where 172 | traverse f = coproduct 173 | (map (Coproduct <<< Left) <<< traverse f) 174 | (map (Coproduct <<< Right) <<< traverse f) 175 | sequence = coproduct 176 | (map (Coproduct <<< Left) <<< sequence) 177 | (map (Coproduct <<< Right) <<< sequence) 178 | 179 | instance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where 180 | traverse f (Compose fga) = map Compose $ traverse (traverse f) fga 181 | sequence = traverse identity 182 | 183 | instance traversableApp :: Traversable f => Traversable (App f) where 184 | traverse f (App x) = App <$> traverse f x 185 | sequence (App x) = App <$> sequence x 186 | 187 | -- | A version of `traverse` with its arguments flipped. 188 | -- | 189 | -- | 190 | -- | This can be useful when running an action written using do notation 191 | -- | for every element in a data structure: 192 | -- | 193 | -- | For example: 194 | -- | 195 | -- | ```purescript 196 | -- | for [1, 2, 3] \n -> do 197 | -- | print n 198 | -- | return (n * n) 199 | -- | ``` 200 | for 201 | :: forall a b m t 202 | . Applicative m 203 | => Traversable t 204 | => t a 205 | -> (a -> m b) 206 | -> m (t b) 207 | for x f = traverse f x 208 | 209 | -- | Fold a data structure from the left, keeping all intermediate results 210 | -- | instead of only the final result. Note that the initial value does not 211 | -- | appear in the result (unlike Haskell's `Prelude.scanl`). 212 | -- | 213 | -- | ```purescript 214 | -- | scanl (+) 0 [1,2,3] = [1,3,6] 215 | -- | scanl (-) 10 [1,2,3] = [9,7,4] 216 | -- | ``` 217 | scanl :: forall a b f. Traversable f => (b -> a -> b) -> b -> f a -> f b 218 | scanl f b0 xs = (mapAccumL (\b a -> let b' = f b a in { accum: b', value: b' }) b0 xs).value 219 | 220 | -- | Fold a data structure from the left, keeping all intermediate results 221 | -- | instead of only the final result. 222 | -- | 223 | -- | Unlike `scanl`, `mapAccumL` allows the type of accumulator to differ 224 | -- | from the element type of the final data structure. 225 | mapAccumL 226 | :: forall a b s f 227 | . Traversable f 228 | => (s -> a -> Accum s b) 229 | -> s 230 | -> f a 231 | -> Accum s (f b) 232 | mapAccumL f s0 xs = stateL (traverse (\a -> StateL \s -> f s a) xs) s0 233 | 234 | -- | Fold a data structure from the right, keeping all intermediate results 235 | -- | instead of only the final result. Note that the initial value does not 236 | -- | appear in the result (unlike Haskell's `Prelude.scanr`). 237 | -- | 238 | -- | ```purescript 239 | -- | scanr (+) 0 [1,2,3] = [6,5,3] 240 | -- | scanr (flip (-)) 10 [1,2,3] = [4,5,7] 241 | -- | ``` 242 | scanr :: forall a b f. Traversable f => (a -> b -> b) -> b -> f a -> f b 243 | scanr f b0 xs = (mapAccumR (\b a -> let b' = f a b in { accum: b', value: b' }) b0 xs).value 244 | 245 | -- | Fold a data structure from the right, keeping all intermediate results 246 | -- | instead of only the final result. 247 | -- | 248 | -- | Unlike `scanr`, `mapAccumR` allows the type of accumulator to differ 249 | -- | from the element type of the final data structure. 250 | mapAccumR 251 | :: forall a b s f 252 | . Traversable f 253 | => (s -> a -> Accum s b) 254 | -> s 255 | -> f a 256 | -> Accum s (f b) 257 | mapAccumR f s0 xs = stateR (traverse (\a -> StateR \s -> f s a) xs) s0 258 | -------------------------------------------------------------------------------- /src/Data/Traversable/Accum.purs: -------------------------------------------------------------------------------- 1 | module Data.Traversable.Accum 2 | ( Accum 3 | ) where 4 | 5 | type Accum s a = { accum :: s, value :: a } 6 | -------------------------------------------------------------------------------- /src/Data/Traversable/Accum/Internal.purs: -------------------------------------------------------------------------------- 1 | module Data.Traversable.Accum.Internal 2 | ( StateL(..) 3 | , stateL 4 | , StateR(..) 5 | , stateR 6 | ) where 7 | 8 | import Prelude 9 | import Data.Traversable.Accum (Accum) 10 | 11 | newtype StateL s a = StateL (s -> Accum s a) 12 | 13 | stateL :: forall s a. StateL s a -> s -> Accum s a 14 | stateL (StateL k) = k 15 | 16 | instance functorStateL :: Functor (StateL s) where 17 | map f k = StateL \s -> case stateL k s of 18 | { accum: s1, value: a } -> { accum: s1, value: f a } 19 | 20 | instance applyStateL :: Apply (StateL s) where 21 | apply f x = StateL \s -> case stateL f s of 22 | { accum: s1, value: f' } -> case stateL x s1 of 23 | { accum: s2, value: x' } -> { accum: s2, value: f' x' } 24 | 25 | instance applicativeStateL :: Applicative (StateL s) where 26 | pure a = StateL \s -> { accum: s, value: a } 27 | 28 | 29 | newtype StateR s a = StateR (s -> Accum s a) 30 | 31 | stateR :: forall s a. StateR s a -> s -> Accum s a 32 | stateR (StateR k) = k 33 | 34 | instance functorStateR :: Functor (StateR s) where 35 | map f k = StateR \s -> case stateR k s of 36 | { accum: s1, value: a } -> { accum: s1, value: f a } 37 | 38 | instance applyStateR :: Apply (StateR s) where 39 | apply f x = StateR \s -> case stateR x s of 40 | { accum: s1, value: x' } -> case stateR f s1 of 41 | { accum: s2, value: f' } -> { accum: s2, value: f' x' } 42 | 43 | instance applicativeStateR :: Applicative (StateR s) where 44 | pure a = StateR \s -> { accum: s, value: a } 45 | -------------------------------------------------------------------------------- /src/Data/TraversableWithIndex.purs: -------------------------------------------------------------------------------- 1 | module Data.TraversableWithIndex 2 | ( class TraversableWithIndex, traverseWithIndex 3 | , traverseWithIndexDefault 4 | , forWithIndex 5 | , scanlWithIndex 6 | , mapAccumLWithIndex 7 | , scanrWithIndex 8 | , mapAccumRWithIndex 9 | , traverseDefault 10 | , module Data.Traversable.Accum 11 | ) where 12 | 13 | import Prelude 14 | 15 | import Control.Apply (lift2) 16 | import Data.Const (Const(..)) 17 | import Data.Either (Either(..)) 18 | import Data.FoldableWithIndex (class FoldableWithIndex) 19 | import Data.Functor.App (App(..)) 20 | import Data.Functor.Compose (Compose(..)) 21 | import Data.Functor.Coproduct (Coproduct(..), coproduct) 22 | import Data.Functor.Product (Product(..), product) 23 | import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) 24 | import Data.Identity (Identity(..)) 25 | import Data.Maybe (Maybe) 26 | import Data.Maybe.First (First) 27 | import Data.Maybe.Last (Last) 28 | import Data.Monoid.Additive (Additive) 29 | import Data.Monoid.Conj (Conj) 30 | import Data.Monoid.Disj (Disj) 31 | import Data.Monoid.Dual (Dual) 32 | import Data.Monoid.Multiplicative (Multiplicative) 33 | import Data.Traversable (class Traversable, sequence, traverse) 34 | import Data.Traversable.Accum (Accum) 35 | import Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR) 36 | import Data.Tuple (Tuple(..), curry) 37 | 38 | 39 | -- | A `Traversable` with an additional index. 40 | -- | A `TraversableWithIndex` instance must be compatible with its 41 | -- | `Traversable` instance 42 | -- | ```purescript 43 | -- | traverse f = traverseWithIndex (const f) 44 | -- | ``` 45 | -- | with its `FoldableWithIndex` instance 46 | -- | ``` 47 | -- | foldMapWithIndex f = unwrap <<< traverseWithIndex (\i -> Const <<< f i) 48 | -- | ``` 49 | -- | and with its `FunctorWithIndex` instance 50 | -- | ``` 51 | -- | mapWithIndex f = unwrap <<< traverseWithIndex (\i -> Identity <<< f i) 52 | -- | ``` 53 | -- | 54 | -- | A default implementation is provided by `traverseWithIndexDefault`. 55 | class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) <= TraversableWithIndex i t | t -> i where 56 | traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b) 57 | 58 | -- | A default implementation of `traverseWithIndex` using `sequence` and `mapWithIndex`. 59 | traverseWithIndexDefault 60 | :: forall i t a b m 61 | . TraversableWithIndex i t 62 | => Applicative m 63 | => (i -> a -> m b) 64 | -> t a 65 | -> m (t b) 66 | traverseWithIndexDefault f = sequence <<< mapWithIndex f 67 | 68 | instance traversableWithIndexArray :: TraversableWithIndex Int Array where 69 | traverseWithIndex = traverseWithIndexDefault 70 | 71 | instance traversableWithIndexMaybe :: TraversableWithIndex Unit Maybe where 72 | traverseWithIndex f = traverse $ f unit 73 | 74 | instance traversableWithIndexFirst :: TraversableWithIndex Unit First where 75 | traverseWithIndex f = traverse $ f unit 76 | 77 | instance traversableWithIndexLast :: TraversableWithIndex Unit Last where 78 | traverseWithIndex f = traverse $ f unit 79 | 80 | instance traversableWithIndexAdditive :: TraversableWithIndex Unit Additive where 81 | traverseWithIndex f = traverse $ f unit 82 | 83 | instance traversableWithIndexDual :: TraversableWithIndex Unit Dual where 84 | traverseWithIndex f = traverse $ f unit 85 | 86 | instance traversableWithIndexConj :: TraversableWithIndex Unit Conj where 87 | traverseWithIndex f = traverse $ f unit 88 | 89 | instance traversableWithIndexDisj :: TraversableWithIndex Unit Disj where 90 | traverseWithIndex f = traverse $ f unit 91 | 92 | instance traversableWithIndexMultiplicative :: TraversableWithIndex Unit Multiplicative where 93 | traverseWithIndex f = traverse $ f unit 94 | 95 | instance traversableWithIndexEither :: TraversableWithIndex Unit (Either a) where 96 | traverseWithIndex _ (Left x) = pure (Left x) 97 | traverseWithIndex f (Right x) = Right <$> f unit x 98 | 99 | instance traversableWithIndexTuple :: TraversableWithIndex Unit (Tuple a) where 100 | traverseWithIndex f (Tuple x y) = Tuple x <$> f unit y 101 | 102 | instance traversableWithIndexIdentity :: TraversableWithIndex Unit Identity where 103 | traverseWithIndex f (Identity x) = Identity <$> f unit x 104 | 105 | instance traversableWithIndexConst :: TraversableWithIndex Void (Const a) where 106 | traverseWithIndex _ (Const x) = pure (Const x) 107 | 108 | instance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where 109 | traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga) 110 | 111 | instance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where 112 | traverseWithIndex f = coproduct 113 | (map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left)) 114 | (map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right)) 115 | 116 | instance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where 117 | traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga 118 | 119 | instance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f) where 120 | traverseWithIndex f (App x) = App <$> traverseWithIndex f x 121 | 122 | -- | A version of `traverseWithIndex` with its arguments flipped. 123 | -- | 124 | -- | 125 | -- | This can be useful when running an action written using do notation 126 | -- | for every element in a data structure: 127 | -- | 128 | -- | For example: 129 | -- | 130 | -- | ```purescript 131 | -- | for [1, 2, 3] \i x -> do 132 | -- | logShow i 133 | -- | pure (x * x) 134 | -- | ``` 135 | forWithIndex 136 | :: forall i a b m t 137 | . Applicative m 138 | => TraversableWithIndex i t 139 | => t a 140 | -> (i -> a -> m b) 141 | -> m (t b) 142 | forWithIndex = flip traverseWithIndex 143 | 144 | -- | Fold a data structure from the left with access to the indices, keeping 145 | -- | all intermediate results instead of only the final result. Note that the 146 | -- | initial value does not appear in the result (unlike Haskell's 147 | -- | `Prelude.scanl`). 148 | -- | 149 | -- | ```purescript 150 | -- | scanlWithIndex (\i y x -> i + y + x) 0 [1, 2, 3] = [1, 4, 9] 151 | -- | ``` 152 | scanlWithIndex 153 | :: forall i a b f 154 | . TraversableWithIndex i f 155 | => (i -> b -> a -> b) 156 | -> b 157 | -> f a 158 | -> f b 159 | scanlWithIndex f b0 xs = 160 | (mapAccumLWithIndex (\i b a -> let b' = f i b a in { accum: b', value: b' }) b0 xs).value 161 | 162 | -- | Fold a data structure from the left with access to the indices, keeping 163 | -- | all intermediate results instead of only the final result. 164 | -- | 165 | -- | Unlike `scanlWithIndex`, `mapAccumLWithIndex` allows the type of accumulator to differ 166 | -- | from the element type of the final data structure. 167 | mapAccumLWithIndex 168 | :: forall i a b s f 169 | . TraversableWithIndex i f 170 | => (i -> s -> a -> Accum s b) 171 | -> s 172 | -> f a 173 | -> Accum s (f b) 174 | mapAccumLWithIndex f s0 xs = stateL (traverseWithIndex (\i a -> StateL \s -> f i s a) xs) s0 175 | 176 | -- | Fold a data structure from the right with access to the indices, keeping 177 | -- | all intermediate results instead of only the final result. Note that the 178 | -- | initial value does not appear in the result (unlike Haskell's `Prelude.scanr`). 179 | -- | 180 | -- | ```purescript 181 | -- | scanrWithIndex (\i x y -> i + x + y) 0 [1, 2, 3] = [9, 8, 5] 182 | -- | ``` 183 | scanrWithIndex 184 | :: forall i a b f 185 | . TraversableWithIndex i f 186 | => (i -> a -> b -> b) 187 | -> b 188 | -> f a 189 | -> f b 190 | scanrWithIndex f b0 xs = 191 | (mapAccumRWithIndex (\i b a -> let b' = f i a b in { accum: b', value: b' }) b0 xs).value 192 | 193 | -- | Fold a data structure from the right with access to the indices, keeping 194 | -- | all intermediate results instead of only the final result. 195 | -- | 196 | -- | Unlike `scanrWithIndex`, `imapAccumRWithIndex` allows the type of accumulator to differ 197 | -- | from the element type of the final data structure. 198 | mapAccumRWithIndex 199 | :: forall i a b s f 200 | . TraversableWithIndex i f 201 | => (i -> s -> a -> Accum s b) 202 | -> s 203 | -> f a 204 | -> Accum s (f b) 205 | mapAccumRWithIndex f s0 xs = stateR (traverseWithIndex (\i a -> StateR \s -> f i s a) xs) s0 206 | 207 | -- | A default implementation of `traverse` in terms of `traverseWithIndex` 208 | traverseDefault 209 | :: forall i t a b m 210 | . TraversableWithIndex i t 211 | => Applicative m 212 | => (a -> m b) -> t a -> m (t b) 213 | traverseDefault f = traverseWithIndex (const f) 214 | -------------------------------------------------------------------------------- /test/Main.js: -------------------------------------------------------------------------------- 1 | export function arrayFrom1UpTo(n) { 2 | var result = []; 3 | for (var i = 1; i <= n; i++) { 4 | result.push(i); 5 | } 6 | return result; 7 | } 8 | 9 | export function arrayReplicate(n) { 10 | return function (x) { 11 | var result = []; 12 | for (var i = 1; i <= n; i++) { 13 | result.push(x); 14 | } 15 | return result; 16 | }; 17 | } 18 | 19 | export function mkNEArray(nothing) { 20 | return function (just) { 21 | return function (arr) { 22 | return arr.length > 0 ? just(arr) : nothing; 23 | }; 24 | }; 25 | } 26 | 27 | export function foldMap1NEArray(append) { 28 | return function (f) { 29 | return function (arr) { 30 | var acc = f(arr[0]); 31 | var len = arr.length; 32 | for (var i = 1; i < len; i++) { 33 | acc = append(acc)(f(arr[i])); 34 | } 35 | return acc; 36 | }; 37 | }; 38 | } 39 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Data.Bifoldable (class Bifoldable, bifoldl, bifoldr, bifoldMap, bifoldrDefault, bifoldlDefault, bifoldMapDefaultR, bifoldMapDefaultL) 6 | import Data.Bifunctor (class Bifunctor, bimap) 7 | import Data.Bitraversable (class Bitraversable, bisequenceDefault, bitraverse, bisequence, bitraverseDefault) 8 | import Data.Foldable (class Foldable, find, findMap, fold, indexl, indexr, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, length, maximum, maximumBy, minimum, minimumBy, null, surroundMap) 9 | import Data.FoldableWithIndex (class FoldableWithIndex, findWithIndex, findMapWithIndex, foldMapWithIndex, foldMapWithIndexDefaultL, foldMapWithIndexDefaultR, foldlWithIndex, foldlWithIndexDefault, foldrWithIndex, foldrWithIndexDefault, surroundMapWithIndex) 10 | import Data.Function (on) 11 | import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) 12 | import Data.Int (toNumber, pow) 13 | import Data.Maybe (Maybe(..)) 14 | import Data.Monoid.Additive (Additive(..)) 15 | import Data.Newtype (unwrap) 16 | import Data.Number (abs) 17 | import Data.Semigroup.Foldable (class Foldable1, foldr1, foldl1, foldr1Default, foldl1Default) 18 | import Data.Semigroup.Foldable as Foldable1 19 | import Data.Traversable (class Traversable, sequenceDefault, traverse, sequence, traverseDefault) 20 | import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) 21 | import Effect (Effect, foreachE) 22 | import Effect.Console (log) 23 | import Performance.Minibench (benchWith) 24 | import Test.Assert (assert, assert') 25 | import Unsafe.Coerce (unsafeCoerce) 26 | 27 | foreign import arrayFrom1UpTo :: Int -> Array Int 28 | foreign import arrayReplicate :: forall a. Int -> a -> Array a 29 | 30 | foreign import data NEArray :: Type -> Type 31 | foreign import mkNEArray :: forall r a. r -> (NEArray a -> r) -> Array a -> r 32 | foreign import foldMap1NEArray :: forall r a. (r -> r -> r) -> (a -> r) -> NEArray a -> r 33 | 34 | instance foldableNEArray :: Foldable NEArray where 35 | foldMap = foldMap1NEArray append 36 | foldl f = foldlDefault f 37 | foldr f = foldrDefault f 38 | 39 | instance foldable1NEArray :: Foldable1 NEArray where 40 | foldr1 f = foldr1Default f 41 | foldl1 f = foldl1Default f 42 | foldMap1 = foldMap1NEArray append 43 | 44 | maybeMkNEArray :: forall a. Array a -> Maybe (NEArray a) 45 | maybeMkNEArray = mkNEArray Nothing Just 46 | 47 | foldableLength :: forall f a. Foldable f => f a -> Int 48 | foldableLength = unwrap <<< foldMap (const (Additive 1)) 49 | 50 | -- Ensure that a value is evaluated 'lazily' by treating it as an Eff action. 51 | deferEff :: forall a. (Unit -> a) -> Effect a 52 | deferEff = unsafeCoerce 53 | 54 | main :: Effect Unit 55 | main = do 56 | log "Test foldableArray instance" 57 | testFoldableArrayWith 20 58 | 59 | assert $ foldMapDefaultL (\x -> [x]) [1, 2] == [1, 2] 60 | 61 | log "Test foldableArray instance is stack safe" 62 | testFoldableArrayWith 20_000 63 | 64 | log "Test foldMapDefaultL" 65 | testFoldableFoldMapDefaultL 20 66 | 67 | log "Test foldMapDefaultL is stack safe" 68 | testFoldableFoldMapDefaultL 20_000 69 | 70 | log "Test foldMapDefaultR" 71 | testFoldableFoldMapDefaultR 20 72 | 73 | log "Test foldMapDefaultR is stack safe" 74 | testFoldableFoldMapDefaultR 20_000 75 | 76 | log "Test foldlDefault" 77 | testFoldableFoldlDefault 20 78 | 79 | log "Test foldlDefault is stack safe" 80 | testFoldableFoldlDefault 20_000 81 | 82 | log "Test foldrDefault" 83 | testFoldableFoldrDefault 20 84 | 85 | log "Test foldrDefault is stack safe" 86 | testFoldableFoldrDefault 20_000 87 | 88 | foreachE [1,2,3,4,5,10,20] \i -> do 89 | log $ "Test traversableArray instance with an array of size: " <> show i 90 | testTraversableArrayWith i 91 | 92 | log "Test traversableArray instance is stack safe" 93 | testTraversableArrayWith 20_000 94 | 95 | log "Test traverseDefault" 96 | testTraverseDefault 20 97 | 98 | log "Test sequenceDefault" 99 | testSequenceDefault 20 100 | 101 | log "Test foldableWithIndexArray instance" 102 | testFoldableWithIndexArrayWith 20 103 | 104 | log "Test foldableWithIndexArray instance is stack safe" 105 | testFoldableWithIndexArrayWith 20_000 106 | 107 | log "Test FoldableWithIndex laws for array instance" 108 | testFoldableWithIndexLawsOn 109 | ["a", "b", "c"] 110 | (\i x -> [Tuple i x]) 111 | (\x -> [x]) 112 | 113 | log "Test traversableArrayWithIndex instance" 114 | testTraversableWithIndexArrayWith 20 115 | 116 | log "Test Bifoldable on `inclusive or`" 117 | testBifoldableIOrWith identity 10 100 42 118 | 119 | log "Test bifoldMapDefaultL" 120 | testBifoldableIOrWith BFML 10 100 42 121 | 122 | log "Test bifoldMapDefaultR" 123 | testBifoldableIOrWith BFMR 10 100 42 124 | 125 | log "Test bifoldlDefault" 126 | testBifoldableIOrWith BFLD 10 100 42 127 | 128 | log "Test bifoldrDefault" 129 | testBifoldableIOrWith BFRD 10 100 42 130 | 131 | log "Test Bitraversable on `inclusive or`" 132 | testBitraversableIOrWith identity 133 | 134 | log "Test bitraverseDefault" 135 | testBitraversableIOrWith BTD 136 | 137 | log "Test bisequenceDefault" 138 | testBitraversableIOrWith BSD 139 | 140 | log "Test indexl" 141 | assert $ indexl 2 [1, 5, 10] == Just 10 142 | assert $ indexl 0 [1, 5, 10] == Just 1 143 | assert $ indexl 9 [1, 5, 10] == Nothing 144 | 145 | log "Test indexr" 146 | assert $ indexr 2 [1, 5, 10] == Just 1 147 | assert $ indexr 0 [1, 5, 10] == Just 10 148 | assert $ indexr 9 [1, 5, 10] == Nothing 149 | 150 | log "Test find" 151 | assert $ find (_ == 10) [1, 5, 10] == Just 10 152 | assert $ find (\x -> x `mod` 2 == 0) [1, 4, 10] == Just 4 153 | 154 | log "Test findWithIndex" 155 | assert $ 156 | case findWithIndex (\i x -> i `mod` 2 == 0 && x `mod` 2 == 0) [1, 2, 4, 6] of 157 | Nothing -> false 158 | Just { index, value } -> index == 2 && value == 4 159 | 160 | log "Test findMap" *> do 161 | let pred x = if x > 5 then Just (x * 100) else Nothing 162 | assert $ findMap pred [1, 5, 10, 20] == Just 1000 163 | 164 | log "Test findMapWithIndex" *> do 165 | let pred i x = if x >= 5 && i >= 3 then Just { i, x } else Nothing 166 | assert $ findMapWithIndex pred [1, 5, 10, 20] == Just { i: 3, x: 20 } 167 | 168 | log "Test maximum" 169 | assert $ maximum (arrayFrom1UpTo 10) == Just 10 170 | 171 | log "Test maximumBy" 172 | assert $ 173 | maximumBy (compare `on` abs) 174 | (map (negate <<< toNumber) (arrayFrom1UpTo 10)) 175 | == Just (-10.0) 176 | 177 | log "Test minimum" 178 | assert $ minimum (arrayFrom1UpTo 10) == Just 1 179 | 180 | log "Test minimumBy" 181 | assert $ 182 | minimumBy (compare `on` abs) 183 | (map (negate <<< toNumber) (arrayFrom1UpTo 10)) 184 | == Just (-1.0) 185 | 186 | log "Test null" 187 | assert $ null Nothing == true 188 | assert $ null (Just 1) == false 189 | assert $ null [] == true 190 | assert $ null [0] == false 191 | assert $ null [0,1] == false 192 | 193 | log "Test length" 194 | assert $ length Nothing == 0 195 | assert $ length (Just 1) == 1 196 | assert $ length [] == 0 197 | assert $ length [1] == 1 198 | assert $ length [1, 2] == 2 199 | 200 | log "Test surroundMap" 201 | assert $ "*" == surroundMap "*" show ([] :: Array Int) 202 | assert $ "*1*" == surroundMap "*" show [1] 203 | assert $ "*1*2*" == surroundMap "*" show [1, 2] 204 | assert $ "*1*2*3*" == surroundMap "*" show [1, 2, 3] 205 | 206 | log "Test surroundMapWithIndex" 207 | assert $ "*" == surroundMapWithIndex "*" (\i x -> show i <> x) [] 208 | assert $ "*0a*" == surroundMapWithIndex "*" (\i x -> show i <> x) ["a"] 209 | assert $ "*0a*1b*" == surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b"] 210 | assert $ "*0a*1b*2c*" == surroundMapWithIndex "*" (\i x -> show i <> x) ["a", "b", "c"] 211 | 212 | log "Test Foldable1 defaults" 213 | assert $ "(a(b(cd)))" == foldMap (foldr1 (\x y -> "(" <> x <> y <> ")")) (maybeMkNEArray ["a", "b", "c", "d"]) 214 | assert $ "(((ab)c)d)" == foldMap (foldl1 (\x y -> "(" <> x <> y <> ")")) (maybeMkNEArray ["a", "b", "c", "d"]) 215 | 216 | log "Test maximumBy" 217 | assert $ 218 | (Foldable1.maximumBy (compare `on` abs) <$> 219 | (maybeMkNEArray (negate <<< toNumber <$> arrayFrom1UpTo 10))) 220 | == Just (-10.0) 221 | 222 | log "Test minimumBy" 223 | assert $ 224 | (Foldable1.minimumBy (compare `on` abs) <$> 225 | (maybeMkNEArray (negate <<< toNumber <$> arrayFrom1UpTo 10))) 226 | == Just (-1.0) 227 | 228 | log "All done!" 229 | 230 | 231 | testFoldableFWith 232 | :: forall f 233 | . Foldable f 234 | => Eq (f Int) 235 | => (Int -> f Int) 236 | -> Int 237 | -> Effect Unit 238 | testFoldableFWith f n = do 239 | let dat = f n 240 | let expectedSum = (n / 2) * (n + 1) 241 | 242 | assert $ foldr (+) 0 dat == expectedSum 243 | assert $ foldl (+) 0 dat == expectedSum 244 | assert $ foldMap Additive dat == Additive expectedSum 245 | 246 | testFoldableArrayWith :: Int -> Effect Unit 247 | testFoldableArrayWith = testFoldableFWith arrayFrom1UpTo 248 | 249 | testFoldableWithIndexFWith 250 | :: forall f 251 | . FoldableWithIndex Int f 252 | => Eq (f Int) 253 | => (Int -> f Int) 254 | -> Int 255 | -> Effect Unit 256 | testFoldableWithIndexFWith f n = do 257 | let dat = f n 258 | -- expectedSum = \Sum_{1 <= i <= n} i * i 259 | let expectedSum = n * (n + 1) * (2 * n + 1) / 6 260 | 261 | assert $ foldrWithIndex (\i x y -> (i + 1) * x + y) 0 dat == expectedSum 262 | assert $ foldlWithIndex (\i y x -> y + (i + 1) * x) 0 dat == expectedSum 263 | assert $ foldMapWithIndex (\i x -> Additive $ (i + 1) * x) dat == Additive expectedSum 264 | 265 | testFoldableWithIndexArrayWith :: Int -> Effect Unit 266 | testFoldableWithIndexArrayWith = testFoldableWithIndexFWith arrayFrom1UpTo 267 | 268 | 269 | data Tuple a b = Tuple a b 270 | derive instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b) 271 | 272 | -- test whether foldable laws hold, using foldMap and ifoldMap 273 | testFoldableWithIndexLawsOn 274 | :: forall f i a m n 275 | . FoldableWithIndex i f 276 | => FunctorWithIndex i f 277 | => Monoid m 278 | => Monoid n 279 | => Eq m 280 | => Eq n 281 | => f a 282 | -> (i -> a -> m) 283 | -> (a -> n) 284 | -> Effect Unit 285 | testFoldableWithIndexLawsOn c f g = do 286 | -- compatibility with FunctorWithIndex (not strictly necessary for a valid 287 | -- instance, but it's likely an error if this does not hold) 288 | assert $ foldMapWithIndex f c == fold (mapWithIndex f c) 289 | 290 | -- Compatiblity with Foldable 291 | assert $ foldMap g c == foldMapWithIndex (const g) c 292 | 293 | -- FoldableWithIndex laws 294 | assert $ foldMapWithIndex f c == foldMapWithIndexDefaultL f c 295 | assert $ foldMapWithIndex f c == foldMapWithIndexDefaultR f c 296 | 297 | -- These follow from the above laws, but they test whether ifoldlDefault and 298 | -- ifoldrDefault have been specified correctly. 299 | assert $ foldMapWithIndex f c == foldlWithIndexDefault (\i y x -> y <> f i x) mempty c 300 | assert $ foldMapWithIndex f c == foldrWithIndexDefault (\i x y -> f i x <> y) mempty c 301 | 302 | testTraversableFWith 303 | :: forall f 304 | . Traversable f 305 | => Eq (f Int) 306 | => (Int -> f Int) 307 | -> Int 308 | -> Effect Unit 309 | testTraversableFWith f n = do 310 | let dat = f n 311 | let len = foldableLength dat 312 | 313 | _ <- traverse pure dat 314 | 315 | assert' "traverse Just == Just" $ traverse Just dat == Just dat 316 | assert' "traverse pure == pure (Array)" $ traverse pure dat == [dat] 317 | 318 | when (len <= 10) do 319 | result <- deferEff \_ -> traverse (\x -> [x,x]) dat == arrayReplicate (pow 2 len) dat 320 | assert' "traverse with Array as underlying applicative" result 321 | 322 | assert' "traverse (const Nothing) == const Nothing" $ 323 | traverse (const Nothing :: Int -> Maybe Int) dat == Nothing 324 | 325 | assert' "sequence <<< map f == traverse f" $ 326 | sequence (map Just dat) == traverse Just dat 327 | 328 | assert' "underlying applicative" $ 329 | (traverse pure dat :: Unit -> f Int) unit == dat 330 | 331 | testTraversableArrayWith :: Int -> Effect Unit 332 | testTraversableArrayWith = testTraversableFWith arrayFrom1UpTo 333 | 334 | testTraversableWithIndexFWith 335 | :: forall f 336 | . TraversableWithIndex Int f 337 | => Eq (f (Tuple Int Int)) 338 | => Eq (f Int) 339 | => (Int -> f Int) 340 | -> Int 341 | -> Effect Unit 342 | testTraversableWithIndexFWith f n = do 343 | let dat = f n 344 | 345 | assert $ traverseWithIndex (\i -> Just <<< Tuple i) dat == Just (mapWithIndex Tuple dat) 346 | assert $ traverseWithIndex (const Just) dat == traverse Just dat 347 | assert $ traverseWithIndex (\i -> pure <<< Tuple i) dat == [mapWithIndex Tuple dat] 348 | assert $ 349 | traverseWithIndex (const pure :: Int -> Int -> Array Int) dat == 350 | traverse pure dat 351 | 352 | testTraversableWithIndexArrayWith 353 | :: Int -> Effect Unit 354 | testTraversableWithIndexArrayWith = testTraversableWithIndexFWith arrayFrom1UpTo 355 | 356 | -- structures for testing default `Foldable` implementations 357 | 358 | newtype FoldMapDefaultL a = FML (Array a) 359 | newtype FoldMapDefaultR a = FMR (Array a) 360 | newtype FoldlDefault a = FLD (Array a) 361 | newtype FoldrDefault a = FRD (Array a) 362 | 363 | instance eqFML :: (Eq a) => Eq (FoldMapDefaultL a) where eq (FML l) (FML r) = l == r 364 | instance eqFMR :: (Eq a) => Eq (FoldMapDefaultR a) where eq (FMR l) (FMR r) = l == r 365 | instance eqFLD :: (Eq a) => Eq (FoldlDefault a) where eq (FLD l) (FLD r) = l == r 366 | instance eqFRD :: (Eq a) => Eq (FoldrDefault a) where eq (FRD l) (FRD r) = l == r 367 | 368 | -- implemented `foldl` and `foldr`, but default `foldMap` using `foldl` 369 | instance foldableFML :: Foldable FoldMapDefaultL where 370 | foldMap f = foldMapDefaultL f 371 | foldl f u (FML a) = foldl f u a 372 | foldr f u (FML a) = foldr f u a 373 | 374 | -- implemented `foldl` and `foldr`, but default `foldMap`, using `foldr` 375 | instance foldableFMR :: Foldable FoldMapDefaultR where 376 | foldMap f = foldMapDefaultR f 377 | foldl f u (FMR a) = foldl f u a 378 | foldr f u (FMR a) = foldr f u a 379 | 380 | -- implemented `foldMap` and `foldr`, but default `foldMap` 381 | instance foldableDFL :: Foldable FoldlDefault where 382 | foldMap f (FLD a) = foldMap f a 383 | foldl f u = foldlDefault f u 384 | foldr f u (FLD a) = foldr f u a 385 | 386 | -- implemented `foldMap` and `foldl`, but default `foldr` 387 | instance foldableDFR :: Foldable FoldrDefault where 388 | foldMap f (FRD a) = foldMap f a 389 | foldl f u (FRD a) = foldl f u a 390 | foldr f u = foldrDefault f u 391 | 392 | testFoldableFoldMapDefaultL :: Int -> Effect Unit 393 | testFoldableFoldMapDefaultL = testFoldableFWith (FML <<< arrayFrom1UpTo) 394 | 395 | testFoldableFoldMapDefaultR :: Int -> Effect Unit 396 | testFoldableFoldMapDefaultR = testFoldableFWith (FMR <<< arrayFrom1UpTo) 397 | 398 | testFoldableFoldlDefault :: Int -> Effect Unit 399 | testFoldableFoldlDefault = testFoldableFWith (FLD <<< arrayFrom1UpTo) 400 | 401 | testFoldableFoldrDefault :: Int -> Effect Unit 402 | testFoldableFoldrDefault = testFoldableFWith (FRD <<< arrayFrom1UpTo) 403 | 404 | 405 | -- structures for testing default `Traversable` implementations 406 | 407 | newtype TraverseDefault a = TD (Array a) 408 | newtype SequenceDefault a = SD (Array a) 409 | 410 | instance eqTD :: (Eq a) => Eq (TraverseDefault a) where eq (TD l) (TD r) = l == r 411 | instance eqSD :: (Eq a) => Eq (SequenceDefault a) where eq (SD l) (SD r) = l == r 412 | 413 | instance functorTD :: Functor TraverseDefault where map f (TD a) = TD (map f a) 414 | instance functorSD :: Functor SequenceDefault where map f (SD a) = SD (map f a) 415 | 416 | instance foldableTD :: Foldable TraverseDefault where 417 | foldMap f (TD a) = foldMap f a 418 | foldr f u (TD a) = foldr f u a 419 | foldl f u (TD a) = foldl f u a 420 | 421 | instance foldableSD :: Foldable SequenceDefault where 422 | foldMap f (SD a) = foldMap f a 423 | foldr f u (SD a) = foldr f u a 424 | foldl f u (SD a) = foldl f u a 425 | 426 | instance traversableTD :: Traversable TraverseDefault where 427 | traverse f = traverseDefault f 428 | sequence (TD a) = map TD (sequence a) 429 | 430 | instance traversableSD :: Traversable SequenceDefault where 431 | traverse f (SD a) = map SD (traverse f a) 432 | sequence m = sequenceDefault m 433 | 434 | testTraverseDefault :: Int -> Effect Unit 435 | testTraverseDefault = testTraversableFWith (TD <<< arrayFrom1UpTo) 436 | 437 | testSequenceDefault :: Int -> Effect Unit 438 | testSequenceDefault = testTraversableFWith (SD <<< arrayFrom1UpTo) 439 | 440 | 441 | -- structure for testing bifoldable, picked `inclusive or` as it has both products and sums 442 | 443 | data IOr l r = Both l r | Fst l | Snd r 444 | 445 | instance eqIOr :: (Eq l, Eq r) => Eq (IOr l r) where 446 | eq (Both lFst lSnd) (Both rFst rSnd) = (lFst == rFst) && (lSnd == rSnd) 447 | eq (Fst l) (Fst r) = l == r 448 | eq (Snd l) (Snd r) = l == r 449 | eq _ _ = false 450 | 451 | instance bifoldableIOr :: Bifoldable IOr where 452 | bifoldr l r u (Both fst snd) = l fst (r snd u) 453 | bifoldr l _ u (Fst fst) = l fst u 454 | bifoldr _ r u (Snd snd) = r snd u 455 | 456 | bifoldl l r u (Both fst snd) = r (l u fst) snd 457 | bifoldl l _ u (Fst fst) = l u fst 458 | bifoldl _ r u (Snd snd) = r u snd 459 | 460 | bifoldMap l r (Both fst snd) = l fst <> r snd 461 | bifoldMap l _ (Fst fst) = l fst 462 | bifoldMap _ r (Snd snd) = r snd 463 | 464 | instance bifunctorIOr :: Bifunctor IOr where 465 | bimap f g (Both fst snd) = Both (f fst) (g snd) 466 | bimap f _ (Fst fst) = Fst (f fst) 467 | bimap _ g (Snd snd) = Snd (g snd) 468 | 469 | instance bitraversableIOr :: Bitraversable IOr where 470 | bitraverse f g (Both fst snd) = Both <$> f fst <*> g snd 471 | bitraverse f _ (Fst fst) = Fst <$> f fst 472 | bitraverse _ g (Snd snd) = Snd <$> g snd 473 | 474 | bisequence (Both fst snd) = Both <$> fst <*> snd 475 | bisequence (Fst fst) = Fst <$> fst 476 | bisequence (Snd snd) = Snd <$> snd 477 | 478 | testBifoldableIOrWith 479 | :: forall t 480 | . Bifoldable t 481 | => Eq (t Int Int) 482 | => (forall l r. IOr l r -> t l r) 483 | -> Int 484 | -> Int 485 | -> Int 486 | -> Effect Unit 487 | testBifoldableIOrWith lift fst snd u = do 488 | assert $ bifoldr (+) (*) u (lift $ Both fst snd) == fst + (snd * u) 489 | assert $ bifoldr (+) (*) u (lift $ Fst fst) == fst + u 490 | assert $ bifoldr (+) (*) u (lift $ Snd snd) == snd * u 491 | 492 | assert $ bifoldl (+) (*) u (lift $ Both fst snd) == (u + fst) * snd 493 | assert $ bifoldl (+) (*) u (lift $ Fst fst) == u + fst 494 | assert $ bifoldl (+) (*) u (lift $ Snd snd) == u * snd 495 | 496 | assert $ bifoldMap Additive Additive (lift $ Both fst snd) == Additive (fst + snd) 497 | assert $ bifoldMap Additive Additive (lift $ Fst fst) == Additive fst 498 | assert $ bifoldMap Additive Additive (lift $ Snd snd) == Additive snd 499 | 500 | testBitraversableIOrWith 501 | :: forall t 502 | . Bitraversable t 503 | => Eq (t Boolean Boolean) 504 | => (forall l r. IOr l r -> t l r) 505 | -> Effect Unit 506 | testBitraversableIOrWith lift = do 507 | let just a = Just (lift a) 508 | assert $ bisequence (lift (Both (Just true) (Just false))) == just (Both true false) 509 | assert $ bisequence (lift (Fst (Just true))) == just (Fst true :: IOr Boolean Boolean) 510 | assert $ bisequence (lift (Snd (Just false))) == just (Snd false :: IOr Boolean Boolean) 511 | assert $ bitraverse Just Just (lift (Both true false)) == just (Both true false) 512 | assert $ bitraverse Just Just (lift (Fst true)) == just (Fst true :: IOr Boolean Boolean) 513 | assert $ bitraverse Just Just (lift (Snd false)) == just (Snd false :: IOr Boolean Boolean) 514 | 515 | 516 | -- structures for testing default `Bifoldable` implementations 517 | 518 | newtype BifoldMapDefaultL l r = BFML (IOr l r) 519 | newtype BifoldMapDefaultR l r = BFMR (IOr l r) 520 | newtype BifoldlDefault l r = BFLD (IOr l r) 521 | newtype BifoldrDefault l r = BFRD (IOr l r) 522 | 523 | instance eqBFML :: (Eq l, Eq r) => Eq (BifoldMapDefaultL l r) where eq (BFML l) (BFML r) = l == r 524 | instance eqBFMR :: (Eq l, Eq r) => Eq (BifoldMapDefaultR l r) where eq (BFMR l) (BFMR r) = l == r 525 | instance eqBFLD :: (Eq l, Eq r) => Eq (BifoldlDefault l r) where eq (BFLD l) (BFLD r) = l == r 526 | instance eqBFRD :: (Eq l, Eq r) => Eq (BifoldrDefault l r) where eq (BFRD l) (BFRD r) = l == r 527 | 528 | instance bifoldableBFML :: Bifoldable BifoldMapDefaultL where 529 | bifoldMap f g m = bifoldMapDefaultL f g m 530 | bifoldr f g u (BFML m) = bifoldr f g u m 531 | bifoldl f g u (BFML m) = bifoldl f g u m 532 | 533 | instance bifoldableBFMR :: Bifoldable BifoldMapDefaultR where 534 | bifoldMap f g m = bifoldMapDefaultR f g m 535 | bifoldr f g u (BFMR m) = bifoldr f g u m 536 | bifoldl f g u (BFMR m) = bifoldl f g u m 537 | 538 | instance bifoldableBFLD :: Bifoldable BifoldlDefault where 539 | bifoldMap f g (BFLD m) = bifoldMap f g m 540 | bifoldr f g u (BFLD m) = bifoldr f g u m 541 | bifoldl f g u m = bifoldlDefault f g u m 542 | 543 | instance bifoldableBFRD :: Bifoldable BifoldrDefault where 544 | bifoldMap f g (BFRD m) = bifoldMap f g m 545 | bifoldr f g u m = bifoldrDefault f g u m 546 | bifoldl f g u (BFRD m) = bifoldl f g u m 547 | 548 | 549 | -- structures for testing default `Bitraversable` implementations 550 | 551 | newtype BitraverseDefault l r = BTD (IOr l r) 552 | newtype BisequenceDefault l r = BSD (IOr l r) 553 | 554 | instance eqBTD :: (Eq l, Eq r) => Eq (BitraverseDefault l r) where eq (BTD l) (BTD r) = l == r 555 | instance eqBSD :: (Eq l, Eq r) => Eq (BisequenceDefault l r) where eq (BSD l) (BSD r) = l == r 556 | 557 | instance bifunctorBTD :: Bifunctor BitraverseDefault where bimap f g (BTD m) = BTD (bimap f g m) 558 | instance bifunctorBSD :: Bifunctor BisequenceDefault where bimap f g (BSD m) = BSD (bimap f g m) 559 | 560 | instance bifoldableBTD :: Bifoldable BitraverseDefault where 561 | bifoldMap f g (BTD m) = bifoldMap f g m 562 | bifoldr f g u (BTD m) = bifoldr f g u m 563 | bifoldl f g u (BTD m) = bifoldl f g u m 564 | 565 | instance bifoldableBSD :: Bifoldable BisequenceDefault where 566 | bifoldMap f g (BSD m) = bifoldMap f g m 567 | bifoldr f g u (BSD m) = bifoldr f g u m 568 | bifoldl f g u (BSD m) = bifoldl f g u m 569 | 570 | instance bitraversableBTD :: Bitraversable BitraverseDefault where 571 | bitraverse f g = bitraverseDefault f g 572 | bisequence (BTD m) = map BTD (bisequence m) 573 | 574 | instance bitraversableBSD :: Bitraversable BisequenceDefault where 575 | bitraverse f g (BSD m) = map BSD (bitraverse f g m) 576 | bisequence m = bisequenceDefault m 577 | 578 | 579 | benchmarkDefaultFolds :: Effect Unit 580 | benchmarkDefaultFolds = do 581 | let 582 | sm = arrayFrom1UpTo 1_000 583 | m = arrayFrom1UpTo 10_000 584 | lg = arrayFrom1UpTo 100_000 585 | xl = arrayFrom1UpTo 1_000_000 586 | 587 | log "\nbenching 1,000" 588 | benchWith 1000 $ \_ -> foldrDefault (+) 0 sm 589 | log "\nbenching 10,000" 590 | benchWith 1000 $ \_ -> foldrDefault (+) 0 m 591 | log "\nbenching 100,000" 592 | benchWith 100 $ \_ -> foldrDefault (+) 0 lg 593 | log "\nbenching 1,000,000" 594 | benchWith 50 $ \_ -> foldrDefault (+) 0 xl 595 | 596 | --------------------------------------------------------------------------------