Experiment in using a pull spec query to generate clojure.spec definitions

gen-spec-from-pull-query.clj

(ns pmr.specs
  (:require [clojure.string :as string]
            [clojure.spec :as s]))

(s/def ::pattern (s/or :one (s/coll-of ::attr-spec :kind set? :min-count 1)
                       :many (s/coll-of ::attr-spec :kind vector? :min-count 1)))
(s/def ::attr-spec (s/or :wildcard ::wildcard
                         :attr-name ::attr-name
                         :map-spec ::map-spec))
(s/def ::wildcard #{"*"})
(s/def ::attr-name string?)
(s/def ::map-spec (s/map-of ::attr-name ::pattern :count 1))

(defn singularize [plural]
  (condp re-find plural
    #"ies$" (string/replace plural #"ies$" "y")
    #"IES$" (string/replace plural #"IES$" "Y")
    #"(s|z|ch|sh|x)es$" (string/replace plural #"(s|z|ch|sh|x)es$" "$1")
    #"(S|Z|CH|SH|X)ES$" (string/replace plural #"(S|Z|CH|SH|X)ES$" "$1")
    #"s$" (string/replace plural #"s$" "")
    #"S$" (string/replace plural #"S$" "")
    plural))

(defn attr-spec->keyword
  [spec-name [attr-key attr-data]]
  (let [parent-name-singular (singularize (name spec-name))
        parent-namespace (namespace spec-name)]
    (case attr-key
      :wildcard (keyword parent-name-singular attr-data)
      :attr-name (keyword parent-name-singular attr-data)
      :map-spec (keyword
                  (str parent-namespace "." parent-name-singular)
                  (key (first attr-data))))))

(defn pattern->spec
  [spec-name [pattern-key attr-specs]]
  (let [{:keys [wildcard map-spec attr-name]} (group-by first attr-specs)
        wildcard (first wildcard)
        map-attr-forms (mapcat
                         (fn [[_ map-spec :as attr-spec]]
                           (let [key (attr-spec->keyword spec-name attr-spec)
                                 val (first (vals map-spec))]
                             (pattern->spec key val)))
                         map-spec)
        map-keywords (map #(attr-spec->keyword spec-name %) map-spec)
        attr-keywords (map #(attr-spec->keyword spec-name %) attr-name)
        pattern-form `(s/keys :req-un [~@attr-keywords ~@map-keywords])
        pattern-form (if wildcard
                       `(s/merge ~(attr-spec->keyword spec-name wildcard) ~pattern-form)
                       pattern-form)
        pattern-form (if (= :many pattern-key)
                       `(s/coll-of ~pattern-form)
                       pattern-form)]
    (conj (vec map-attr-forms)
          `(s/def ~spec-name ~pattern-form))))

(defmacro sym->keyword [sym]
  `(keyword (name (ns-name *ns*)) (name ~sym)))

(defmacro defpull
  "as (def sym pull-spec) but also generates a matching spec
   in ::name."
  [sym pull-spec]
  (s/assert ::pattern pull-spec)
  `(do (def ~sym ~pull-spec)
       ~@(pattern->spec
           (sym->keyword sym)
           (s/conform ::pattern #{pull-spec}))))

(comment
  (defpull project-summary-spec
    {"PROJ_PROJECT"
     #{"*"
       {"PROJ_PROGRAM" #{"*"}}
       {"PROJ_CATEGORY" #{"*"}}
       {"PROJ_STAGE" #{"*"}}
       {"PROJ_TYPE" #{"*"}}
       {"LatestPlan" #{"*"}}
       {"LatestApprovedPlan" #{"*"}}
       {"PROJ_PROJECT_TIMINGs"
        ["*"
         {"PROJ_TIMING_TYPE" #{"*"}}]}
       {"PROJ_PROJECT_CONTACTs"
        ["*"
         {"PROJ_CONTACT" ["*" {"PROJ_COMPANY" #{"*"}}]}
         {"PROJ_ROLE" #{"*"}}]}}}))