388 lines
13 KiB
Clojure
388 lines
13 KiB
Clojure
(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#))))
|