devcards-with-gen-data.cljc

(ns labs.demo
  (:require [clojure.spec :as s]
            [clojure.test.check.generators :as generators]
            [clojure.test.check.random :as random]
            [clojure.test.check.rose-tree :as rose-tree]
            [sablono.core :as sab :include-macros true]))

(defonce demo-db (atom {:seed 1 :size 5 :overrides {}}))

(defn add-override [k v]
  (swap! demo-db assoc-in [:overrides k] v))

(defn sample-gen
  [gen seed size]
  (let [rnd (random/make-random seed)]
    (rose-tree/root (generators/call-gen gen rnd size))))

(defn sample-fn*
  "Call a function with generated args.
   Use seed, size and overrides to control data generation."
  [f fspec {:keys [seed size overrides]}]
  (let [seed (or seed 1)
        size (or size 1)
        args (sample-gen (clojure.spec/gen (:args fspec) overrides) seed size)]
    [args (apply f args)]))

(defn sample-fn
  "Return a function which uses sample-fn* to call f-var with test data.
   Use seed, size and overrides to control data generation."
  [f-var]
  (fn [opts]
    (let [f (deref f-var)
          {f-ns :ns f-name :name} (meta f-var)
          f-sym (symbol f-ns f-name)
          fspec (clojure.spec/get-spec f-sym)]
      (assert fspec (str "No spec defined for " f-sym))
      (sample-fn* f fspec opts))))

(defmacro card
  [sym]
  `(let [f# (sample-fn (var ~sym))]
     (fn [app-db#]
       (second (f# @app-db#)))))

(defmacro example-card
  [sym & expr]
  `(devcards.core/defcard ~sym
     (card ~sym)
     demo-db
     ~@expr))


#?(:cljs
   (defn demo-controls [sample-fn]
     (fn [app-db]
       (let [{:keys [seed size overrides]} @app-db
             overrides (merge (:overrides @demo-db) overrides)
             [args ret] (sample-fn {:seed seed :size size :overrides overrides})
             next-seed #(swap! app-db update :seed inc)
             prev-seed #(swap! app-db update :seed dec)
             change-size #(swap! app-db assoc :size %)]
         (sab/html
           [:div
            [:div
             [:button {:on-click next-seed} "<"]
             [:button {:on-click prev-seed} ">"]
             [:span [:input {:type      "range" :min 0 :max 100 :value size
                             :on-change (fn [e] (change-size (.-target.value e)))}]
              size]]
            [:div
             [:div ret]
             [:div (devcards.core/edn args)]]])))))


(comment

  (defn my-table
    ([rows]
     (my-table (distinct (mapcat keys rows)) rows))
    ([ks rows]
     (sab/html
       [:table.table
        [:thead [:tr (for [k ks]
                       [:th (name k)])]]
        [:tbody (for [row rows]
                  [:tr (for [k ks]
                         [:td (get row k "-")])])]])))

  (s/def ::col-key keyword?)
  (s/fdef my-table :args (s/cat :ks (s/coll-of ::col-key)
                                :rows (s/coll-of (s/map-of ::col-key string?))))
  (demo/add-override ::col-key #(s/gen #{:name :age :blah :foo}))
  
  ; View with generated data, no controls.
  (demo/example-card my-table)

  ; View with generated data.  Controls allow seed & size adjustment.
  (defcard my-table-controls
           (demo/demo-controls (demo/sample-fn #'my-table))))