commit 9abfd74d6c8f23f3a509162365ffecd9a10070bb Author: Yann Esposito (Yogsototh) Date: Tue Aug 9 16:24:03 2022 +0200 intial either lib diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d956ab0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,13 @@ +/target +/classes +/checkouts +profiles.clj +pom.xml +pom.xml.asc +*.jar +*.class +/.lein-* +/.nrepl-port +/.prepl-port +.hgignore +.hg/ diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..f7addf7 --- /dev/null +++ b/CHANGELOG.md @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..2315126 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..e169007 --- /dev/null +++ b/README.md @@ -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. diff --git a/doc/intro.md b/doc/intro.md new file mode 100644 index 0000000..1d8e7df --- /dev/null +++ b/doc/intro.md @@ -0,0 +1,3 @@ +# Introduction to either + +TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) diff --git a/project.clj b/project.clj new file mode 100644 index 0000000..eabaf5e --- /dev/null +++ b/project.clj @@ -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}) diff --git a/src/either/core.clj b/src/either/core.clj new file mode 100644 index 0000000..f529d3b --- /dev/null +++ b/src/either/core.clj @@ -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#)))) diff --git a/test/either/core_test.clj b/test/either/core_test.clj new file mode 100644 index 0000000..88819af --- /dev/null +++ b/test/either/core_test.clj @@ -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])))))))