476 lines
19 KiB
Clojure
476 lines
19 KiB
Clojure
(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])))))))
|