generative-schema.clj

generative-schema.clj

(ns generative-checking.schema
  (:use plumbing.core)
  (:require
   [schema.core :as s]
   [clojure.pprint :as pprint]
   [clojure.test.check.generators :as gen]))

(defn g-by [f & args]
  (gen/fmap
   (partial apply f)
   (apply gen/tuple args)))

(defn g-apply-by [f args]
  (gen/fmap f (apply gen/tuple args)))

(defn g-or [& args]
  (gen/one-of args))

(defprotocol Generatable
  (generate [x] "return a generator for x"))

(extend-type Object
  Generatable
  (generate [x]
    (cond
     (= x s/Int) gen/int
     (= x s/Bool) gen/boolean
     (= x Boolean) gen/boolean
     (= x String) gen/string-ascii
     (= x s/Keyword) gen/keyword
     :else (gen/return x))))

(extend-type schema.core.Either
  Generatable
  (generate [x]
    (gen/one-of (map generate (:schemas x)))))

(extend-type schema.core.One
  Generatable
  (generate [x]
    (generate (:schema x))))

(extend-type clojure.lang.APersistentVector
  Generatable
  (generate [x]
    (let [[ones [repeated]] (split-with #(instance? schema.core.One %) x)
          [required optional] (split-with (comp not :optional?) ones)]

      (g-by
       concat
       (g-or
        (apply gen/tuple (map generate required))
        (apply gen/tuple (map generate (concat required optional))))
       (if repeated
         (gen/vector (generate repeated))
         (gen/return []))))))

(extend-type schema.core.RequiredKey
  Generatable
  (generate [x]
    (gen/return (:k x))))

(extend-type schema.core.OptionalKey
  Generatable
  (generate [x]
    (gen/return (:k x))))

(defn optional-entry [[k v]]
  (g-or
   (gen/return {})
   (g-by hash-map (generate k) (generate v))))

(extend-type clojure.lang.APersistentMap
  Generatable
  (generate [x]

    (let [[required other] (split-with
                            (fn [[k v]]
                              (or (keyword? k)
                                  (instance? schema.core.RequiredKey k))) x)

          [optional [repeated]] (split-with
                                 (fn [[k v]] (instance? schema.core.OptionalKey k)) other)]

      (g-by
       merge
       (g-apply-by (partial into {}) (map optional-entry optional))
       (if repeated
         (->> repeated (map generate) (apply gen/map))
         (gen/return {}))
       (g-apply-by
        (partial into {})
        (for [entry required]
          (apply gen/tuple (map generate entry))))))))



(doseq [schm [{:x s/Int
               (s/optional-key "hi") s/Bool
               s/Keyword s/Bool}
              [(s/one s/Bool "first") (s/optional s/Keyword "maybe") s/Int]]]

  (println "\n\n=== SCHEMA ===")
  (pprint/pprint (s/explain schm))
  (println "== Samples ==")

  (-> schm generate gen/sample pprint/pprint))




;; === SCHEMA ===
;; {:x Int,
;;  (optional-key "hi") java.lang.Boolean,
;;  Keyword java.lang.Boolean}
;; == Samples ==
;; ({:x 0}
;;  {:x 1, :FP false}
;;  {:x -2, :8j true, :5J false, "hi" true}
;;  {:x -2}
;;  {:x -3, :npv false, :937 true, :GtNL false}
;;  {:x 1, :RD1P false, :1yjJ7 false, :MvJJB false, "hi" true}
;;  {:x -5, :G0z6Q5 false, :Y9XT true, :YJ false, "hi" true}
;;  {:x 4, "hi" false}
;;  {:x -5,
;;   :3tTmb3H false,
;;   :Ms59j false,
;;   :7g5 true,
;;   :pGu69 true,
;;   :1J false,
;;   :GF27V16 false,
;;   "hi" false}
;;  {:x 1,
;;   :IK true,
;;   :V87X4F3mY false,
;;   :uX false,
;;   :mqOcoU false,
;;   :559khUj5 false,
;;   :UXE2 false,
;;   :Wu9b95x2 false})


;; === SCHEMA ===
;; [(one java.lang.Boolean "first") (optional Keyword "maybe") Int]
;; == Samples ==
;; ((true :D)
;;  (true)
;;  (false :g -2 0)
;;  (true :orkp9a 1 1)
;;  (true :B7f 4)
;;  (true -4)
;;  (true :5 0)
;;  (false :I6jDb1 0 -2 -6 1 6)
;;  (true :96wv3999 -1 4)
;;  (false :08RF5t -7 -6 -5 2))