Skip to content

Instantly share code, notes, and snippets.

@noprompt

noprompt/derive_specs.clj

Created January 15, 2019 17:49
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save noprompt/a275a80b4178b12c1290c503dac0964a to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save noprompt/a275a80b4178b12c1290c503dac0964a to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. noprompt created this gist Jan 15, 2019.
    30 changes: 30 additions & 0 deletions derive_specs.clj
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,30 @@
    (require '[spec-provider.provider :as sp])

    (defn derive-specs [var & args]
    (let [ns-sym (ns-name (:ns (meta var)))
    ns-name (name ns-sym)
    derived-specs (atom [])
    fn-var-info (into [] (keep (fn [[var-sym var]]
    (let [x (deref var)]
    (when (fn? x)
    [var var-sym x]))))
    (ns-interns ns-sym))
    new-defs (into [] (map
    (fn [[var var-sym f]]
    (let [ret-key (keyword (str ns-name "." var-sym) "ret")]
    [var (fn [& args]
    (let [ret (apply f args)]
    (swap! derived-specs
    conj {:name var-sym
    :ret (sp/infer-specs [ret] ret-key)})
    ret))])))
    fn-var-info)]
    (doseq [[var f] new-defs]
    (alter-var-root var (constantly f)))
    (try
    (let [ret (apply (deref var) args)]
    {:derived-specs (deref derived-specs)
    :ret ret})
    (finally
    (doseq [[var _ f] fn-var-info]
    (alter-var-root var (constantly f)))))))