Macro for defining instrumented functions which verify their arguments and return values against specs.

strum.clj

(ns strum.core
  (:refer-clojure :exclude [defn])
  (:require
   [clojure.spec :as spec]
   [clojure.spec.test :as spec.test]))

;; ---------------------------------------------------------------------
;; Prelude

;; HACK: Currently, as of Clojure 1.9.0-alpha14, there is a bug with
;; conforming the spec `:clojure.core.specs/binding-form` where the
;; cases `{}` and `{:as x}` are parsed incorrectly as a
;; `:clojure.core.specs/seq-binding-form`.
;;
;; SEE:
;;
;;  * http://dev.clojure.org/jira/browse/CLJ-2055
;;  * http://dev.clojure.org/jira/secure/attachment/16084/CLJ-2055-01.patch
;;
;; Redefine `:clojure.core.specs/seq-binding-form` to constrain it to
;; vectors only.
(spec/def :clojure.core.specs/seq-binding-form
  (spec/and vector?
            (spec/cat :elems
                      (spec/* :clojure.core.specs/binding-form)

                      :rest
                      (spec/? (spec/cat :amp #{'&}
                                        :form :clojure.core.specs/binding-form))
                      :as
                      (spec/? (spec/cat :as #{:as}
                                        :sym :clojure.core.specs/local-name)))))

;; Redefine `:clojure.core.specs/binding-form` to reflect changes.
(spec/def :clojure.core.specs/binding-form
  (spec/or :sym :clojure.core.specs/local-name
           :seq :clojure.core.specs/seq-binding-form
           :map :clojure.core.specs/map-binding-form))

(clojure.core/defn qualify
  "Given a keyword or symbol, `named`, qualify it with respect to
  `*ns*` unless it is already qualified."
  [named]
  (if (namespace named)
    named
    ((if (symbol? named)
       symbol
       keyword)
     (str (ns-name *ns*))
     (name named))))

(clojure.core/defn spec-key
  "Given a keyword or symbol, `named`, convert it to a fully qualified
  keyword."
  [named]
  (keyword (qualify named)))

(clojure.core/defn find-spec
  "Given a keyword or symbol, `named`, qualify it and look it up in
  the spec registry."
  [named]
  (find (spec/registry) (spec-key named)))


;; ---------------------------------------------------------------------
;; Converting bindings into spec keys

(defmulti
  ^{:arglists '([[tag data]])
    :private true}
  emit-binding-key
  "Given value as produced by conforming
  `:clojure.core.spec/binding-form`, return a keyword for use in keyed
  specs such as `cat`, `alt`, etc."
  #'first)

(defmethod emit-binding-key :sym [[_ sym]]
  (keyword sym))

(defmethod emit-binding-key :seq [[_ {:keys [as]}]]
  (keyword (or (:sym as) (gensym "sequential_"))))

(defmethod emit-binding-key :map [[_ {:keys [as]}]]
  (keyword (or as (gensym "map_"))))


;; ---------------------------------------------------------------------
;; Converting bindings into specs


(defmulti
  ^{:arglists '([[tag data]])}
  emit-binding-spec
  "Given value as produced by conforming
  `:clojure.core.spec/binding-form`, return a spec for use in `fdef`."
  #'first)

;; ---------------------------------------------------------------------
;; Symbol binding emision
;;
;; Binding form:
;;
;;   x
;;
;; Conform value:
;;
;;   [:sym x]
;;
;; Example specs:
;;
;;   ::x
;;
;;   any?


(defmethod emit-binding-spec :sym [[_ sym]]
  (if-let [[spec-key] (find-spec sym)]
    spec-key
    `any?))


;; ---------------------------------------------------------------------
;; Vector binding emision
;;
;; Binding form:
;;
;;   [x :as xs]
;;
;; Conform value: 
;;
;;   [:seq {:elems [[:sym x₀],,,[:sym xₙ], :as {:as :as, :sym xs}}]
;;
;; Example specs:
;;
;;   ::xs
;;
;;   (spec/and sequential? (spec/cat :x ::x))
;;
;;   sequential?

(defmethod emit-binding-spec :seq [[_ {:keys [as elems rest]}]]
  ;; TODO: Handle `:rest` values i.e. `{:amp &, :form [:sym zs]}`.
  (if-let [[spec-key] (and (:sym as)
                           (find-spec (:sym as)))]
    spec-key
    (if elems
      `(spec/and sequential?
                 (spec/cat ~@(mapcat
                              (juxt emit-binding-key
                                    emit-binding-spec)
                              elems)))
      `sequential?)))

;; ---------------------------------------------------------------------
;; Map binding emision
;;
;; Binding form:
;;  
;;   {b₀ :b₀ :keys [x₀] :syms [x₁] :strs [x₂] :as m}
;;
;; Conform value: 
;;
;;   [:map {b₀ :b₀, :keys [x₀], :syms [x₁], :strs [x₂], :as m}]
;;
;; Example specs: 
;;
;;   ::m
;;
;;   (spec/and map? (spec/keys :req-un [::b₀ ::x₀])
;;                  (spec/and #(contains? % "x₂"))
;;                  (spec/and #(contains? % 'x₁))) 


(clojure.core/defn emit-keys-spec
  "Find all of the symbols (or keywords) which are either members of
  the `:keys` field of `m` or represent a symbol binding for a key in
  `m`. `{:keys [sym₀ sym₁,,,] symₙ :keyₘ}`"
  [m]
  (let [keys (reduce-kv
              (fn [keys k v]
                (cond-> keys
                  (keyword? v)
                  (conj v)))
              (into #{} (:keys m))
              (dissoc m :as :keys))]
    `(spec/keys
      :req [~@(filter namespace keys)]
      :req-un [~@(map (comp qualify keyword)
                      (remove namespace keys))])))

(clojure.core/defn emit-syms-spec
  "Find all of the symbols which are either members of the `:syms`
  field of `m` or represent a symbol binding for a symbol in
  `m`. `{:syms [sym₀ sym₁,,,] symₙ :symₘ}`"
  [m]
  (let [syms (reduce-kv
              (fn [keys k v]
                (cond-> keys
                  (symbol? v)
                  (conj v)))
              (into #{} (:syms m))
              (dissoc m :as :syms))
        msym (:as m 'm)]
    `(spec/and ~@(for [sym syms]
                   `(fn [~msym]
                      (contains? ~msym '~sym))))))

(clojure.core/defn emit-strs-spec
  "Find all of the symbols which are either members of the `:syms`
  field of `m` or represent a symbol binding for a string in
  `m`. `{:strs [sym₀ sym₁,,,] symₙ \"strₙ\"}`"
  [m]
  (let [strs (reduce-kv
              (fn [keys k v]
                (cond-> keys
                  (string? v)
                  (conj v)))
              (into #{} (:strs m))
              (dissoc m :as :strs))
        msym (:as m 'm)]
    `(spec/and ~@(for [str strs]
                   `(fn [~msym]
                      (contains? ~msym ~str))))))

(defmethod emit-binding-spec :map [[_ {:keys [as] :as m}]]
  (if-let [[spec-key] (and as (find-spec as))]
    spec-key
    `(spec/and ~(emit-keys-spec m)
               ~(emit-syms-spec m)
               ~(emit-strs-spec m))))

;; ---------------------------------------------------------------------
;; fdef emission

(clojure.core/defn conform-binding-form [binding-form]
  (spec/conform :clojure.core.specs/binding-form
                binding-form))

(clojure.core/defn emit-args-spec
  {:arglists '([args-data])}
  [{:keys [args varargs]}]
  `(spec/cat ~@(mapcat
                (juxt emit-binding-key emit-binding-spec)
                args)
             ~@(when-let [{:keys [form]} varargs]
                 `(~(emit-binding-key form)
                   (spec/* ~(emit-binding-spec form))))))

(clojure.core/defn emit-args-arity-key
  {:arglists '([args-data])}
  [{:keys [args varargs]}]
  (if varargs
    :arity-n
    (keyword (str "arity-" (count args)))))

(clojure.core/defn emit-arity-n-spec [bodies-data]
  `(spec/alt 
    ~@(mapcat
       (fn [body]
         `(~(emit-args-arity-key (:args body))
           ~(emit-args-spec (:args body))))
       bodies-data)))

(clojure.core/defn emit-fdef
  {:arglists '([defn-data])}
  ;; `:bs` is autological.
  [{[tag data] :bs :keys [name]}]
  `(do
     ;; Define a spec for ::name if hasn't been defined.
     ~(when-not (find-spec name)
        `(spec/def ~(spec-key name) any?))

     (spec/fdef ~name
       :args ~(case tag
                :arity-1 (emit-args-spec (:args data))
                :arity-n (emit-arity-n-spec (:bodies data)))
       :ret ~(spec-key name))))

;; ---------------------------------------------------------------------
;; defn emission

(clojure.core/defn emit-defn [defn-args]
  (let [[_ name fn-form] (macroexpand-1 (cons 'clojure.core/defn defn-args))
        [_ & fn-specs] fn-form]
    `(def ~name
       (fn 
         ~@(for [[arglist & fn-body] fn-specs]
             (let [x (first fn-body)
                   pre-post-map (when (and (map? x)
                                           (or (contains? x :pre)
                                               (contains? x :post)))
                                  x)
                   fn-body (if pre-post-map
                             (rest fn-body)
                             fn-body)]
               `(~arglist
                 ~pre-post-map
                 (let [ret# (do ~@fn-body)]
                   (spec/assert ~(keyword (qualify name))
                                ret#)))))))))

(defmacro defn [& defn-args]
  (let [defn-data (spec/conform
                   :clojure.core.specs/defn-args
                   defn-args)]
    `(let [var# ~(emit-defn defn-args)]
       ~(emit-fdef defn-data)
       (spec.test/instrument '~(qualify (:name defn-data)))
       var#)))


(comment
  ;; Let's start by defining a simple increment function. In practice we
  ;; expect this function to take a number and return a number,
  ;; naturally.
  (defn inc [n]
    (+ 1 n))

  ;; We'll call it with the argument "foo".
  (inc "foo")
  ;; Which will result in the following error:
  ;;
  ;;   java.lang.String cannot be cast to java.lang.Number
  ;;
  ;; Not fun.

  ;; Let's specify what `n` should be by defining a spec for it, `::n`.
  (spec/def ::n number?)


  ;; And redefine our function.
  (defn inc [n]
    (+ 1 n))

  ;; Let's try passing it the "foo" argument again.
  (inc "foo")

  ;; And watch it fail with the following error:
  ;;
  ;;   Call to #'strum.core/inc did not conform to spec: In: [0] val:
  ;;   "foo" fails spec: :strum.core/n at: [:args :n] predicate: number?
  ;;
  ;; Nice. So now we're catching the incorrect argument at the time the
  ;; function is called which prevents us from propagating it to
  ;; subsequent calls and getting, potentially, useless error messages.

  ;; But what if we change the return value?
  (defn inc [n]
    "foo")

  (inc 5)
  ;; => "foo"

  ;; Hmm. That's not quite right. Remember, in practice what we want is
  ;; for `inc` to take a number and return a number. (We've deliberately
  ;; changed the function to return "foo" to set up the next example.)
  ;;
  ;; Let's define a spec for `inc` — `::inc`.
  (spec/def ::inc number?)

  ;; And try calling it again.

  (inc 5)

  ;; This time we get an error.
  ;;
  ;;   Spec assertion failed val: "foo" fails predicate: number?
  ;;   :clojure.spec/failure :assertion-failed
  ;;
  ;; Now our function is failing to meet the spec for the return
  ;; value of `inc` described by `::inc`. So let's fix that.
  (defn inc [n]
    (+ 1 n))

  ;; And call it one more time.
  (inc 10)
  ;; => 11
  )