intial either lib
This commit is contained in:
commit
9abfd74d6c
13
.gitignore
vendored
Normal file
13
.gitignore
vendored
Normal 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
24
CHANGELOG.md
Normal 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
280
LICENSE
Normal 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
22
README.md
Normal 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
3
doc/intro.md
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
# Introduction to either
|
||||||
|
|
||||||
|
TODO: write [great documentation](http://jacobian.org/writing/what-to-write/)
|
10
project.clj
Normal file
10
project.clj
Normal 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
387
src/either/core.clj
Normal 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
475
test/either/core_test.clj
Normal 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])))))))
|
Loading…
Reference in a new issue