schema->gen.clj

(ns schema->gen
  "Functions for generating test data from schemas."
  (:require [four.stateful :as four]
            [re-rand :refer [re-rand]]
            [schema.core :as sch]
            [simple-check.generators :as gen]))

(defn ^:private re-randify-regex
  "schema requires ^$ while re-rand forbids them"
  [re]
  (let [s (str re)]
    (if (re-matches #"\^.*\$" s)
      (re-pattern (subs s 1 (dec (count s))))
      re)))

(declare schema->gen)

(defn record->gen
  "record should be a map from keys to schemas."
  [record]
  (apply gen/hash-map (mapcat (fn [[k schema]]
                                [k (schema->gen schema)])
                              record)))

(defn schema->gen
  "Oh man here we go!"
  [schema]
  ;; TODO: other kinds of keys, optional keys, etc.

  ;; I'm doing the keyword? check here and elsewhere because I don't
  ;; know of another simple way to distingush regular keys from a
  ;; singular key representing the schema of the keys of a homogeneous
  ;; map
  (cond (= schema sch/Any)
        any-json

        (and (map? schema) (every? keyword? (keys schema)))
        (record->gen schema)

        ;; special casing {Keyword _, ...} because we use it and I'm
        ;; not sure at the moment how to do this more generally
        (and (map? schema)
             (contains? schema sch/Keyword)
             (every? keyword? (keys (dissoc schema sch/Keyword))))
        (gen/fmap (fn [[rec homo-map]] (merge homo-map rec))
                  (gen/tuple
                   (record->gen (dissoc schema sch/Keyword))
                   (gen/map gen/keyword (schema->gen (get schema sch/Keyword)))))


        (= schema sch/Str)
        gen/string-ascii ; bad idea to exclude unicode from tests?

        (instance? java.util.regex.Pattern schema)
        (let [re (re-randify-regex schema)]
          {:gen (fn [r _size]
                  (binding [four/*rand* r]
                    (gen/rose-pure (re-rand re))))})

        :else
        (throw (ex-info "Unknown schema format in schema->gen!"
                        {:schema schema}))))