Bind wrapped type->lifecycle in specs

Author: vlaaad

src/cljfx/dev.clj

@@ -39,11 +39,9 @@
 (def ^:dynamic *type->lifecycle*
   (some-fn fx/keyword->lifecycle fx/fn->lifecycle))
 
-(defn- type->lifecycle [x]
-  (or (*type->lifecycle* x) x))
-
 (defn- valid-fx-type? [m]
-  (let [lifecycle (type->lifecycle (:fx/type m))]
+  (let [type (:fx/type m)
+        lifecycle (or (*type->lifecycle* type) type)]
     (or (contains? (meta lifecycle) `lifecycle/create)
         (satisfies? lifecycle/Lifecycle lifecycle))))
 
@@ -244,7 +242,7 @@
 
 (defn wrap-type->lifecycle [type->lifecycle]
   (fn [type]
-    (wrap-lifecycle type (type->lifecycle type))))
+    (wrap-lifecycle type type->lifecycle)))
 
 (def type->lifecycle
   (wrap-type->lifecycle (some-fn fx/keyword->lifecycle fx/fn->lifecycle)))

src/cljfx/dev/validation.clj

@@ -57,32 +57,34 @@
                      (str " in " in)))))
        (str/join "\n")))
 
-(defn- ensure-valid-desc [desc fx-type]
-  (when-let [explain-data (s/explain-data :cljfx/desc (assoc desc :fx/type fx-type))]
-    (throw (ex-info (str "Invalid cljfx description of " (type->string fx-type) " type:\n"
-                         (explain-str explain-data))
-                    explain-data))))
+(defn- ensure-valid-desc [desc fx-type type->lifecycle]
+  (binding [*type->lifecycle* type->lifecycle]
+    (when-let [explain-data (s/explain-data :cljfx/desc (assoc desc :fx/type fx-type))]
+      (throw (ex-info (str "Invalid cljfx description of " (type->string fx-type) " type:\n"
+                           (explain-str explain-data))
+                      explain-data)))))
 
-(defn- wrap-lifecycle [fx-type lifecycle]
-  (reify lifecycle/Lifecycle
-    (create [_ desc opts]
-      (let [stack (conj (::stack opts) fx-type)
-            opts (assoc opts ::stack stack)]
-        (try
-          (ensure-valid-desc desc fx-type)
-          (lifecycle/create lifecycle desc opts)
-          (catch Exception ex (re-throw-with-stack ex stack)))))
-    (advance [_ component desc opts]
-      (let [stack (conj (::stack opts) fx-type)
-            opts (assoc opts ::stack stack)]
-        (try
-          (ensure-valid-desc desc fx-type)
-          (lifecycle/advance lifecycle component desc opts)
-          (catch Exception ex (re-throw-with-stack ex stack)))))
-    (delete [_ component opts]
-      (let [stack (conj (::stack opts) fx-type)
-            opts (assoc opts ::stack stack)]
-        (try
-          (lifecycle/delete lifecycle component opts)
-          (catch Exception ex (re-throw-with-stack ex stack))))
-      (lifecycle/delete lifecycle component opts))))
+(defn- wrap-lifecycle [fx-type type->lifecycle]
+  (let [lifecycle (or (type->lifecycle fx-type) fx-type)]
+    (reify lifecycle/Lifecycle
+      (create [_ desc opts]
+        (let [stack (conj (::stack opts) fx-type)
+              opts (assoc opts ::stack stack)]
+          (try
+            (ensure-valid-desc desc fx-type type->lifecycle)
+            (lifecycle/create lifecycle desc opts)
+            (catch Exception ex (re-throw-with-stack ex stack)))))
+      (advance [_ component desc opts]
+        (let [stack (conj (::stack opts) fx-type)
+              opts (assoc opts ::stack stack)]
+          (try
+            (ensure-valid-desc desc fx-type type->lifecycle)
+            (lifecycle/advance lifecycle component desc opts)
+            (catch Exception ex (re-throw-with-stack ex stack)))))
+      (delete [_ component opts]
+        (let [stack (conj (::stack opts) fx-type)
+              opts (assoc opts ::stack stack)]
+          (try
+            (lifecycle/delete lifecycle component opts)
+            (catch Exception ex (re-throw-with-stack ex stack))))
+        (lifecycle/delete lifecycle component opts)))))