expound

feature-spec-alpha/babashka/impl/spec.clj

@@ -2,11 +2,10 @@
   {:no-doc true}
   (:require [babashka.impl.clojure.spec.alpha :as s :refer [sns]]
             [babashka.impl.clojure.spec.gen.alpha :as gen]
-            [babashka.impl.clojure.spec.test.alpha :as test]
+            [babashka.impl.clojure.spec.test.alpha :as test :refer [tns]]
             [clojure.core :as c]
             [sci.core :as sci :refer [copy-var]]))
 
-(def tns (sci/create-ns 'clojure.spec.test.alpha nil))
 (def gns (sci/create-ns 'clojure.spec.gen.alpha nil))
 
 (defn- ns-qualify
@@ -92,13 +91,20 @@
    'assert* (copy-var s/assert* sns)
    'explain-printer (copy-var s/explain-printer sns)
    ;; PRIVATE, but exposed for expound
-   'maybe-spec (copy-var s/maybe-spec sns)})
+   'maybe-spec (copy-var s/maybe-spec sns)
+   'spec-name (copy-var s/spec-name sns)
+   'explain-data* (copy-var s/explain-data* sns)
+   '->sym (copy-var s/->sym sns)
+   'explain-str (copy-var s/explain-str sns)})
 
 #_:clj-kondo/ignore
 (def test-namespace
   {'instrument (copy-var test/instrument tns)
    'unstrument (copy-var test/unstrument tns)
-   'with-instrument-disabled (copy-var test/with-instrument-disabled tns)})
+   '*instrument-enabled* test/instrument-enabled-var
+   'with-instrument-disabled (copy-var test/with-instrument-disabled tns)
+   'stacktrace-relevant-to-instrument (copy-var test/stacktrace-relevant-to-instrument tns)
+   'spec-checking-fn (copy-var test/spec-checking-fn tns)})
 
 #_:clj-kondo/ignore
 (def gen-namespace

src/babashka/impl/clojure/spec/alpha.clj

@@ -95,7 +95,7 @@
     (instance? clojure.lang.IObj spec)
     (with-meta spec (assoc (meta spec) :clojure.spec.alpha/name name))))
 
-(defn- spec-name [spec]
+(defn spec-name [spec]
   (cond
     (ident? spec) spec
 
@@ -234,27 +234,28 @@
 (defn explain-printer
   "Default printer for explain-data. nil indicates a successful validation."
   [ed]
-  (if ed
+  (binding [*out* sci/out]
-    (let [problems (->> (:clojure.spec.alpha/problems ed)
+    (if ed
-                        (sort-by #(- (count (:in %))))
+      (let [problems (->> (:clojure.spec.alpha/problems ed)
-                        (sort-by #(- (count (:path %)))))]
+                          (sort-by #(- (count (:in %))))
-      ;;(prn {:ed ed})
+                          (sort-by #(- (count (:path %)))))]
-      (doseq [{:keys [path pred val reason via in] :as prob} problems]
+        ;;(prn {:ed ed})
-        (pr val)
+        (doseq [{:keys [path pred val reason via in] :as prob} problems]
-        (print " - failed: ")
+          (pr val)
-        (if reason (print reason) (pr (abbrev pred)))
+          (print " - failed: ")
-        (when-not (empty? in)
+          (if reason (print reason) (pr (abbrev pred)))
-          (print (str " in: " (pr-str in))))
+          (when-not (empty? in)
-        (when-not (empty? path)
+            (print (str " in: " (pr-str in))))
-          (print (str " at: " (pr-str path))))
+          (when-not (empty? path)
-        (when-not (empty? via)
+            (print (str " at: " (pr-str path))))
-          (print (str " spec: " (pr-str (last via)))))
+          (when-not (empty? via)
-        (doseq [[k v] prob]
+            (print (str " spec: " (pr-str (last via)))))
-          (when-not (#{:path :pred :val :reason :via :in} k)
+          (doseq [[k v] prob]
-            (print "\n\t" (pr-str k) " ")
+            (when-not (#{:path :pred :val :reason :via :in} k)
-            (pr v)))
+              (print "\n\t" (pr-str k) " ")
-        (newline)))
+              (pr v)))
-    (println "Success!")))
+          (newline)))
+      (println "Success!"))))
 
 (def sns (sci/create-ns 'clojure.spec.alpha nil))
 
@@ -274,7 +275,7 @@
 (defn explain-str
   "Given a spec and a value that fails to conform, returns an explanation as a string."
   [spec x]
-  (with-out-str (explain spec x)))
+  (sci/with-out-str (explain spec x)))
 
 (declare valid?)
 
@@ -304,7 +305,7 @@
   ([spec] (gen spec nil))
   ([spec overrides] (gensub spec overrides [] {:clojure.spec.alpha/recursion-limit *recursion-limit*} spec)))
 
-(defn- ->sym
+(defn ->sym
   "Returns a symbol from a symbol or var"
   [x]
   (if (var? x)

src/babashka/impl/clojure/spec/test/alpha.clj

@@ -12,7 +12,8 @@
    [babashka.impl.clojure.spec.alpha :as s]
    [babashka.impl.clojure.spec.gen.alpha :as gen]
    [babashka.impl.pprint :as pp]
-   [clojure.string :as str]))
+   [clojure.string :as str]
+   [sci.core :as sci]))
 
 (in-ns 'clojure.spec.test.check)
 (in-ns 'babashka.impl.clojure.spec.test.alpha)
@@ -27,13 +28,13 @@
   (@#'s/->sym x))
 
 #_(defn- ->var
-  [s-or-v]
+    [s-or-v]
-  (if (var? s-or-v)
+    (if (var? s-or-v)
-    s-or-v
+      s-or-v
-    (let [v (and (symbol? s-or-v) (resolve s-or-v))]
+      (let [v (and (symbol? s-or-v) (resolve s-or-v))]
-      (if (var? v)
+        (if (var? v)
-        v
+          v
-        (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
+          (throw (IllegalArgumentException. (str (pr-str s-or-v) " does not name a var")))))))
 
 (defn- collectionize
   [x]
@@ -43,7 +44,7 @@
 
 (defn enumerate-namespace
   "Given a symbol naming an ns, or a collection of such symbols,
-returns the set of all symbols naming vars in those nses."
+  returns the set of all symbols naming vars in those nses."
   [ns-sym-or-syms]
   (into
    #{}
@@ -56,25 +57,29 @@ returns the set of all symbols naming vars in those nses."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; instrument ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private ^:dynamic *instrument-enabled*
+(def tns (sci/create-ns 'clojure.spec.test.alpha))
-  "if false, instrumented fns call straight through"
+
-  true)
+(def instrument-enabled-var (sci/new-dynamic-var '*instrument-enabled* true {:ns tns} ))
+
+#_(def ^:private ^:dynamic *instrument-enabled*
+    "if false, instrumented fns call straight through"
+    true)
 
 #_(defn- fn-spec?
-  "Fn-spec must include at least :args or :ret specs."
+    "Fn-spec must include at least :args or :ret specs."
-  [m]
+    [m]
-  (or (:args m) (:ret m)))
+    (or (:args m) (:ret m)))
 
 (defmacro with-instrument-disabled
   "Disables instrument's checking of calls, within a scope."
   [& body]
-  `(binding [*instrument-enabled* nil]
+  `(binding [clojure.spec.test.alpha/*instrument-enabled* nil]
      ~@body))
 
 (defn- interpret-stack-trace-element
   "Given the vector-of-syms form of a stacktrace element produced
-by e.g. Throwable->map, returns a map form that adds some keys
+  by e.g. Throwable->map, returns a map form that adds some keys
-guessing the original Clojure names. Returns a map with
+  guessing the original Clojure names. Returns a map with
 
   :class         class name symbol from stack trace
   :method        method symbol from stack trace
@@ -83,7 +88,7 @@ guessing the original Clojure names. Returns a map with
   :var-scope     optional Clojure var symbol scoping fn def
   :local-fn      optional local Clojure symbol scoping fn def
 
-For non-Clojure fns, :scope and :local-fn will be absent."
+  For non-Clojure fns, :scope and :local-fn will be absent."
   [[cls method file line]]
   (let [clojure? (contains? '#{invoke invokeStatic} method)
         demunge #(clojure.lang.Compiler/demunge %)
@@ -100,11 +105,11 @@ For non-Clojure fns, :scope and :local-fn will be absent."
            (when local
              {:local-fn (symbol (degensym local))}))))
 
-(defn- stacktrace-relevant-to-instrument
+(defn stacktrace-relevant-to-instrument
   "Takes a coll of stack trace elements (as returned by
-StackTraceElement->vec) and returns a coll of maps as per
+  StackTraceElement->vec) and returns a coll of maps as per
-interpret-stack-trace-element that are relevant to a
+  interpret-stack-trace-element that are relevant to a
-failure in instrument."
+  failure in instrument."
   [elems]
   (let [plumbing? (fn [{:keys [var-scope]}]
                     (contains? '#{clojure.spec.test.alpha/spec-checking-fn} var-scope))]
@@ -114,7 +119,7 @@ failure in instrument."
                     (drop-while plumbing?))
               elems)))
 
-(defn- spec-checking-fn
+(defn spec-checking-fn
   [v f fn-spec]
   (let [fn-spec (@#'s/maybe-spec fn-spec)
         conform! (fn [v role spec data args]
@@ -124,9 +129,9 @@ failure in instrument."
                                          stacktrace-relevant-to-instrument
                                          first)
                              ed (merge (assoc (s/explain-data* spec [] [] [] data)
-                                         ::s/fn (->sym v)
+                                              ::s/fn (->sym v)
-                                         ::s/args args
+                                              ::s/args args
-                                         ::s/failure :instrument)
+                                              ::s/failure :instrument)
                                        (when caller
                                          {::caller (dissoc caller :class :method)}))]
                          (throw (ex-info
@@ -134,13 +139,13 @@ failure in instrument."
                                  ed)))
                        conformed)))]
     (fn
-     [& args]
+      [& args]
-     (if *instrument-enabled*
+      (if @instrument-enabled-var
-       (with-instrument-disabled
+        (sci/binding [@instrument-enabled-var false]
-         (when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
+          (when (:args fn-spec) (conform! v :args (:args fn-spec) args args))
-         (binding [*instrument-enabled* true]
+          (sci/binding [@instrument-enabled-var true]
-           (.applyTo ^clojure.lang.IFn f args)))
+            (.applyTo ^clojure.lang.IFn f args)))
-       (.applyTo ^clojure.lang.IFn f args)))))
+        (.applyTo ^clojure.lang.IFn f args)))))
 
 (defn- no-fspec
   [v spec]
@@ -191,9 +196,9 @@ failure in instrument."
           (->sym v))))))
 
 #_(defn- opt-syms
-  "Returns set of symbols referenced by 'instrument' opts map"
+    "Returns set of symbols referenced by 'instrument' opts map"
-  [opts]
+    [opts]
-  (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
+    (reduce into #{} [(:stub opts) (keys (:replace opts)) (keys (:spec opts))]))
 
 (defn- fn-spec-name?
   [s]
@@ -206,11 +211,11 @@ failure in instrument."
 that can be instrumented."
   ([] (instrumentable-syms nil))
   ([opts]
-     (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
+   (assert (every? ident? (keys (:gen opts))) "instrument :gen expects ident keys")
-     (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
+   (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
-                       (keys (:spec opts))
+                     (keys (:spec opts))
-                       (:stub opts)
+                     (:stub opts)
-                       (keys (:replace opts))])))
+                     (keys (:replace opts))])))
 
 (defn instrument
   "Instruments the vars named by sym-or-syms, a symbol or collection
@@ -252,14 +257,14 @@ Returns a collection of syms naming the vars instrumented."
   ([] (instrument (instrumentable-syms)))
   ([sym-or-syms] (instrument sym-or-syms nil))
   ([sym-or-syms opts]
-     (locking instrumented-vars
+   (locking instrumented-vars
-       (into
+     (into
-        []
+      []
-        (comp (filter (instrumentable-syms opts))
+      (comp (filter (instrumentable-syms opts))
-              (distinct)
+            (distinct)
-              (map #(instrument-1 % opts))
+            (map #(instrument-1 % opts))
-              (remove nil?))
+            (remove nil?))
-        (collectionize sym-or-syms)))))
+      (collectionize sym-or-syms)))))
 
 (defn unstrument
   "Undoes instrument on the vars named by sym-or-syms, specified
@@ -267,13 +272,13 @@ as in instrument. With no args, unstruments all instrumented vars.
 Returns a collection of syms naming the vars unstrumented."
   ([] (unstrument (map ->sym (keys @instrumented-vars))))
   ([sym-or-syms]
-     (locking instrumented-vars
+   (locking instrumented-vars
-       (into
+     (into
-        []
+      []
-        (comp (filter symbol?)
+      (comp (filter symbol?)
-              (map unstrument-1)
+            (map unstrument-1)
-              (remove nil?))
+            (remove nil?))
-        (collectionize sym-or-syms)))))
+      (collectionize sym-or-syms)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; testing  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -283,9 +288,9 @@ Returns a collection of syms naming the vars unstrumented."
    "Specification-based check failed"
    (when-not (s/valid? spec v nil)
      (assoc (s/explain-data* spec [role] [] [] v)
-       ::args args
+            ::args args
-       ::val v
+            ::val v
-       ::s/failure :check-failed))))
+            ::s/failure :check-failed))))
 
 (defn- check-call
   "Returns true if call passes specs, otherwise *returns* an exception
@@ -331,20 +336,20 @@ with explain-data + ::s/failure."
         f (or f (when v @v))
         specd (s/spec spec)]
     (try
-     (cond
+      (cond
-      (or (nil? f) (some-> v meta :macro))
+        (or (nil? f) (some-> v meta :macro))
-      {:failure (ex-info "No fn to spec" {::s/failure :no-fn})
+        {:failure (ex-info "No fn to spec" {::s/failure :no-fn})
-       :sym s :spec spec}
+         :sym s :spec spec}
-    
+
-      (:args specd)
+        (:args specd)
-      (let [tcret (quick-check f specd opts)]
+        (let [tcret (quick-check f specd opts)]
-        (make-check-result s spec tcret))
+          (make-check-result s spec tcret))
-    
+
-      :default
+        :default
-      {:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
+        {:failure (ex-info "No :args spec" {::s/failure :no-args-spec})
-       :sym s :spec spec})
+         :sym s :spec spec})
-     (finally
+      (finally
-      (when re-inst? (instrument s))))))
+        (when re-inst? (instrument s))))))
 
 (defn- sym->check-map
   [s]
@@ -363,17 +368,17 @@ with explain-data + ::s/failure."
 'check' for options and return."
   ([f spec] (check-fn f spec nil))
   ([f spec opts]
-     (validate-check-opts opts)
+   (validate-check-opts opts)
-     (check-1 {:f f :spec spec} opts)))
+   (check-1 {:f f :spec spec} opts)))
 
 (defn checkable-syms
   "Given an opts map as per check, returns the set of syms that
 can be checked."
   ([] (checkable-syms nil))
   ([opts]
-     (validate-check-opts opts)
+   (validate-check-opts opts)
-     (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
+   (reduce into #{} [(filter fn-spec-name? (keys (s/registry)))
-                       (keys (:spec opts))])))
+                     (keys (:spec opts))])))
 
 (defn check
   "Run generative tests for spec conformance on vars named by
@@ -381,7 +386,7 @@ sym-or-syms, a symbol or collection of symbols. If sym-or-syms
 is not specified, check all checkable vars.
 
 The opts map includes the following optional keys, where stc
-aliases clojure.spec.test.check: 
+aliases clojure.spec.test.check:
 
 ::stc/opts  opts to flow through test.check/quick-check
 :gen        map from spec names to generator overrides
@@ -411,10 +416,10 @@ spec itself will have an ::s/failure value in ex-data:
   ([] (check (checkable-syms)))
   ([sym-or-syms] (check sym-or-syms nil))
   ([sym-or-syms opts]
-     (->> (collectionize sym-or-syms)
+   (->> (collectionize sym-or-syms)
-          (filter (checkable-syms opts))
+        (filter (checkable-syms opts))
-          (pmap
+        (pmap
-           #(check-1 (sym->check-map %) opts)))))
+         #(check-1 (sym->check-map %) opts)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; check reporting  ;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -437,9 +442,9 @@ spec itself will have an ::s/failure value in ex-data:
   [ret]
   (let [failure (:failure ret)]
     (cond
-     (nil? failure) :check-passed
+      (nil? failure) :check-passed
-     (failure-type failure) (failure-type failure)
+      (failure-type failure) (failure-type failure)
-     :default :check-threw)))
+      :default :check-threw)))
 
 (defn abbrev-result
   "Given a check result, returns an abbreviated version
@@ -459,13 +464,11 @@ Returns a map with :total, the total number of results, plus a
 key with a count for each different :type of result."
   ([check-results] (summarize-results check-results abbrev-result))
   ([check-results summary-result]
-     (reduce
+   (reduce
-      (fn [summary result]
+    (fn [summary result]
-        (pp/pprint (summary-result result))
+      (pp/pprint (summary-result result))
-        (-> summary
+      (-> summary
-            (update :total inc)
+          (update :total inc)
-            (update (result-type result) (fnil inc 0))))
+          (update (result-type result) (fnil inc 0))))
-      {:total 0}
+    {:total 0}
-       check-results)))
+    check-results)))
-
-