yogsototh/either
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

intial either lib

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2022-08-09 16:24:03 +02:00
commit 9abfd74d6c
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
8 changed files with 1214 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
.gitignore vendored Normal file
View file

@ -0,0 +1,13 @@
/target
/classes
/checkouts
profiles.clj
pom.xml
pom.xml.asc
*.jar
*.class
/.lein-*
/.nrepl-port
/.prepl-port
.hgignore
.hg/

24
CHANGELOG.md Normal file
View file

@ -0,0 +1,24 @@
# Change Log
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [Unreleased]
### Changed
- Add a new arity to `make-widget-async` to provide a different widget shape.
## [0.1.1] - 2022-08-09
### Changed
- Documentation on how to make the widgets.
### Removed
- `make-widget-sync` - we're all async, all the time.
### Fixed
- Fixed widget maker to keep working when daylight savings switches over.
## 0.1.0 - 2022-08-09
### Added
- Files from the new template.
- Widget maker public API - `make-widget-sync`.
[Unreleased]: https://sourcehost.site/your-name/either/compare/0.1.1...HEAD
[0.1.1]: https://sourcehost.site/your-name/either/compare/0.1.0...0.1.1

280
LICENSE Normal file
View file

@ -0,0 +1,280 @@
Eclipse Public License - v 2.0
THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION
OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
1. DEFINITIONS
"Contribution" means:
a) in the case of the initial Contributor, the initial content
Distributed under this Agreement, and
b) in the case of each subsequent Contributor:
i) changes to the Program, and
ii) additions to the Program;
where such changes and/or additions to the Program originate from
and are Distributed by that particular Contributor. A Contribution
"originates" from a Contributor if it was added to the Program by
such Contributor itself or anyone acting on such Contributor's behalf.
Contributions do not include changes or additions to the Program that
are not Modified Works.
"Contributor" means any person or entity that Distributes the Program.
"Licensed Patents" mean patent claims licensable by a Contributor which
are necessarily infringed by the use or sale of its Contribution alone
or when combined with the Program.
"Program" means the Contributions Distributed in accordance with this
Agreement.
"Recipient" means anyone who receives the Program under this Agreement
or any Secondary License (as applicable), including Contributors.
"Derivative Works" shall mean any work, whether in Source Code or other
form, that is based on (or derived from) the Program and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship.
"Modified Works" shall mean any work in Source Code or other form that
results from an addition to, deletion from, or modification of the
contents of the Program, including, for purposes of clarity any new file
in Source Code form that contains any contents of the Program. Modified
Works shall not include works that contain only declarations,
interfaces, types, classes, structures, or files of the Program solely
in each case in order to link to, bind by name, or subclass the Program
or Modified Works thereof.
"Distribute" means the acts of a) distributing or b) making available
in any manner that enables the transfer of a copy.
"Source Code" means the form of a Program preferred for making
modifications, including but not limited to software source code,
documentation source, and configuration files.
"Secondary License" means either the GNU General Public License,
Version 2.0, or any later versions of that license, including any
exceptions or additional permissions as identified by the initial
Contributor.
2. GRANT OF RIGHTS
a) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free copyright
license to reproduce, prepare Derivative Works of, publicly display,
publicly perform, Distribute and sublicense the Contribution of such
Contributor, if any, and such Derivative Works.
b) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free patent
license under Licensed Patents to make, use, sell, offer to sell,
import and otherwise transfer the Contribution of such Contributor,
if any, in Source Code or other form. This patent license shall
apply to the combination of the Contribution and the Program if, at
the time the Contribution is added by the Contributor, such addition
of the Contribution causes such combination to be covered by the
Licensed Patents. The patent license shall not apply to any other
combinations which include the Contribution. No hardware per se is
licensed hereunder.
c) Recipient understands that although each Contributor grants the
licenses to its Contributions set forth herein, no assurances are
provided by any Contributor that the Program does not infringe the
patent or other intellectual property rights of any other entity.
Each Contributor disclaims any liability to Recipient for claims
brought by any other entity based on infringement of intellectual
property rights or otherwise. As a condition to exercising the
rights and licenses granted hereunder, each Recipient hereby
assumes sole responsibility to secure any other intellectual
property rights needed, if any. For example, if a third party
patent license is required to allow Recipient to Distribute the
Program, it is Recipient's responsibility to acquire that license
before distributing the Program.
d) Each Contributor represents that to its knowledge it has
sufficient copyright rights in its Contribution, if any, to grant
the copyright license set forth in this Agreement.
e) Notwithstanding the terms of any Secondary License, no
Contributor makes additional grants to any Recipient (other than
those set forth in this Agreement) as a result of such Recipient's
receipt of the Program under the terms of a Secondary License
(if permitted under the terms of Section 3).
3. REQUIREMENTS
3.1 If a Contributor Distributes the Program in any form, then:
a) the Program must also be made available as Source Code, in
accordance with section 3.2, and the Contributor must accompany
the Program with a statement that the Source Code for the Program
is available under this Agreement, and informs Recipients how to
obtain it in a reasonable manner on or through a medium customarily
used for software exchange; and
b) the Contributor may Distribute the Program under a license
different than this Agreement, provided that such license:
i) effectively disclaims on behalf of all other Contributors all
warranties and conditions, express and implied, including
warranties or conditions of title and non-infringement, and
implied warranties or conditions of merchantability and fitness
for a particular purpose;
ii) effectively excludes on behalf of all other Contributors all
liability for damages, including direct, indirect, special,
incidental and consequential damages, such as lost profits;
iii) does not attempt to limit or alter the recipients' rights
in the Source Code under section 3.2; and
iv) requires any subsequent distribution of the Program by any
party to be under a license that satisfies the requirements
of this section 3.
3.2 When the Program is Distributed as Source Code:
a) it must be made available under this Agreement, or if the
Program (i) is combined with other material in a separate file or
files made available under a Secondary License, and (ii) the initial
Contributor attached to the Source Code the notice described in
Exhibit A of this Agreement, then the Program may be made available
under the terms of such Secondary Licenses, and
b) a copy of this Agreement must be included with each copy of
the Program.
3.3 Contributors may not remove or alter any copyright, patent,
trademark, attribution notices, disclaimers of warranty, or limitations
of liability ("notices") contained within the Program from any copy of
the Program which they Distribute, provided that Contributors may add
their own appropriate notices.
4. COMMERCIAL DISTRIBUTION
Commercial distributors of software may accept certain responsibilities
with respect to end users, business partners and the like. While this
license is intended to facilitate the commercial use of the Program,
the Contributor who includes the Program in a commercial product
offering should do so in a manner which does not create potential
liability for other Contributors. Therefore, if a Contributor includes
the Program in a commercial product offering, such Contributor
("Commercial Contributor") hereby agrees to defend and indemnify every
other Contributor ("Indemnified Contributor") against any losses,
damages and costs (collectively "Losses") arising from claims, lawsuits
and other legal actions brought by a third party against the Indemnified
Contributor to the extent caused by the acts or omissions of such
Commercial Contributor in connection with its distribution of the Program
in a commercial product offering. The obligations in this section do not
apply to any claims or Losses relating to any actual or alleged
intellectual property infringement. In order to qualify, an Indemnified
Contributor must: a) promptly notify the Commercial Contributor in
writing of such claim, and b) allow the Commercial Contributor to control,
and cooperate with the Commercial Contributor in, the defense and any
related settlement negotiations. The Indemnified Contributor may
participate in any such claim at its own expense.
For example, a Contributor might include the Program in a commercial
product offering, Product X. That Contributor is then a Commercial
Contributor. If that Commercial Contributor then makes performance
claims, or offers warranties related to Product X, those performance
claims and warranties are such Commercial Contributor's responsibility
alone. Under this section, the Commercial Contributor would have to
defend claims against the other Contributors related to those performance
claims and warranties, and if a court requires any other Contributor to
pay any damages as a result, the Commercial Contributor must pay
those damages.
5. NO WARRANTY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS"
BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR
IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF
TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR
PURPOSE. Each Recipient is solely responsible for determining the
appropriateness of using and distributing the Program and assumes all
risks associated with its exercise of rights under this Agreement,
including but not limited to the risks and costs of program errors,
compliance with applicable laws, damage to or loss of data, programs
or equipment, and unavailability or interruption of operations.
6. DISCLAIMER OF LIABILITY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS
SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST
PROFITS), 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 OR DISTRIBUTION OF THE PROGRAM OR THE
EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
7. GENERAL
If any provision of this Agreement is invalid or unenforceable under
applicable law, it shall not affect the validity or enforceability of
the remainder of the terms of this Agreement, and without further
action by the parties hereto, such provision shall be reformed to the
minimum extent necessary to make such provision valid and enforceable.
If Recipient institutes patent litigation against any entity
(including a cross-claim or counterclaim in a lawsuit) alleging that the
Program itself (excluding combinations of the Program with other software
or hardware) infringes such Recipient's patent(s), then such Recipient's
rights granted under Section 2(b) shall terminate as of the date such
litigation is filed.
All Recipient's rights under this Agreement shall terminate if it
fails to comply with any of the material terms or conditions of this
Agreement and does not cure such failure in a reasonable period of
time after becoming aware of such noncompliance. If all Recipient's
rights under this Agreement terminate, Recipient agrees to cease use
and distribution of the Program as soon as reasonably practicable.
However, Recipient's obligations under this Agreement and any licenses
granted by Recipient relating to the Program shall continue and survive.
Everyone is permitted to copy and distribute copies of this Agreement,
but in order to avoid inconsistency the Agreement is copyrighted and
may only be modified in the following manner. The Agreement Steward
reserves the right to publish new versions (including revisions) of
this Agreement from time to time. No one other than the Agreement
Steward has the right to modify this Agreement. The Eclipse Foundation
is the initial Agreement Steward. The Eclipse Foundation may assign the
responsibility to serve as the Agreement Steward to a suitable separate
entity. Each new version of the Agreement will be given a distinguishing
version number. The Program (including Contributions) may always be
Distributed subject to the version of the Agreement under which it was
received. In addition, after a new version of the Agreement is published,
Contributor may elect to Distribute the Program (including its
Contributions) under the new version.
Except as expressly stated in Sections 2(a) and 2(b) above, Recipient
receives no rights or licenses to the intellectual property of any
Contributor under this Agreement, whether expressly, by implication,
estoppel or otherwise. All rights in the Program not expressly granted
under this Agreement are reserved. Nothing in this Agreement is intended
to be enforceable by any entity that is not a Contributor or Recipient.
No third-party beneficiary rights are created under this Agreement.
Exhibit A - Form of Secondary Licenses Notice
"This Source Code may also be made available under the following
Secondary Licenses when the conditions for such availability set forth
in the Eclipse Public License, v. 2.0 are satisfied: GNU General Public
License as published by the Free Software Foundation, either version 2
of the License, or (at your option) any later version, with the GNU
Classpath Exception which is available at
https://www.gnu.org/software/classpath/license.html."
Simply including a copy of this Agreement, including this Exhibit A
is not sufficient to license the Source Code under Secondary Licenses.
If it is not possible or desirable to put the notice in a particular
file, then You may include the notice in a location (such as a LICENSE
file in a relevant directory) where a recipient would be likely to
look for such a notice.
You may add additional accurate notices of copyright ownership.

