diff --git a/src/nodely/engine/applicative/manifold.clj b/src/nodely/engine/applicative/manifold.clj new file mode 100644 index 0000000..78c1474 --- /dev/null +++ b/src/nodely/engine/applicative/manifold.clj @@ -0,0 +1,51 @@ +(ns nodely.engine.applicative.manifold + (:require + [cats.protocols :as mp] + [manifold.deferred :as deferred])) + +(declare context) + +(extend-type manifold.deferred.SuccessDeferred + mp/Extract + (-extract [it] + (try (deref it) + (catch java.util.concurrent.ExecutionException e + (throw (.getCause e)))))) + +(extend-type manifold.deferred.Deferred + mp/Extract + (-extract [it] + (try (deref it) + (catch java.util.concurrent.ExecutionException e + (throw (.getCause e)))))) + +(extend-type manifold.deferred.ErrorDeferred + mp/Extract + (-extract [it] + (try (deref it) + (catch java.util.concurrent.ExecutionException e + (throw (.getCause e)))))) + +(def ^:no-doc context + (reify + mp/Context + mp/Functor + (-fmap [_ f mv] + (deferred/chain mv f)) + + mp/Monad + (-mreturn [_ v] + (deferred/future v)) + + (-mbind [_ mv f] + (deferred/chain mv (fn [v] + (f v)))) + + mp/Applicative + (-pure [_ v] + (deferred/future v)) + + (-fapply [_ pf pv] + (deferred/chain (deferred/zip' pf pv) + (fn [[f v]] + (f v)))))) diff --git a/test/nodely/engine/applicative_test.clj b/test/nodely/engine/applicative_test.clj index 83139c7..6f9baa6 100644 --- a/test/nodely/engine/applicative_test.clj +++ b/test/nodely/engine/applicative_test.clj @@ -11,6 +11,7 @@ [nodely.engine.applicative :as applicative] [nodely.engine.applicative.core-async :as core-async] [nodely.engine.applicative.promesa :as promesa] + [nodely.engine.applicative.manifold :as manifold] [nodely.engine.applicative.synchronous :as synchronous] [nodely.engine.core :as core] [nodely.engine.core-async.core :as nodely.async] @@ -297,3 +298,74 @@ promesa/context java.util.concurrent.CompletableFuture core-async/context clojure.core.async.impl.channels.ManyToManyChannel synchronous/context nodely.engine.applicative.synchronous.Box)) +(deftest manifold-applicative-test + (let [simple-env {:a (>value 2) + :b (>value 1) + :c (>leaf (+ ?a ?b))} + env-with-failing-schema {:a (>value 2) + :b (>value 1) + :c (yielding-schema (>leaf (+ ?a ?b)) s/Bool)}] + (testing "it should not fail" + (is (match? 3 (applicative/eval-key simple-env :c {::applicative/context manifold/context})))) + + (testing "more complicated example" + (is (match? 4 (applicative/eval-key tricky-example :z {::applicative/context manifold/context})))) + + (testing "returns ex-info when schema is selected as fvalidate, and schema fn validation is enabled" + (is (thrown-match? clojure.lang.ExceptionInfo + {:type :schema.core/error + :schema java.lang.Boolean + :value 3} + (ex-data + (s/with-fn-validation + (applicative/eval-key env-with-failing-schema :c {::applicative/fvalidate schema/fvalidate + ::applicative/context manifold/context})))))))) + +(deftest manifold-eval-key-test + (testing "eval promise" + (is (match? 3 (applicative/eval-key test-env :c {::applicative/context core-async/context})))) + (testing "async works" + (let [[time-ns result] (criterium/time-body (applicative/eval-key test-env+delay-core-async + :d + {::applicative/context manifold/context}))] + (is (match? {:a 3 :b 6 :c 9} result)) + (is (match? (matchers/within-delta 100000000 1000000000) time-ns)))) + (testing "tricky example" + (is (match? 4 (applicative/eval-key tricky-example :z + {::applicative/context manifold/context}))))) + +(deftest manifold-eval-test + (testing "eval promise" + (is (match? {:a {::data/value 2} + :b {::data/value 1} + :c {::data/value 3}} + (applicative/eval test-env :c {::applicative/context manifold/context})))) + (testing "tricky example" + (is (match? {:x (data/value 1) + :y (data/value 2) + :a (data/value 3) + :b (data/value 4) + :c (data/value 5) + :w (data/value 4) + :z {::data/type :leaf + ::data/inputs #{:w}}} + (applicative/eval tricky-example :w {::applicative/context manifold/context}))))) + +(deftest manifold-eval-env-with-sequence + (testing "async response is equal to sync response" + (is (match? (-> (core/resolve :b env-with-sequence) (get :b) ::data/value) + (applicative/eval-key env-with-sequence :b {::applicative/context manifold/context})))) + (testing "sync=async for sequence with nil values" + (is (match? (-> (core/resolve :b env+sequence-with-nil-values) (get :b) ::data/value) + (applicative/eval-key env+sequence-with-nil-values :b {::applicative/context manifold/context})))) + (testing "sync=async for sequence returning nil values" + (is (match? (-> (core/resolve :b env+sequence-returning-nil-values) (get :b) ::data/value) + (applicative/eval-key env+sequence-returning-nil-values :b {::applicative/context manifold/context})))) + (testing "async version takes a third of the time of sync version + (runtime diff is 2 sec, within a tolerance of 3ms" + (let [[nanosec-sync _] (criterium/time-body (core/resolve :c env-with-sequence+delay-sync)) + [nanosec-async _] (criterium/time-body (applicative/eval-key env-with-sequence+delay-sync :c {::applicative/context manifold/context}))] + (is (match? (matchers/within-delta 8000000 2000000000) + (- nanosec-sync nanosec-async))))) + (testing "Actually computes the correct answers" + (is (match? [2 3 4] (applicative/eval-key env-with-sequence+delay-sync :c {::applicative/context manifold/context})))))