Merge pull request #203 from ericvm/fix-infer-nested-contexts

Fix Issue #192 of dynamic context overriding default context

src/cats/context.cljc

@@ -28,6 +28,7 @@
   (:require [cats.protocols :as p]))
 
 (def ^:dynamic *context* nil)
+(def ^:dynamic *override* nil)
 
 (defn throw-illegal-argument
   {:no-doc true :internal true}
@@ -52,6 +53,18 @@
         (binding [*context* ~ctx]
           ~@body))))
 
+#?(:clj
+(defmacro with-context-override
+  "Set current context to specific monad."
+  [ctx & body]
+  `(do
+     (when-not (context? ~ctx)
+       (throw-illegal-argument
+        "The provided context does not implements Context."))
+     (binding [*context* ~ctx
+               *override* true]
+       ~@body))))
+
 #?(:clj
    (defmacro with-monad
      "Semantic alias for `with-context`."
@@ -69,12 +82,15 @@
    *context*)
   ([v]
    (cond
-     (not (nil? *context*))
+     (not (nil? *override*))
      *context*
 
      (satisfies? p/Contextual v)
      (p/-get-context v)
 
+     (not (nil? *context*))
+     *context*
+
      :else
      (throw-illegal-argument
       (str "No context is set and it can not be automatically "

src/cats/labs/test.cljc

@@ -74,7 +74,7 @@
 (defn monoid-identity-element
   [{:keys [ctx gen empty eq] :or {empty (m/mempty ctx) eq =}}]
   (prop/for-all [x gen]
-    (ctx/with-context ctx
+    (ctx/with-context-override ctx
       (eq x
           (m/mappend x empty)
           (m/mappend empty x)))))

test/cats/labs/manifold_spec.clj

@@ -77,14 +77,14 @@
 
   (t/testing "Times out"
     (let [tctx (mf/deferred-context* 20)
-          v (ctx/with-context tctx
+          v (ctx/with-context-override tctx
               (m/mlet [x (d/future (Thread/sleep 30) :foo)]
                 (m/return x)))]
       (t/is (thrown? java.util.concurrent.TimeoutException @v))))
 
   (t/testing "Times out with value"
     (let [tctx (mf/deferred-context* 20 (either/left :foo))
-          v (ctx/with-context tctx
+          v (ctx/with-context-override tctx
               (m/mlet [x (d/future (Thread/sleep 30) :foo)]
                 (m/return x)))]
       (t/is (= (either/left :foo) @v)))))