22
README.md Normal file
View file

@ -0,0 +1,22 @@
# either
A Clojure library designed to provide a functionally pure mechanism to handle errors.
## Usage
## License
Copyright © 2022 FIXME
This program and the accompanying materials are made available under the
terms of the Eclipse Public License 2.0 which is available at
http://www.eclipse.org/legal/epl-2.0.
This Source Code may also be made available under the following Secondary
Licenses when the conditions for such availability set forth in the Eclipse
Public License, v. 2.0 are satisfied: GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or (at your
option) any later version, with the GNU Classpath Exception which is available
at https://www.gnu.org/software/classpath/license.html.

3
doc/intro.md Normal file
View file

@ -0,0 +1,3 @@
# Introduction to either
TODO: write [great documentation](http://jacobian.org/writing/what-to-write/)

10
project.clj Normal file
View file

@ -0,0 +1,10 @@
(defproject either "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.10.3"]
[prismatic/schema "1.3.5"]
[metosin/schema-tools "0.12.3"]
]
:repl-options {:init-ns either.core})

387
src/either/core.clj Normal file
View file

@ -0,0 +1,387 @@
(ns either.core
"Sumtype like Either in Clojure.
This is useful to represent potential failure with an adjoined error.
Unlike exceptions it is functionally pure.
In the litterature, an Either is sum type with a Left and a Right.
Left often represent the error and Right the value.
As the main usage of Either is probably pure error handling, this ns
provide both naming conventions.
left/right and val/err
Also provide a `let-either` macro for a do-notation similar as the one in Haskell
for the Either type.
"
(:require [schema.core :as s]
[schema-tools.core :as st]))
(defn ->Either
"Return an Either schema by specifying the two sub schemas"
[left-schema right-schema]
(st/optional-keys
{:err left-schema
:val right-schema}))
(def EitherAny
"Useful generic schema for Either"
(->Either s/Any s/Any))
(s/defn left? :- s/Bool
"returns true if the Either contains an error"
[e :- EitherAny]
(contains? e :err))
(s/def error? :- (s/=> s/Bool EitherAny)
"returns true if the Either contains an error"
left?)
(s/defn right? :- s/Bool
"returns true if the Either contains a value"
[e :- EitherAny]
(not (error? e)))
(s/def val? :- (s/=> s/Bool EitherAny)
"returns true if the Either contains a value"
right?)
(s/defn pure :- EitherAny
"Returns an Either from a value"
[value]
{:val value})
(s/def val-> :- (s/=> :EitherAny s/Any)
"Returns an Either from a value"
pure)
(s/defn err-> :- EitherAny
"Returns an Either containing an error"
[err]
{:err err})
(s/defn ->either :- EitherAny
"This is a helper function to build an Either.
The first argument should be a function that should return a value.
The second argument should be a function that given either nil or an Exception should return an error.
- If the function returns a non-nil value then we return `(pure (f))`
- If the function return nil then we return (err-> (exception->err nil))
- If the function throw an Exception e then we return (err-> (exception->err e))
"
[f :- (s/=> s/Any)
exception->err :- (s/=> s/Any (s/maybe Exception))]
(try (if-some [v (f)]
(pure v)
(err-> (exception->err nil)))
(catch Exception e
(err-> (exception->err e)))))
(s/defn some->either :- EitherAny
"Return `(pure v)` unless v is nil, in which case returns `(err-> err)`
Equivalent to: `(->either (constantly v) (constantly err))`
"
[v err]
(if (some? v) (pure v) (err-> err)))
(s/defn left :- s/Any
"Return the error of an Either"
[e :- EitherAny]
(:err e))
(def ->err
"Extract the error of an Either. Returns nil if the Either contains a value"
left)
(s/defn right :- s/Any
"Extract the value of an Either. Returns nil if the Either contains an error"
[e :- EitherAny]
(when-not (error? e)
(:val e)))
(def ->val
"Extract the value of an Either. Returns nil if the Either contains an error"
right)
(s/defn <- :- s/Any
"Return the content of an Either. If the Either contains
an error will just return the error otherwise returns the value."
[e :- EitherAny]
(if (error? e)
(->err e)
(->val e)))
(s/defn fmap :- EitherAny
"Apply a function to the value of an either"
[f e :- EitherAny]
(if (right? e)
(update e :val f)
e))
(s/defn >>= :- EitherAny
"give an Either and a function taking the value of it and returning a new Either bind them.
Example:
```
> (>>= {:val 0} (fn [i] {:val (inc i)}))
{:val 1}
> (>>= {:err :ERROR} (fn [i] {:val (inc i)}))
{:err :ERROR}
```"
[e :- EitherAny
f :- (s/=> EitherAny s/Any)]
(if (error? e)
e
(f (:val e))))
(s/defn >> :- EitherAny
"Equivalent to (>>= e1 (constantly e2))
```
> (>> {:val 1} {:val :second})
{:val :second}
#> (>> {:err :ERROR} {:val 2})
{:err :ERROR}
```"
[e1 :- EitherAny
e2 :- EitherAny]
(if (error? e1) e1 e2))
(s/defn <> :- EitherAny
"Returns its first argument if not an error otherwise the second."
[e1 :- EitherAny
e2 :- EitherAny]
(if (error? e1) e2 e1))
(s/defn either :- s/Any
"Given a function to apply to errors and one to apply to values, applies the correct function to
an Either and return a result which is potentially no more an Either
Perhaps being more precise in the type could help (we cannot do that easily with Clojure and schemas)
The haskell notation would give:
`either : (a -> r) -> (b -> r) -> Either a b -> r`
```
> (either str inc {:val 1})
2
> (either str inc {:err :ERROR})
\":ERROR\"
```"
[err-fn ;; a -> r
val-fn ;; b -> r
e :- EitherAny ;; Either a b
]
(if (error? e)
(err-fn (left e))
(val-fn (right e))))
(s/defn from-either :- s/Any
"Extract the value out of an Either, but apply an error-fn "
[err-fn e :- EitherAny]
(either err-fn identity e))
(s/defn from-either! :- s/Any
"Extract the value out of an Either,
but throw an ExceptionInfo if instead of a value the either contain an error.
We try to build a convenient exception, if the error is a string we use it.
If the error is a map we look for a description in the following keys (in order):
1. `:error_description` (to follow OAuth2 error message structure)
2. `:msg`
3. `:error`
We advise you to build your own
function transforming errors to exceptions.
And on a general note, too much usage of `from-either!` or even `from-either` indicates
an issue with your usage of this library.
If that's the case, you probably want to invest more time in looking into
the `let-either` macro."
[e :- EitherAny]
(let [err->ex-info
(fn [err]
(cond
(string? err) (ex-info err {})
(map? err) (if-let [err-msg (or (:error_description err)
(:msg err)
(:error err))]
(cond
(string? err-msg) (ex-info err-msg err)
(keyword? err-msg) (ex-info (name err-msg) err)
:else (ex-info "error" err))
(ex-info "error" err))
:else (ex-info "error" {:err err})))]
(either #(throw (err->ex-info %)) identity e)))
(s/defn bimap :- EitherAny
"Given two functions, one to apply to val and one to apply to errors
Apply the function into the Either content.
This should obey the laws:
> (bimap f g (pure x)) == (pure (g x))
> (bimap f g (err-> x)) == (pure (f x))
```
> (bimap str inc (pure 0))
1
> (bimap str inc (err-> :ERROR))
\":ERROR\"
```
"
[err-fn val-fn e :- EitherAny]
(if (error? e)
(err-> (err-fn (left e)))
(pure (val-fn (right e)))))
(s/defn bifoldmap :- [EitherAny]
"Given two functions, one to apply on errors and one to apply on values
Apply the function inside the Either for a sequence of them.
> (= (bifoldmap str inc [(pure 0) (err-> :ERROR)])
[(pure 1) (err-> \":ERROR\")])
true
"
[err-fn val-fn eithers :- [EitherAny]]
(map #(bimap err-fn val-fn %) eithers))
(defmacro let-either
"The let-either macro can be used to handle cascading eithers that
could depends of preceeding values.
It is EXACTLY like the either monad.
So all right-hand-side of the let must return an EitherAny
If one of the function fail, we stop evaluation as soon as possible
and return the failed either.
If all functions are successful we return the content of the
body as a successful Result. So the body shouldn't take care of
returning an Either..
Examples:
```
> (let-either [] 10)
10
> (let-either [x {:val 1}] ;; x => 1
(inc x))
2
> (let-either [x {:val 1} ;; x => 1
y {:val (inc x)} ;; y => 2
z {:val (+ x y)} ;; z => 3
t {:err :ERROR} ;; stop evaluating here
u {:val (+ z x)}]
(inc u))
{:err :ERROR}
> (let-either [x {:val 1} ;; x => 1
y {:val (inc x)} ;; y => 2
z {:val (+ x y)} ;; z => 3
t {:val (* z 2)} ;; t => 6
u {:val (* t 10)}] ;; u => 60
(inc u))
61
```"
{:special-form true
:forms '[(let-either [bindings*] exprs*)]
:style/indent 0}
[bindings & body]
(if (empty? bindings)
`(do ~@body)
(if (>= (count bindings) 2)
`(let [either# ~(second bindings)]
(if (error? either#)
either#
(let [~(first bindings) (:val either#)]
(let-either ~(drop 2 bindings) ~@body))))
(throw (IllegalArgumentException.
"an even number of arguments is expected in the bindings")))))
(s/defn partition-eithers :- {:vals [s/Any] :errs [s/Any]}
"This function is useful to accumulate extracted values and errors from eithers.
```
> (sut/partition-eithers [(sut/pure 1)
(sut/pure 2)
(sut/err-> :x)
(sut/pure 3)
(sut/err-> :y)])
{:vals [1 2 3], :errs [:x :y]}
```"
[eithers :- [EitherAny]]
(let [[vs errs]
(->> eithers
(sort-by error?)
(partition-by error?))]
(cond
;; empty list
(nil? vs) {:vals [] :errs []}
;; only errors
(error? (first vs)) {:vals [] :errs (mapv left vs)}
:else {:vals (mapv right vs)
:errs (mapv left errs)})))
(s/defn rights :- [s/Any]
"This function accumulate all values of a list of eithers, and discard errors.
If you need both values and errors, use partition-eithers instead of `left-sum`
and `right-sum` separately."
[eithers :- [EitherAny]]
(:vals (partition-eithers eithers)))
(s/defn lefts :- [s/Any]
"Accumulate errors of a list of eithers and discard values.
If you need both values and errors, use partition-eithers instead of `left-sum`
and `right-sum` separately."
[eithers :- [EitherAny]]
(:errs (partition-eithers eithers)))
(defmacro build-either-api
"Declare all functions for Either but restricted to (->Either left-schema right-schema)
instead of using the broader EitherAny schema.
It will declare all the functions in your current namespace."
[left-schema right-schema]
`(let [ls# ~left-schema
rs# ~right-schema]
(def ~'Either (either.core/->Either ls# rs#))
(schema.core/defn ~'left? :- schema.core/Bool [e# :- ~'Either] (either.core/left? e#))
(schema.core/defn ~'error? :- schema.core/Bool [e# :- ~'Either] (either.core/error? e#))
(schema.core/defn ~'right? :- schema.core/Bool [e# :- ~'Either] (either.core/right? e#))
(schema.core/defn ~'val? :- schema.core/Bool [e# :- ~'Either] (either.core/val? e#))
(schema.core/defn ~'pure :- ~'Either [v# :- rs#] (either.core/pure v#))
(schema.core/defn ~'val-> :- ~'Either [v# :- rs#] (either.core/pure v#))
(schema.core/defn ~'err-> :- ~'Either [err# :- ls#] (either.core/err-> err#))
(schema.core/defn ~'->either :- ~'Either [f# x#] (either.core/->either f# x#))
(schema.core/defn ~'some->either :- ~'Either [v# :- rs# err# :- ls#] (either.core/some->either v# err#))
(schema.core/defn ~'left :- ls# [e# :- ~'Either] (either.core/left e#))
(schema.core/defn ~'->err :- ls# [e# :- ~'Either] (either.core/left e#))
(schema.core/defn ~'right :- rs# [e# :- ~'Either] (either.core/right e#))
(schema.core/defn ~'->val :- rs# [e# :- ~'Either] (either.core/right e#))
(schema.core/defn ~'<- [e# :- ~'Either] (either.core/<- e#)) ;; missing s/either cond-pre is to risky
(schema.core/defn ~'fmap :- ~'Either [f# e# :- ~'Either] (either.core/fmap f# e#))
(schema.core/defn ~'>>= :- ~'Either [e# :- ~'Either f#] (either.core/>>= e# f#))
(schema.core/defn ~'>> :- ~'Either [e1# :- ~'Either e2# :- ~'Either] (either.core/>> e1# e2#))
(schema.core/defn ~'<> :- ~'Either [e1# :- ~'Either e2# :- ~'Either] (either.core/<> e1# e2#))
(schema.core/defn ~'either [lfn# rfn# e# :- ~'Either] (either.core/either lfn# rfn# e#))
(schema.core/defn ~'from-either [lfn# e# :- ~'Either] (either.core/from-either lfn# e#))
(schema.core/defn ~'from-either! [e# :- ~'Either] (either.core/from-either! e#))
(schema.core/defn ~'bimap :- ~'Either [lfn# rfn# e# :- ~'Either] (either.core/bimap lfn# rfn# e#))
(schema.core/defn ~'bifoldmap :- [~'Either] [lfn# rfn# es# :- [~'Either]] (either.core/bifoldmap lfn# rfn# es#))
(schema.core/defn ~'partition-eithers :- {:vals [rs#] :errs [ls#]} [es# :- [~'Either]] (either.core/partition-eithers es#))
(schema.core/defn ~'rights :- [rs#] [es# :- [~'Either]] (either.core/rights es#))
(schema.core/defn ~'lefts :- [ls#] [es# :- [~'Either]] (either.core/lefts es#))))

475
test/either/core_test.clj Normal file
View file

@ -0,0 +1,475 @@
(ns either.core-test
(:require
[clojure.string :as string]
[clojure.test :as t]
[either.core :as sut]
[schema.core :as s]
[schema.test]))
(t/use-fixtures :once schema.test/validate-schemas)
(t/deftest ->Either-test
(t/testing "Either Str Int"
(let [EitherStrInt (sut/->Either s/Str s/Int)]
(t/testing "valid"
(t/are [x] (nil? (s/check EitherStrInt x))
(sut/pure 1)
(sut/err-> "error")))
(t/testing "invalid"
(t/are [x] (s/check EitherStrInt x)
(sut/pure "string")
(sut/err-> :not-string))))))
(t/deftest error?-test
(t/is (false? (sut/error? (sut/pure nil)))
"Even if the value is nil, it should detect this either is not an error.")
(t/is (false? (sut/error? (sut/pure false)))
"Even if the value is false, it should detect this either is not an error.")
(t/is (false? (sut/error? (sut/pure true)))
"Even if the value is true, it should detect this either is not an error.")
(t/is (false? (sut/error? {}))
"An empty map is a valid Either, equivalent to {:val nil} and is thus not an error.")
(t/is (true? (sut/error? (sut/err-> nil)))
"Even if the error value is nil, it should detect this either is an error.")
(t/is (true? (sut/error? (sut/err-> false)))
"Even if the error value is false, it should detect this either is an error.")
(t/is (true? (sut/error? (sut/err-> true)))
"Even if the error value is true, it should detect this either is an error."))
(t/deftest val?-test
(t/is (true? (sut/val? (sut/pure nil)))
"Even if the value is nil, it should detect this either is not an error.")
(t/is (true? (sut/val? (sut/pure false)))
"Even if the value is false, it should detect this either is not an error.")
(t/is (true? (sut/val? (sut/pure true)))
"Even if the value is true, it should detect this either is not an error.")
(t/is (true? (sut/val? {}))
"An empty map is a valid Either, equivalent to {:val nil} and is thus not an error.")
(t/is (false? (sut/val? (sut/err-> nil)))
"Even if the error value is nil, it should detect this either is an error.")
(t/is (false? (sut/val? (sut/err-> false)))
"Even if the error value is false, it should detect this either is an error.")
(t/is (false? (sut/val? (sut/err-> true)))
"Even if the error value is true, it should detect this either is an error."))
(t/deftest pure-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/right (sut/pure x)))
"pure should return an Either with a single right")))
(t/deftest err->-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/left (sut/err-> x)))
"err-> should return an Either with a single left")))
(t/deftest ->either-test
(t/is (= (sut/pure 10)
(sut/->either (constantly 10) (constantly :ERROR))))
(t/is (= (sut/err-> :ERROR)
(sut/->either (constantly nil)
(fn [e] (if e {:e (ex-data e)} :ERROR)))))
(t/is (= (sut/err-> {:e {:error :test-error}})
(sut/->either (fn [] (throw (ex-info "test-error" {:error :test-error})))
(fn [e] (if e {:e (ex-data e)} :ERROR)))))
(t/is (= :schema.core/error
(try (sut/->either nil :ERROR)
(catch Exception e
(:type (ex-data e)))))
"not passing a function should throw a schema exception")
(t/is (= :schema.core/error
(try (sut/->either (constantly nil) nil)
(catch Exception e
(:type (ex-data e)))))
"not passing a function should throw a schema exception"))
(t/deftest some->either-test
(t/is (= (sut/pure 10)
(sut/some->either 10 :ERROR)))
(t/is (= (sut/err-> :ERROR)
(sut/some->either nil :ERROR))))
(t/deftest left-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/left (sut/err-> x)))
"left should return the value of an either"))
(t/is (false? (sut/left {:val true :err false}))
"left should return the error even if the Either is misrepresented"))
(t/deftest ->err-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/->err (sut/err-> x)))
"->err should return the value of an either"))
(t/is (false? (sut/->err {:val true :err false}))
"->err should return the error even if the Either is misrepresented"))
(t/deftest right-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/right (sut/val-> x)))
"right should return the value of an either"))
(t/is (nil? (sut/right {:val true :err false}))
"right should return nil if the Either is an error even when the Either is misrepresented"))
(t/deftest ->val-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/->val (sut/val-> x)))
"->val should return the value of an either"))
(t/is (nil? (sut/->val {:val true :err false}))
"->val should return nil if the Either is an error even when the Either is misrepresented"))
(t/deftest <--test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/<- (sut/val-> x)))
"should return the value if this is a pure value")
(t/is (= x (sut/<- (sut/err-> x)))
"should return the error if this is a pure error")
(t/is (= x (sut/<- {:val true :err x}))
"should return the error if the either is misrepresented")))
(t/deftest left-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/left (sut/err-> x)))
"left should return the error of an either")
(t/is (nil? (sut/left (sut/pure x)))
"left should return nil for non error eithers")))
(t/deftest right-test
(doseq [x [nil :x true "x" {:a "a"}]]
(t/is (= x (sut/right (sut/pure x)))
"right should return the error of an either")
(t/is (nil? (sut/right (sut/err-> x)))
"right should return nil for non error eithers"))
(t/is (nil? (sut/right {:val true :err nil}))
"Even if the either is not clean (both :val and :err) it should return the error"))
(t/deftest fmap-test
(t/testing "Obey applicative law"
(doseq [[x f] [[0 inc]
[:ERROR str]
[:ERROR name]
[:x (constantly :value)]]]
(t/is (= (sut/pure (f x))
(sut/fmap f (sut/pure x))))
(let [err (sut/err-> x)]
(t/is (= err (sut/fmap f err))))
(let [malformed-either {:val true :err x}]
(t/is (= malformed-either (sut/fmap f malformed-either)))))))
(t/deftest >>=-test
(t/is (= (sut/pure 1)
(sut/>>= (sut/pure 0) (fn [i] (sut/pure (inc i))))))
(t/is (= (sut/err-> :ERROR)
(sut/>>= (sut/err-> :ERROR) (fn [i] (sut/pure (inc i)))))))
(t/deftest >>-test
(t/is (= (sut/pure 42)
(sut/>> (sut/pure 0) (sut/pure 42))))
(t/is (= (sut/err-> :ERROR)
(sut/>> (sut/err-> :ERROR) (sut/pure 42)))))
(t/deftest either-test
(t/is (= 2 (sut/either str inc (sut/pure 1))))
(t/is (= ":ERROR" (sut/either str inc (sut/err-> :ERROR)))))
(t/deftest from-either-test
(t/is (= 1 (sut/from-either (constantly :HERE) (sut/pure 1))))
(t/is (= :HERE (sut/from-either (constantly :HERE) (sut/err-> :ERROR))))
(t/is (= :HERE (sut/from-either (constantly :HERE) {:val 1 :err :ERROR}))
"Should return the error for misrepresented eithers"))
(t/deftest from-either!-test
(let [ex-info->map (fn [e] {:msg (ex-message e)
:data (ex-data e)
:cause (ex-cause e)})]
(t/is (= 1 (sut/from-either! (sut/pure 1))))
(t/is (= {:msg "error"
:data {:err :ERROR}
:cause nil}
(try (sut/from-either! (sut/err-> :ERROR))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))
(t/is (= {:msg "direct error message", :data {}, :cause nil}
(try (sut/from-either! (sut/err-> "direct error message"))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))
(t/is (= {:msg "some description"
:data {:error :code
:error_description "some description"}
:cause nil}
(try (sut/from-either! (sut/err-> {:error :code :error_description "some description"}))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))
(t/is (= {:msg "keyword-error"
:data {:error :code
:error_description :keyword-error}
:cause nil}
(try (sut/from-either! (sut/err-> {:error :code :error_description :keyword-error}))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))
(t/is (= {:msg "error"
:data {:error :code, :error_description {:bad :type}}
:cause nil}
(try (sut/from-either! (sut/err-> {:error :code :error_description {:bad :type}}))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))
(t/is (= {:msg "message"
:data {:msg "message"}
:cause nil}
(try (sut/from-either! (sut/err-> {:msg "message"}))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))
(t/is (= {:msg "error-code"
:data {:error :error-code}
:cause nil}
(try (sut/from-either! (sut/err-> {:error :error-code}))
(catch clojure.lang.ExceptionInfo e (ex-info->map e)))))))
(t/deftest bimap-test
;; testing that:
;; (bimap f g (pure x)) == (pure (f x))
;; (bimap f g (err-> x)) == (pure (g x))
(t/is (= (sut/pure 1) (sut/bimap str inc (sut/pure 0))))
(t/is (= (sut/err-> ":ERROR") (sut/bimap str inc (sut/err-> :ERROR))))
(t/is (= {:err ":ERROR"} (sut/bimap str inc {:val 0 :err :ERROR}))
"Even if misrepresented handled bimap correctly, forget val"))
(t/deftest bifolfmap-test
(t/is
(= (sut/bifoldmap str inc [(sut/pure 0) (sut/err-> :ERROR)])
[(sut/pure 1) (sut/err-> ":ERROR")])))
(t/deftest let-either-test
(t/is (= :ok (sut/let-either [] :ok)))
(t/is (= 2 (sut/let-either [x (sut/pure 1)]
(inc x))))
(t/is
(= 61
(sut/let-either [x (sut/pure 1) ;; x => 1
y (sut/pure (inc x)) ;; y => 2
z (sut/pure (+ x y)) ;; z => 3
t (sut/pure (* z 2)) ;; t => 6
u (sut/pure (* t 10))] ;; u => 60
(inc u)))
"Check every left-hand-side is the value of the either extracted as expected")
(try
(t/is
(= {:err :ERROR}
(sut/let-either [x (sut/pure 1) ;; x => 1
y (sut/err-> :ERROR) ;; STOP here and should not evaluate
z (throw (ex-info "SHOULD NOT BE THROWN" {:x x :y y}))
t (sut/pure (* z 2)) ;; t => 6
u (sut/pure (* t 10))] ;; u => 60
(inc u)))
"Test early failure")
(catch Exception e
(t/is (= :error (ex-data e))
"No exception should be thrown because let stop evaluating as soon as possible."))))
(t/deftest partition-eithers-test
(t/is (= {:vals [], :errs []}
(sut/partition-eithers [])))
(t/is (= {:vals [], :errs [:x :y]}
(sut/partition-eithers [(sut/err-> :x)
(sut/err-> :y)])))
(t/is (= {:vals [1 2 3], :errs []}
(sut/partition-eithers [(sut/pure 1)
(sut/pure 2)
(sut/pure 3)])))
(t/is (= {:vals [1 2 3], :errs [:x :y]}
(sut/partition-eithers [(sut/pure 1)
(sut/pure 2)
(sut/err-> :x)
(sut/pure 3)
(sut/err-> :y)]))))
(t/deftest lefts-test
(t/is (= [] (sut/lefts [])))
(t/is (= []
(sut/lefts [(sut/pure 1)
(sut/pure 2)
(sut/pure 3)])))
(t/is (= [:x :y]
(sut/lefts [(sut/err-> :x)
(sut/err-> :y)])))
(t/is (= [:x :y]
(sut/lefts [(sut/pure 1)
(sut/pure 2)
(sut/err-> :x)
(sut/pure 3)
(sut/err-> :y)]))))
(t/deftest rights-test
(t/is (= [] (sut/rights [])))
(t/is (= [1 2 3]
(sut/rights [(sut/pure 1)
(sut/pure 2)
(sut/pure 3)])))
(t/is (= []
(sut/rights [(sut/err-> :x)
(sut/err-> :y)])))
(t/is (= [1 2 3]
(sut/rights [(sut/pure 1)
(sut/pure 2)
(sut/err-> :x)
(sut/pure 3)
(sut/err-> :y)]))))
;; --- MACRO build-either-apit TESTING
;;
;; To understand what is going on, the build-either-api
;; will declare all function with the same names as the one declared
;; in either.core
;; but these local functions will be more restrictive with their schemas.
;;
;; So we could test the schema validation by building some Either with the wrong schemas
;; using the global functions in either.core but using them with the local
;; function declared in this specific namespace (either.core-test)
(sut/build-either-api s/Str s/Int)
(defmacro throw-schema-x?
"Around a body, returns true if once evaluated the body thrown a schema error exception"
[& body]
`(= :schema.core/error
(try (do ~@body)
false
(catch Exception e#
(:type (ex-data e#))))))
(t/deftest build-either-api-test
;; see comment on top of build-either-api in this ns
;; for help
#_{:clj-kondo/ignore true, :eastwood/ignore true}
(let [ok-val 10
bad-val "bad-type"
ok-err "error"
bad-err :not-a-string
r (sut/pure ok-val)
bad-r (sut/pure bad-val)
l (sut/err-> ok-err)
bad-l (sut/err-> bad-err)]
(t/testing "(build-either-api Str Int)"
(t/testing "left?"
(t/is (left? l))
(t/is (throw-schema-x? (left? bad-l))))
(t/testing "error?"
(t/is (error? l))
(t/is (throw-schema-x? (error? bad-l))))
(t/testing "right?"
(t/is (right? r))
(t/is (throw-schema-x? (right? bad-r))))
(t/testing "val?"
(t/is (val? r))
(t/is (throw-schema-x? (val? bad-r))))
(t/testing "pure"
(t/is (pure 10))
(t/is (throw-schema-x? (pure "some-string"))))
(t/testing "val->"
(t/is (val-> ok-val))
(t/is (throw-schema-x? (val-> bad-val))))
(t/testing "err->"
(t/is (err-> ok-err))
(t/is (throw-schema-x? (err-> bad-err))))
(t/testing "->either"
(t/is (->either (constantly ok-val) (constantly ok-err)))
(t/is (->either (constantly nil) (constantly ok-err)))
(t/is (throw-schema-x? (->either (constantly bad-val) (constantly ok-err))))
(t/is (throw-schema-x? (->either (constantly nil) (constantly bad-err)))))
(t/testing "some->either"
(t/is (some->either ok-val ok-err))
(t/is (throw-schema-x? (some->either nil ok-err)))
(t/is (throw-schema-x? (some->either ok-val bad-err))))
(t/testing "left"
(t/is (left l))
(t/is (throw-schema-x? (left bad-l))))
(t/testing "->err"
(t/is (->err l))
(t/is (throw-schema-x? (->err bad-l))))
(t/testing "right"
(t/is (right r))
(t/is (throw-schema-x? (right bad-r))))
(t/testing "->val"
(t/is (->val r))
(t/is (throw-schema-x? (->val bad-r))))
(t/testing "<-"
(t/is (<- r))
(t/is (<- l))
(t/is (throw-schema-x? (<- bad-r)))
(t/is (throw-schema-x? (<- bad-l))))
(t/testing "fmap"
(t/is (fmap identity r))
(t/is (fmap identity l))
(t/is (throw-schema-x? (fmap identity bad-r)))
(t/is (throw-schema-x? (fmap identity bad-l))))
(t/testing ">>="
(t/is (>>= r #(sut/pure (inc %)) ))
(t/is (>>= l #(sut/pure (inc %))))
(t/is (throw-schema-x? (>>= bad-r #(sut/pure (str "x" %)))))
(t/is (throw-schema-x? (>>= r #(sut/err-> (inc %))))))
(t/testing ">>"
(t/is (>> r r))
(t/is (>> l r))
(t/is (>> r l))
(t/is (throw-schema-x? (>> bad-r r)))
(t/is (throw-schema-x? (>> r bad-r)))
(t/is (throw-schema-x? (>> bad-l r)))
(t/is (throw-schema-x? (>> r bad-l))))
(t/testing "<>"
(t/is (<> r r))
(t/is (<> r l))
(t/is (<> l r))
(t/is (<> l l))
(t/is (throw-schema-x? (<> bad-r r)))
(t/is (throw-schema-x? (<> bad-r l)))
(t/is (throw-schema-x? (<> bad-l r)))
(t/is (throw-schema-x? (<> bad-l l)))
(t/is (throw-schema-x? (<> r bad-r)))
(t/is (throw-schema-x? (<> r bad-l)))
(t/is (throw-schema-x? (<> l bad-r)))
(t/is (throw-schema-x? (<> l bad-l))))
(t/testing "either"
(t/is (either string/reverse inc r))
(t/is (either string/reverse inc l))
(t/is (throw-schema-x? (either string/reverse inc bad-r)))
(t/is (throw-schema-x? (either string/reverse inc bad-l)))
;; would be nice but we don't have a natural way with conditional to express this is one schema or another
;; (t/is (throw-schema-x? (either (constantly bad-err) (constantly bad-val) r)))
;; (t/is (throw-schema-x? (either (constantly bad-err) (constantly bad-val) l)))
)
(t/testing "from-either"
(t/is (from-either string/reverse r))
(t/is (from-either string/reverse l))
(t/is (throw-schema-x? (from-either string/reverse bad-r)))
(t/is (throw-schema-x? (from-either string/reverse bad-l))))
(t/testing "from-either!"
(t/is (from-either! r))
(t/is (not (throw-schema-x? (from-either! l)))) ;; throw an exception but not a schema exception
(t/is (throw-schema-x? (from-either! bad-r)))
(t/is (throw-schema-x? (from-either! bad-l))))
(t/testing "bimap"
(t/is (bimap string/reverse inc r))
(t/is (bimap string/reverse inc l))
(t/is (throw-schema-x? (bimap string/reverse inc bad-r)))
(t/is (throw-schema-x? (bimap string/reverse inc bad-l)))
(t/is (throw-schema-x? (bimap (constantly bad-err) (constantly bad-val) r)))
(t/is (throw-schema-x? (bimap (constantly bad-err) (constantly bad-val) l))))
(t/testing "bifoldmap"
(t/is (bifoldmap string/reverse inc [r l]))
(t/is (throw-schema-x? (bifoldmap string/reverse inc [bad-r l])))
(t/is (throw-schema-x? (bifoldmap string/reverse inc [r bad-l])))
(t/is (throw-schema-x? (bifoldmap (constantly bad-err) inc [r l])))
(t/is (throw-schema-x? (bifoldmap string/reverse (constantly bad-val) [r l]))))
(t/testing "partition-eithers"
(t/is (partition-eithers [r l r l]))
(t/is (throw-schema-x? (partition-eithers [r l bad-r l])))
(t/is (throw-schema-x? (partition-eithers [r l r bad-l]))))
(t/testing "rights"
(t/is (rights [r l r l]))
(t/is (throw-schema-x? (rights [r l bad-r l])))
(t/is (throw-schema-x? (rights [r l r bad-l]))))
(t/testing "lefts"
(t/is (lefts [r l r l]))
(t/is (throw-schema-x? (lefts [r l bad-r l])))
(t/is (throw-schema-x? (lefts [r l r bad-l])))))))