Adds some specs to dogfood instrumentation. Added orchestra

dev/user.clj

@@ -0,0 +1,11 @@
+(ns user
+  (:require [clojure.spec.alpha :as s]
+            [orchestra.spec.test :as st]
+            [expound.alpha :as expound]))
+
+(defn setup []
+  (set! s/*explain-out* expound/printer)
+  (st/instrument))
+
+(comment
+  (setup))

project.clj

@@ -74,7 +74,8 @@
              }
   :profiles {:dev {:dependencies [[binaryage/devtools "0.9.2"]
                                   [figwheel-sidecar "0.5.10"]
-                                  [com.cemerick/piggieback "0.2.1"]]
+                                  [com.cemerick/piggieback "0.2.1"]
+                                  [orchestra "2017.07.04-1"]]
                    ;; need to add dev source path here to get user.clj loaded
                    :source-paths ["src" "dev"]
                    ;; for CIDER

src/expound/alpha.cljc

@@ -13,6 +13,19 @@
 ;;;;;; specs   ;;;;;;
 
 (s/def ::singleton (s/coll-of any? :count 1))
+(s/def ::path vector?)
+
+;;;;;; types ;;;;;;
+
+(defrecord KeyPathSegment [key])
+
+(defrecord KeyValuePathSegment [idx])
+
+(defn kps? [x]
+  (instance? KeyPathSegment x))
+
+(defn kvps? [x]
+  (instance? KeyValuePathSegment x))
 
 ;;;;;; private ;;;;;;
 
@@ -31,11 +44,17 @@
      (apply goog.string/format fmt args))
    :clj (def format clojure.core/format))
 
+(s/fdef pprint-str
+        :args (s/cat :x any?)
+        :ret string?)
 (defn pprint-str
   "Returns the pretty-printed string"
   [x]
   (pprint/write x :stream nil))
 
+(s/fdef no-trailing-whitespace
+        :args (s/cat :s string?)
+        :ret string?)
 (defn no-trailing-whitespace
   "Given an potentially multi-line string, returns that string with all
   trailing whitespace removed."
@@ -45,6 +64,12 @@
        (map string/trimr)
        (string/join "\n")))
 
+(s/fdef indent
+        :args (s/cat
+               :first-line-indent-level (s/? nat-int?)
+               :indent-level (s/? nat-int?)
+               :s string?)
+        :ret string?)
 (defn indent
   "Given an potentially multi-line string, returns that string indented by
    'indent-level' spaces. Optionally, can indent first line and other lines
@@ -59,23 +84,18 @@
                   (into [(str (apply str (repeat first-line-indent " ")) line)]
                         (map #(str (apply str (repeat rest-lines-indent " ")) %) lines))))))
 
+(s/fdef prefix-path?
+        :args (s/cat
+               :partial-path ::path
+               :partial-path ::path)
+        :ret boolean?)
 (defn prefix-path?
   "True if partial-path is a prefix of full-path."
   [partial-path full-path]
   (and (< (count partial-path) (count full-path))
        (= partial-path
           (subvec full-path 0 (count partial-path)))))
 
-(defrecord KeyPathSegment [key])
-
-(defrecord KeyValuePathSegment [idx])
-
-(defn kps? [x]
-  (instance? KeyPathSegment x))
-
-(defn kvps? [x]
-  (instance? KeyValuePathSegment x))
-
 (def mapv-indexed (comp vec map-indexed))
 
 (defn walk-with-path
@@ -101,17 +121,23 @@
   ([f path form]
    (walk-with-path (partial postwalk-with-path f) f path form)))
 
+(s/fdef kps-path?
+        :args (s/cat :x any?)
+        :ret boolean?)
 (defn kps-path?
   "True if path points to a key"
   [x]
-  (and (vector? x)
-       (kps? (last x))))
+  (boolean (and (vector? x)
+                (kps? (last x)))))
 
+(s/fdef kvps-path?
+        :args (s/cat :x any?)
+        :ret boolean?)
 (defn kvps-path?
   "True if path points to a key/value pair"
   [x]
-  (and (vector? x)
-       (some kvps? x)))
+  (boolean (and (vector? x)
+                 (some kvps? x))))
 
 (defn summary-form
   "Given a form and a path to highlight, returns a data structure that marks
@@ -534,9 +560,11 @@ should satisfy
   (print
    (if-not explain-data
      "Success!\n"
-     (let [{:keys [::s/problems ::s/value ::s/args ::s/failure :clojure.spec.test.alpha/caller]} explain-data
+     (let [{:keys [::s/problems ::s/value ::s/args ::s/ret ::s/failure :clojure.spec.test.alpha/caller]} explain-data
            form (if (= :instrument failure)
-                  args
+                  (if (contains? explain-data ::s/ret)
+                    ret
+                    args)
                   value)
            _ (doseq [problem problems]
                (s/assert (s/nilable #{"Insufficient input" "Extra input" "no method"}) (:reason problem)))

test/expound/alpha_test.cljc

@@ -8,7 +8,9 @@
             [expound.test-utils :as test-utils]
             [clojure.string :as string]))
 
-(use-fixtures :once test-utils/check-spec-assertions)
+(use-fixtures :once
+  test-utils/check-spec-assertions
+  test-utils/instrument-all)
 
 (def any-printable-wo-nan (gen/such-that (complement test-utils/contains-nan?) gen/any-printable))
 

test/expound/test_utils.cljc

@@ -1,5 +1,12 @@
 (ns expound.test-utils
   (:require [clojure.spec.alpha :as s]
+            #?(:cljs
+               [clojure.spec.test.alpha :as st]
+               ;; orchestra is supposed to work with cljs but
+               ;; it isn't working for me right now
+               #_[orchestra-cljs.spec.test :as st]
+               :clj [orchestra.spec.test :as st])
+            [expound.alpha :as expound]
             [clojure.test :as ct]
             [com.gfredericks.test.chuck.clojure-test :as chuck]))
 
@@ -17,6 +24,12 @@
   (test-fn)
   (s/check-asserts false))
 
+(defn instrument-all [test-fn]
+  (set! s/*explain-out* expound/printer)
+  (st/instrument)
+  (test-fn)
+  (st/unstrument))
+
 (defn nan? [x]
   #?(:clj false
      :cljs (and (number? x) (js/isNaN x))))