diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..4435abb --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,12 @@ +**Description of the change** + +Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. + +--- + +**Checklist:** + +- [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") +- [ ] Linked any existing issues or proposals that this pull request should close +- [ ] Updated or added relevant documentation +- [ ] Added a test for the contribution (if applicable) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..c69237a --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,35 @@ +name: CI + +on: + push: + branches: [master] + pull_request: + branches: [master] + +jobs: + build: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + + - uses: purescript-contrib/setup-purescript@main + with: + purescript: "unstable" + + - uses: actions/setup-node@v2 + with: + node-version: "14.x" + + - name: Install dependencies + run: | + npm install -g bower + npm install + bower install --production + + - name: Build source + run: npm run-script build + + - name: Run tests + run: | + bower install + npm run-script test --if-present diff --git a/.gitignore b/.gitignore index b215c44..7ebd961 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ /.* !/.gitignore -!/.travis.yml +!/.github/ /bower_components/ /node_modules/ /output/ diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 27b95cd..0000000 --- a/.travis.yml +++ /dev/null @@ -1,21 +0,0 @@ -language: node_js -dist: trusty -sudo: required -node_js: stable -env: - - PATH=$HOME/purescript:$PATH -install: - - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p') - - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz - - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - - chmod a+x $HOME/purescript - - npm install -g bower - - npm install - - bower install -script: - - npm run -s build -after_success: -- >- - test $TRAVIS_TAG && - echo $GITHUB_TOKEN | pulp login && - echo y | pulp publish --no-push diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..73022e2 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,155 @@ +# Changelog + +Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +Breaking changes: + +New features: + +Bugfixes: + +Other improvements: + +## [v6.1.0](https://github.com/purescript/purescript-either/releases/tag/v6.1.0) - 2022-05-16 + +New features: +- Add `blush` which is a left-biased `hush`, thus turns `Right`s into `Nothing`s but `Left`s into `Just`s (#69 by @i-am-the-slime). + +## [v6.0.0](https://github.com/purescript/purescript-either/releases/tag/v6.0.0) - 2022-04-27 + +Breaking changes: +- Update project and deps to PureScript v0.15.0 (#66 by @JordanMartinez) + +New features: + +Bugfixes: + +Other improvements: + +## [v5.0.0](https://github.com/purescript/purescript-either/releases/tag/v5.0.0) - 2021-02-26 + +Breaking changes: +- Added support for PureScript 0.14 and dropped support for all previous versions (#55) +- Added default parameter to `fromLeft` and `fromRight` and removed `Partial` constraint (#48) + +New features: +- Added `\/` alias for `either` (#51) +- Added lazy versions of `fromRight` and `fromLeft` (#59) +- This package no longer depends on the `purescript-bifunctors` and `purescript-foldable-traversable` packages. Relevant instances have been moved to those packages. (#64) + +Bugfixes: + +Other improvements: +- Migrated CI to GitHub Actions and updated installation instructions to use Spago (#58) +- Added a CHANGELOG.md file and pull request template (#62, #63) +- Corrected docs for `Apply` instance (#49) +- Improved documentation of `Either`s "do notation" (#52) + +## [v4.1.1](https://github.com/purescript/purescript-either/releases/tag/v4.1.1) - 2018-11-30 + +Reordered instance chain for `Inject` so that `inj :: a -> a` succeeds (@hdgarrood) + +## [v4.1.0](https://github.com/purescript/purescript-either/releases/tag/v4.1.0) - 2018-10-28 + +Added `FunctorWithIndex`, `FoldableWithIndex`, `TraversableWithIndex` instances (@MonoidMusician) + +## [v4.0.0](https://github.com/purescript/purescript-either/releases/tag/v4.0.0) - 2018-05-23 + +- Updated for PureScript 0.12 +- Added `\/` type synonym to `Data.Either.Nested` +- Added `Inject` class for injecting values into/projecting values out of nested `Eithers` + +## [v3.2.0](https://github.com/purescript/purescript-either/releases/tag/v3.2.0) - 2018-04-15 + +- Added `note'` (lazy `note`) (@matthewleon) + +## [v3.1.0](https://github.com/purescript/purescript-either/releases/tag/v3.1.0) - 2017-06-23 + +- Added `note` and `hush` functions (@kRITZCREEK) + +## [v3.0.0](https://github.com/purescript/purescript-either/releases/tag/v3.0.0) - 2017-03-26 + +- Updated for PureScript 0.11 + +## [v2.2.1](https://github.com/purescript/purescript-either/releases/tag/v2.2.1) - 2017-03-05 + +- Fix lower bound of prelude dependency (@passy) + +## [v2.2.0](https://github.com/purescript/purescript-either/releases/tag/v2.2.0) - 2017-03-02 + +- Added `Eq1` and `Ord1` instances + +## [v2.1.0](https://github.com/purescript/purescript-either/releases/tag/v2.1.0) - 2016-12-24 + +Add `choose` function (@tmcgilchrist) + +## [v2.0.0](https://github.com/purescript/purescript-either/releases/tag/v2.0.0) - 2016-10-03 + +- Updated dependencies +- The `Nested` module has been reworked for "open" nesting #20 (@natefaubion) + +## [v1.0.0](https://github.com/purescript/purescript-either/releases/tag/v1.0.0) - 2016-06-01 + +This release is intended for the PureScript 0.9.1 compiler and newer. + +**Note**: The v1.0.0 tag is not meant to indicate the library is “finished”, the core libraries are all being bumped to this for the 0.9 compiler release so as to use semver more correctly. + +## [v1.0.0-rc.1](https://github.com/purescript/purescript-either/releases/tag/v1.0.0-rc.1) - 2016-03-13 + +- Release candidate for the psc 0.8+ core libraries + +## [v0.2.3](https://github.com/purescript/purescript-either/releases/tag/v0.2.3) - 2015-09-26 + +Fixed error message (@zudov) + +## [v0.2.2](https://github.com/purescript/purescript-either/releases/tag/v0.2.2) - 2015-08-14 + +- Added `Semiring` and `Semigroup` instances (@anttih) + +## [v0.2.1](https://github.com/purescript/purescript-either/releases/tag/v0.2.1) - 2015-08-13 + +- Fixed warnings about partial functions + +## [v0.2.0](https://github.com/purescript/purescript-either/releases/tag/v0.2.0) - 2015-06-30 + +This release works with versions 0.7.\* of the PureScript compiler. It will not work with older versions. If you are using an older version, you should require an older, compatible version of this library. + +## [v0.2.0-rc.1](https://github.com/purescript/purescript-either/releases/tag/v0.2.0-rc.1) - 2015-06-06 + +Initial release candidate of the library intended for the 0.7 compiler. + +## [v0.1.8](https://github.com/purescript/purescript-either/releases/tag/v0.1.8) - 2015-03-25 + +More helper functions for nested sums (@jdegoes) + +## [v0.1.7](https://github.com/purescript/purescript-either/releases/tag/v0.1.7) - 2015-03-24 + +Reworked nested sums (@jdegoes) + +## [v0.1.6](https://github.com/purescript/purescript-either/releases/tag/v0.1.6) - 2015-03-18 + +Add `fromLeft` and `fromRight` (@pseudonom) + +## [v0.1.5](https://github.com/purescript/purescript-either/releases/tag/v0.1.5) - 2015-03-17 + +Update docs + +## [v0.1.4](https://github.com/purescript/purescript-either/releases/tag/v0.1.4) - 2014-11-05 + + + +## [v0.1.3](https://github.com/purescript/purescript-either/releases/tag/v0.1.3) - 2014-08-26 + +Add `Alt` instance + +## [v0.1.2](https://github.com/purescript/purescript-either/releases/tag/v0.1.2) - 2014-05-22 + +- Fixed `show` output (paf31) + +## [v0.1.1](https://github.com/purescript/purescript-either/releases/tag/v0.1.1) - 2014-04-25 + + + +## [v0.1.0](https://github.com/purescript/purescript-either/releases/tag/v0.1.0) - 2014-04-21 diff --git a/LICENSE b/LICENSE index 58b0299..311379c 100644 --- a/LICENSE +++ b/LICENSE @@ -1,20 +1,26 @@ -The MIT License (MIT) +Copyright 2018 PureScript -Copyright (c) 2014 PureScript +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of -the Software, and to permit persons to whom the Software is furnished to do so, -subject to the following conditions: +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation and/or +other materials provided with the distribution. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS -FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR -COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +3. Neither the name of the copyright holder nor the names of its contributors +may be used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md index 7f62d2b..b361259 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,8 @@ # purescript-either [![Latest release](http://img.shields.io/github/release/purescript/purescript-either.svg)](https://github.com/purescript/purescript-either/releases) -[![Build status](https://travis-ci.org/purescript/purescript-either.svg?branch=master)](https://travis-ci.org/purescript/purescript-either) +[![Build status](https://github.com/purescript/purescript-either/workflows/CI/badge.svg?branch=master)](https://github.com/purescript/purescript-either/actions?query=workflow%3ACI+branch%3Amaster) +[![Pursuit](https://pursuit.purescript.org/packages/purescript-either/badge)](https://pursuit.purescript.org/packages/purescript-either) The `Either` type provides is used to represent values that can be one of two possibilities. For example, `Either Int Number` can be used in a place where either integers or floating point numbers are acceptable. @@ -10,7 +11,7 @@ A common use for this type is error handling, where by convention the `Left` con ## Installation ``` -bower install purescript-either +spago install either ``` ## Documentation diff --git a/bower.json b/bower.json index 52a1285..6e9638d 100644 --- a/bower.json +++ b/bower.json @@ -1,11 +1,10 @@ { "name": "purescript-either", "homepage": "https://github.com/purescript/purescript-either", - "description": "Values with two possibilities", - "license": "MIT", + "license": "BSD-3-Clause", "repository": { "type": "git", - "url": "git://github.com/purescript/purescript-either.git" + "url": "https://github.com/purescript/purescript-either.git" }, "ignore": [ "**/.*", @@ -17,7 +16,14 @@ "package.json" ], "dependencies": { - "purescript-foldable-traversable": "^3.0.0", - "purescript-prelude": "^3.0.0" + "purescript-control": "^6.0.0", + "purescript-invariant": "^6.0.0", + "purescript-maybe": "^6.0.0", + "purescript-prelude": "^6.0.0" + }, + "devDependencies": { + "purescript-assert": "^6.0.0", + "purescript-console": "^6.0.0", + "purescript-effect": "^4.0.0" } } diff --git a/package.json b/package.json index f9e9db6..c8e10e0 100644 --- a/package.json +++ b/package.json @@ -2,11 +2,12 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "pulp build -- --censor-lib --strict" + "build": "pulp build -- --censor-lib --strict", + "test": "pulp test" }, "devDependencies": { - "pulp": "^10.0.4", - "purescript-psa": "^0.5.0-rc.1", - "rimraf": "^2.6.1" + "pulp": "16.0.0-0", + "purescript-psa": "^0.8.2", + "rimraf": "^3.0.2" } } diff --git a/src/Data/Either.purs b/src/Data/Either.purs index 8ac3396..3940d93 100644 --- a/src/Data/Either.purs +++ b/src/Data/Either.purs @@ -4,16 +4,11 @@ import Prelude import Control.Alt (class Alt, (<|>)) import Control.Extend (class Extend) -import Data.Bifoldable (class Bifoldable) -import Data.Bifunctor (class Bifunctor) -import Data.Bitraversable (class Bitraversable) import Data.Eq (class Eq1) -import Data.Foldable (class Foldable) import Data.Functor.Invariant (class Invariant, imapF) +import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..), maybe, maybe') -import Data.Monoid (mempty) import Data.Ord (class Ord1) -import Data.Traversable (class Traversable) -- | The `Either` type is used to represent a choice between two types of value. -- | @@ -33,17 +28,13 @@ data Either a b = Left a | Right b -- | ``` purescript -- | f <$> Left y == Left y -- | ``` -instance functorEither :: Functor (Either a) where - map _ (Left x) = Left x - map f (Right y) = Right (f y) +derive instance functorEither :: Functor (Either a) + +derive instance genericEither :: Generic (Either a b) _ instance invariantEither :: Invariant (Either a) where imap = imapF -instance bifunctorEither :: Bifunctor Either where - bimap f _ (Left l) = Left (f l) - bimap _ g (Right r) = Right (g r) - -- | The `Apply` instance allows functions contained within a `Right` to -- | transform a value contained within a `Right` using the `(<*>)` operator: -- | @@ -54,7 +45,7 @@ instance bifunctorEither :: Bifunctor Either where -- | `Left` values are left untouched: -- | -- | ``` purescript --- | Left f <*> Right x == Left x +-- | Left f <*> Right x == Left f -- | Right f <*> Left y == Left y -- | ``` -- | @@ -122,24 +113,46 @@ instance altEither :: Alt (Either e) where -- | Left x >>= f = Left x -- | Right x >>= f = f x -- | ``` -instance bindEither :: Bind (Either e) where - bind = either (\e _ -> Left e) (\a f -> f a) - --- | The `Monad` instance guarantees that there are both `Applicative` and --- | `Bind` instances for `Either`. This also enables the `do` syntactic sugar: -- | +-- | `Either`'s "do notation" can be understood to work like this: -- | ``` purescript --- | do +-- | x :: forall e a. Either e a +-- | x = -- +-- | +-- | y :: forall e b. Either e b +-- | y = -- +-- | +-- | foo :: forall e a. (a -> b -> c) -> Either e c +-- | foo f = do -- | x' <- x -- | y' <- y -- | pure (f x' y') -- | ``` -- | --- | Which is equivalent to: +-- | ...which is equivalent to... -- | -- | ``` purescript -- | x >>= (\x' -> y >>= (\y' -> pure (f x' y'))) -- | ``` +-- | +-- | ...and is the same as writing... +-- | +-- | ``` +-- | foo :: forall e a. (a -> b -> c) -> Either e c +-- | foo f = case x of +-- | Left e -> +-- | Left e +-- | Right x -> case y of +-- | Left e -> +-- | Left e +-- | Right y -> +-- | Right (f x y) +-- | ``` +instance bindEither :: Bind (Either e) where + bind = either (\e _ -> Left e) (\a f -> f a) + +-- | The `Monad` instance guarantees that there are both `Applicative` and +-- | `Bind` instances for `Either`. instance monadEither :: Monad (Either e) -- | The `Extend` instance allows sequencing of `Either` values and functions @@ -166,7 +179,7 @@ instance showEither :: (Show a, Show b) => Show (Either a b) where -- | types the `Either` can contain. derive instance eqEither :: (Eq a, Eq b) => Eq (Either a b) -instance eq1Either :: Eq a => Eq1 (Either a) where eq1 = eq +derive instance eq1Either :: Eq a => Eq1 (Either a) -- | The `Ord` instance allows `Either` values to be compared with -- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for @@ -175,46 +188,12 @@ instance eq1Either :: Eq a => Eq1 (Either a) where eq1 = eq -- | Any `Left` value is considered to be less than a `Right` value. derive instance ordEither :: (Ord a, Ord b) => Ord (Either a b) -instance ord1Either :: Ord a => Ord1 (Either a) where compare1 = compare +derive instance ord1Either :: Ord a => Ord1 (Either a) instance boundedEither :: (Bounded a, Bounded b) => Bounded (Either a b) where top = Right top bottom = Left bottom -instance foldableEither :: Foldable (Either a) where - foldr _ z (Left _) = z - foldr f z (Right x) = f x z - foldl _ z (Left _) = z - foldl f z (Right x) = f z x - foldMap f (Left _) = mempty - foldMap f (Right x) = f x - -instance bifoldableEither :: Bifoldable Either where - bifoldr f _ z (Left a) = f a z - bifoldr _ g z (Right b) = g b z - bifoldl f _ z (Left a) = f z a - bifoldl _ g z (Right b) = g z b - bifoldMap f _ (Left a) = f a - bifoldMap _ g (Right b) = g b - -instance traversableEither :: Traversable (Either a) where - traverse _ (Left x) = pure (Left x) - traverse f (Right x) = Right <$> f x - sequence (Left x) = pure (Left x) - sequence (Right x) = Right <$> x - -instance bitraversableEither :: Bitraversable Either where - bitraverse f _ (Left a) = Left <$> f a - bitraverse _ g (Right b) = Right <$> g b - bisequence (Left a) = Left <$> a - bisequence (Right b) = Right <$> b - -instance semiringEither :: (Semiring b) => Semiring (Either a b) where - one = Right one - mul x y = mul <$> x <*> y - zero = Right zero - add x y = add <$> x <*> y - instance semigroupEither :: (Semigroup b) => Semigroup (Either a b) where append x y = append <$> x <*> y @@ -242,15 +221,37 @@ isLeft = either (const true) (const false) isRight :: forall a b. Either a b -> Boolean isRight = either (const false) (const true) --- | A partial function that extracts the value from the `Left` data constructor. --- | Passing a `Right` to `fromLeft` will throw an error at runtime. -fromLeft :: forall a b. Partial => Either a b -> a -fromLeft (Left a) = a - --- | A partial function that extracts the value from the `Right` data constructor. --- | Passing a `Left` to `fromRight` will throw an error at runtime. -fromRight :: forall a b. Partial => Either a b -> b -fromRight (Right a) = a +-- | A function that extracts the value from the `Left` data constructor. +-- | The first argument is a default value, which will be returned in the +-- | case where a `Right` is passed to `fromLeft`. +fromLeft :: forall a b. a -> Either a b -> a +fromLeft _ (Left a) = a +fromLeft default _ = default + +-- | Similar to `fromLeft` but for use in cases where the default value may be +-- | expensive to compute. As PureScript is not lazy, the standard `fromLeft` +-- | has to evaluate the default value before returning the result, +-- | whereas here the value is only computed when the `Either` is known +-- | to be `Right`. +fromLeft' :: forall a b. (Unit -> a) -> Either a b -> a +fromLeft' _ (Left a) = a +fromLeft' default _ = default unit + +-- | A function that extracts the value from the `Right` data constructor. +-- | The first argument is a default value, which will be returned in the +-- | case where a `Left` is passed to `fromRight`. +fromRight :: forall a b. b -> Either a b -> b +fromRight _ (Right b) = b +fromRight default _ = default + +-- | Similar to `fromRight` but for use in cases where the default value may be +-- | expensive to compute. As PureScript is not lazy, the standard `fromRight` +-- | has to evaluate the default value before returning the result, +-- | whereas here the value is only computed when the `Either` is known +-- | to be `Left`. +fromRight' :: forall a b. (Unit -> b) -> Either a b -> b +fromRight' _ (Right b) = b +fromRight' default _ = default unit -- | Takes a default and a `Maybe` value, if the value is a `Just`, turn it into -- | a `Right`, if the value is a `Nothing` use the provided default as a `Left` @@ -272,7 +273,7 @@ note a = maybe (Left a) Right note' :: forall a b. (Unit -> a) -> Maybe b -> Either a b note' f = maybe' (Left <<< f) Right --- | Turns an `Either` into a `Maybe`, by throwing eventual `Left` values away and converting +-- | Turns an `Either` into a `Maybe`, by throwing potential `Left` values away and converting -- | them into `Nothing`. `Right` values get turned into `Just`s. -- | -- | ```purescript @@ -281,3 +282,13 @@ note' f = maybe' (Left <<< f) Right -- | ``` hush :: forall a b. Either a b -> Maybe b hush = either (const Nothing) Just + +-- | Turns an `Either` into a `Maybe`, by throwing potential `Right` values away and converting +-- | them into `Nothing`. `Left` values get turned into `Just`s. +-- | +-- | ```purescript +-- | blush (Left "ParseError") = Just "Parse Error" +-- | blush (Right 42) = Nothing +-- | ``` +blush :: forall a b. Either a b -> Maybe a +blush = either Just (const Nothing) diff --git a/src/Data/Either/Inject.purs b/src/Data/Either/Inject.purs new file mode 100644 index 0000000..502d464 --- /dev/null +++ b/src/Data/Either/Inject.purs @@ -0,0 +1,23 @@ +module Data.Either.Inject where + +import Prelude + +import Data.Either (Either(..), either) +import Data.Maybe (Maybe(..)) + +class Inject a b where + inj :: a -> b + prj :: b -> Maybe a + +instance injectReflexive :: Inject a a where + inj = identity + prj = Just + +else instance injectLeft :: Inject a (Either a b) where + inj = Left + prj = either Just (const Nothing) + +else instance injectRight :: Inject a b => Inject a (Either c b) where + inj = Right <<< inj + prj = either (const Nothing) prj + diff --git a/src/Data/Either/Nested.purs b/src/Data/Either/Nested.purs index a736476..f4ee931 100644 --- a/src/Data/Either/Nested.purs +++ b/src/Data/Either/Nested.purs @@ -17,114 +17,122 @@ -- | toEither3 (Blue v) = in3 v -- | ``` module Data.Either.Nested - ( in1, in2, in3, in4, in5, in6, in7, in8, in9, in10 + ( type (\/), (\/) + , in1, in2, in3, in4, in5, in6, in7, in8, in9, in10 , at1, at2, at3, at4, at5, at6, at7, at8, at9, at10 , Either1, Either2, Either3, Either4, Either5, Either6, Either7, Either8, Either9, Either10 , either1, either2, either3, either4, either5, either6, either7, either8, either9, either10 - , E2, E3, E4, E5, E6, E7, E8, E9, E10, E11 ) where -import Data.Either (Either(..)) +import Data.Either (Either(..), either) import Data.Void (Void, absurd) -type Either1 a = E2 a Void -type Either2 a b = E3 a b Void -type Either3 a b c = E4 a b c Void -type Either4 a b c d = E5 a b c d Void -type Either5 a b c d e = E6 a b c d e Void -type Either6 a b c d e f = E7 a b c d e f Void -type Either7 a b c d e f g = E8 a b c d e f g Void -type Either8 a b c d e f g h = E9 a b c d e f g h Void -type Either9 a b c d e f g h i = E10 a b c d e f g h i Void -type Either10 a b c d e f g h i j = E11 a b c d e f g h i j Void - -type E2 a z = Either a z -type E3 a b z = Either a (E2 b z) -type E4 a b c z = Either a (E3 b c z) -type E5 a b c d z = Either a (E4 b c d z) -type E6 a b c d e z = Either a (E5 b c d e z) -type E7 a b c d e f z = Either a (E6 b c d e f z) -type E8 a b c d e f g z = Either a (E7 b c d e f g z) -type E9 a b c d e f g h z = Either a (E8 b c d e f g h z) -type E10 a b c d e f g h i z = Either a (E9 b c d e f g h i z) -type E11 a b c d e f g h i j z = Either a (E10 b c d e f g h i j z) - -in1 :: forall a z. a -> E2 a z +infixr 6 type Either as \/ + +-- | The `\/` operator alias for the `either` function allows easy matching on nested Eithers. For example, consider the function +-- | +-- | ```purescript +-- | f :: (Int \/ String \/ Boolean) -> String +-- | f (Left x) = show x +-- | f (Right (Left y)) = y +-- | f (Right (Right z)) = if z then "Yes" else "No" +-- | ``` +-- | +-- | The `\/` operator alias allows us to rewrite this function as +-- | +-- | ```purescript +-- | f :: (Int \/ String \/ Boolean) -> String +-- | f = show \/ identity \/ if _ then "Yes" else "No" +-- | ``` +infixr 6 either as \/ + +type Either1 a = a \/ Void +type Either2 a b = a \/ b \/ Void +type Either3 a b c = a \/ b \/ c \/ Void +type Either4 a b c d = a \/ b \/ c \/ d \/ Void +type Either5 a b c d e = a \/ b \/ c \/ d \/ e \/ Void +type Either6 a b c d e f = a \/ b \/ c \/ d \/ e \/ f \/ Void +type Either7 a b c d e f g = a \/ b \/ c \/ d \/ e \/ f \/ g \/ Void +type Either8 a b c d e f g h = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ Void +type Either9 a b c d e f g h i = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ Void +type Either10 a b c d e f g h i j = a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ Void + +in1 :: forall a z. a -> a \/ z in1 = Left -in2 :: forall a b z. b -> E3 a b z +in2 :: forall a b z. b -> a \/ b \/ z in2 v = Right (Left v) -in3 :: forall a b c z. c -> E4 a b c z +in3 :: forall a b c z. c -> a \/ b \/ c \/ z in3 v = Right (Right (Left v)) -in4 :: forall a b c d z. d -> E5 a b c d z +in4 :: forall a b c d z. d -> a \/ b \/ c \/ d \/ z in4 v = Right (Right (Right (Left v))) -in5 :: forall a b c d e z. e -> E6 a b c d e z +in5 :: forall a b c d e z. e -> a \/ b \/ c \/ d \/ e \/ z in5 v = Right (Right (Right (Right (Left v)))) -in6 :: forall a b c d e f z. f -> E7 a b c d e f z +in6 :: forall a b c d e f z. f -> a \/ b \/ c \/ d \/ e \/ f \/ z in6 v = Right (Right (Right (Right (Right (Left v))))) -in7 :: forall a b c d e f g z. g -> E8 a b c d e f g z +in7 :: forall a b c d e f g z. g -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ z in7 v = Right (Right (Right (Right (Right (Right (Left v)))))) -in8 :: forall a b c d e f g h z. h -> E9 a b c d e f g h z +in8 :: forall a b c d e f g h z. h -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ z in8 v = Right (Right (Right (Right (Right (Right (Right (Left v))))))) -in9 :: forall a b c d e f g h i z. i -> E10 a b c d e f g h i z +in9 :: forall a b c d e f g h i z. i -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ z in9 v = Right (Right (Right (Right (Right (Right (Right (Right (Left v)))))))) -in10 :: forall a b c d e f g h i j z. j -> E11 a b c d e f g h i j z +in10 :: forall a b c d e f g h i j z. j -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ z in10 v = Right (Right (Right (Right (Right (Right (Right (Right (Right (Left v))))))))) -at1 :: forall r a z. r -> (a -> r) -> E2 a z -> r +at1 :: forall r a z. r -> (a -> r) -> a \/ z -> r at1 b f y = case y of Left r -> f r _ -> b -at2 :: forall r a b z. r -> (b -> r) -> E3 a b z -> r +at2 :: forall r a b z. r -> (b -> r) -> a \/ b \/ z -> r at2 b f y = case y of Right (Left r) -> f r _ -> b -at3 :: forall r a b c z. r -> (c -> r) -> E4 a b c z -> r +at3 :: forall r a b c z. r -> (c -> r) -> a \/ b \/ c \/ z -> r at3 b f y = case y of Right (Right (Left r)) -> f r _ -> b -at4 :: forall r a b c d z. r -> (d -> r) -> E5 a b c d z -> r +at4 :: forall r a b c d z. r -> (d -> r) -> a \/ b \/ c \/ d \/ z -> r at4 b f y = case y of Right (Right (Right (Left r))) -> f r _ -> b -at5 :: forall r a b c d e z. r -> (e -> r) -> E6 a b c d e z -> r +at5 :: forall r a b c d e z. r -> (e -> r) -> a \/ b \/ c \/ d \/ e \/ z -> r at5 b f y = case y of Right (Right (Right (Right (Left r)))) -> f r _ -> b -at6 :: forall r a b c d e f z. r -> (f -> r) -> E7 a b c d e f z -> r +at6 :: forall r a b c d e f z. r -> (f -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ z -> r at6 b f y = case y of Right (Right (Right (Right (Right (Left r))))) -> f r _ -> b -at7 :: forall r a b c d e f g z. r -> (g -> r) -> E8 a b c d e f g z -> r +at7 :: forall r a b c d e f g z. r -> (g -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ z -> r at7 b f y = case y of Right (Right (Right (Right (Right (Right (Left r)))))) -> f r _ -> b -at8 :: forall r a b c d e f g h z. r -> (h -> r) -> E9 a b c d e f g h z -> r +at8 :: forall r a b c d e f g h z. r -> (h -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ z -> r at8 b f y = case y of Right (Right (Right (Right (Right (Right (Right (Left r))))))) -> f r _ -> b -at9 :: forall r a b c d e f g h i z. r -> (i -> r) -> E10 a b c d e f g h i z -> r +at9 :: forall r a b c d e f g h i z. r -> (i -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ z -> r at9 b f y = case y of Right (Right (Right (Right (Right (Right (Right (Right (Left r)))))))) -> f r _ -> b -at10 :: forall r a b c d e f g h i j z. r -> (j -> r) -> E11 a b c d e f g h i j z -> r +at10 :: forall r a b c d e f g h i j z. r -> (j -> r) -> a \/ b \/ c \/ d \/ e \/ f \/ g \/ h \/ i \/ j \/ z -> r at10 b f y = case y of Right (Right (Right (Right (Right (Right (Right (Right (Right (Left r))))))))) -> f r _ -> b diff --git a/test/Main.purs b/test/Main.purs new file mode 100644 index 0000000..c878a67 --- /dev/null +++ b/test/Main.purs @@ -0,0 +1,66 @@ +module Test.Main where + +import Prelude + +import Data.Either.Inject (inj, prj) +import Data.Either.Nested (Either3, in1, in2, in3) +import Data.Maybe (Maybe(..)) +import Effect (Effect) +import Effect.Console (log) +import Test.Assert (assertEqual) + +type MySum = Either3 Boolean String Int + +main :: Effect Unit +main = do + log "Test injection" + assertEqual + { actual: inj true :: MySum + , expected: in1 true + } + assertEqual + { actual: inj "hello" :: MySum + , expected: in2 "hello" + } + assertEqual + { actual: inj 100 :: MySum + , expected: in3 100 + } + log "Test injection with the injectReflexive instance" + assertEqual + let + x = inj 100 :: MySum + in + { actual: inj x :: MySum + , expected: x + } + log "Test that injection picks the left-most option" + assertEqual + { actual: inj 100 :: Either3 Int Int Int + , expected: in1 100 + } + log "Test projection" + assertEqual + { actual: prj (in1 true :: MySum) + , expected: Just true + } + assertEqual + { actual: prj (in2 "hello" :: MySum) + , expected: Just "hello" + } + assertEqual + { actual: prj (in3 100 :: MySum) + , expected: Just 100 + } + assertEqual + { actual: prj (in1 true :: MySum) + , expected: Nothing :: Maybe String + } + assertEqual + { actual: prj (in2 "hello" :: MySum) + , expected: Nothing :: Maybe Int + } + assertEqual + { actual: prj (in3 100 :: MySum) + , expected: Nothing :: Maybe Boolean + }