From f7545780757e4fef23e9e90947d069955ea296fd Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Wed, 8 Dec 2021 21:31:58 +0100 Subject: [PATCH] Add coax tests --- deps.edn | 4 +- .../babashka/impl/clojure/test/check.clj | 22 + src/babashka/impl/classes.clj | 1 + src/babashka/impl/clojure/test.clj | 7 + src/babashka/impl/test.clj | 3 +- src/babashka/main.clj | 23 +- .../lib_tests/babashka/run_all_libtests.clj | 4 + .../lib_tests/exoscale/coax_test.cljc | 437 ++++++++++ .../reifyhealth/specmonstah/core_test.cljc | 790 ++++++++++++++++++ .../specmonstah/spec_gen_test.cljc | 283 +++++++ .../reifyhealth/specmonstah/test_data.cljc | 110 +++ 11 files changed, 1672 insertions(+), 12 deletions(-) create mode 100644 test-resources/lib_tests/exoscale/coax_test.cljc create mode 100644 test-resources/lib_tests/reifyhealth/specmonstah/core_test.cljc create mode 100644 test-resources/lib_tests/reifyhealth/specmonstah/spec_gen_test.cljc create mode 100644 test-resources/lib_tests/reifyhealth/specmonstah/test_data.cljc diff --git a/deps.edn b/deps.edn index 22b0fa75..574eb8c3 100644 --- a/deps.edn +++ b/deps.edn @@ -94,7 +94,9 @@ org.clj-commons/digest {:mvn/version "1.4.100"} hato/hato {:mvn/version "0.8.2"} better-cond/better-cond {:mvn/version "2.1.1"} - org.clojure/core.specs.alpha {:mvn/version "0.2.62"}} + org.clojure/core.specs.alpha {:mvn/version "0.2.62"} + reifyhealth/specmonstah {:mvn/version "2.0.0"} + exoscale/coax {:mvn/version "1.0.0-alpha14"}} :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil}} :clj-nvd diff --git a/feature-test-check/babashka/impl/clojure/test/check.clj b/feature-test-check/babashka/impl/clojure/test/check.clj index 4f293028..5a98b236 100644 --- a/feature-test-check/babashka/impl/clojure/test/check.clj +++ b/feature-test-check/babashka/impl/clojure/test/check.clj @@ -175,3 +175,25 @@ (def test-check-namespace {'quick-check (sci/copy-var tc/quick-check tc-ns)}) + +#_(require '[clojure.test.check.clojure-test :as tct]) + +#_(def tct-ns (sci/create-ns 'clojure.test.check nil)) + +#_(doseq [k (sort (keys (ns-publics 'clojure.test.check.clojure-test)))] + (println (str "'" k) (format "(sci/copy-var tct/%s tct-ns)" k))) + +#_(def test-check-clojure-test-namespace + {'*default-opts* (sci/copy-var tct/*default-opts* tct-ns) + '*default-test-count* (sci/copy-var tct/*default-test-count* tct-ns) + '*report-completion* (sci/copy-var tct/*report-completion* tct-ns) + '*report-shrinking* (sci/copy-var tct/*report-shrinking* tct-ns) + '*report-trials* (sci/copy-var tct/*report-trials* tct-ns) + '*trial-report-period* (sci/copy-var tct/*trial-report-period* tct-ns) + 'assert-check (sci/copy-var tct/assert-check tct-ns) + 'default-reporter-fn (sci/copy-var tct/default-reporter-fn tct-ns) + 'defspec (sci/copy-var tct/defspec tct-ns) + 'process-options (sci/copy-var tct/process-options tct-ns) + 'trial-report-dots (sci/copy-var tct/trial-report-dots tct-ns) + 'trial-report-periodic (sci/copy-var tct/trial-report-periodic tct-ns) + 'with-test-out* (sci/copy-var tct/with-test-out* tct-ns)}) diff --git a/src/babashka/impl/classes.clj b/src/babashka/impl/classes.clj index c699cfe1..d53076b8 100644 --- a/src/babashka/impl/classes.clj +++ b/src/babashka/impl/classes.clj @@ -414,6 +414,7 @@ clojure.lang.LispReader$Resolver clojure.lang.Named clojure.lang.Keyword + clojure.lang.MultiFn clojure.lang.PersistentArrayMap clojure.lang.PersistentHashMap clojure.lang.PersistentHashSet diff --git a/src/babashka/impl/clojure/test.clj b/src/babashka/impl/clojure/test.clj index e714e3df..4d757773 100644 --- a/src/babashka/impl/clojure/test.clj +++ b/src/babashka/impl/clojure/test.clj @@ -282,6 +282,13 @@ `(sci/binding [sci/out @test-out] ~@body)) +(defmacro with-test-out + "Runs body with *out* bound to the value of *test-out*." + {:added "1.1"} + [& body] + `(binding [*out* clojure.test/*test-out*] + ~@body)) + ;;; UTILITIES FOR REPORTING FUNCTIONS (defn testing-vars-str diff --git a/src/babashka/impl/test.clj b/src/babashka/impl/test.clj index 6e618efe..62b1b494 100644 --- a/src/babashka/impl/test.clj +++ b/src/babashka/impl/test.clj @@ -56,4 +56,5 @@ ;; running tests: high level 'run-tests (new-var 'run-tests (contextualize t/run-tests)) 'run-all-tests (new-var 'run-all-tests (contextualize t/run-all-tests)) - 'successful? (sci/copy-var t/successful? tns)}) + 'successful? (sci/copy-var t/successful? tns) + 'with-test-out (sci/copy-var t/with-test-out tns)}) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index 6b00c687..2a1ed381 100644 --- a/src/babashka/main.clj +++ b/src/babashka/main.clj @@ -272,8 +272,8 @@ Use bb run --help to show this help output. (let [f (io/file file)] (if (.exists f) (as-> (slurp file) x - ;; remove shebang - (str/replace x #"^#!.*" "")) + ;; remove shebang + (str/replace x #"^#!.*" "")) (throw (Exception. (str "File does not exist: " file)))))) (defn load-file* [f] @@ -346,9 +346,9 @@ Use bb run --help to show this help output. 'demunge (sci/copy-var demunge clojure-main-ns) 'repl-requires (sci/copy-var clojure-main/repl-requires clojure-main-ns) 'repl (sci/new-var 'repl - (fn [& opts] - (let [opts (apply hash-map opts)] - (repl/start-repl! @common/ctx opts))) {:ns clojure-main-ns})} + (fn [& opts] + (let [opts (apply hash-map opts)] + (repl/start-repl! @common/ctx opts))) {:ns clojure-main-ns})} 'clojure.test t/clojure-test-namespace 'babashka.classpath classpath-namespace 'clojure.pprint pprint-namespace @@ -402,7 +402,10 @@ Use bb run --help to show this help output. 'clojure.test.check.properties @(resolve 'babashka.impl.clojure.test.check/properties-namespace) 'clojure.test.check - @(resolve 'babashka.impl.clojure.test.check/test-check-namespace)) + @(resolve 'babashka.impl.clojure.test.check/test-check-namespace) + ;; it's better to load this from source by adding the clojure.test.check dependency + #_#_'clojure.test.check.clojure-test + @(resolve 'babashka.impl.clojure.test.check/test-check-clojure-test-namespace)) features/spec-alpha? (-> (assoc ;; spec 'clojure.spec.alpha @(resolve 'babashka.impl.spec/spec-namespace) 'clojure.spec.gen.alpha @(resolve 'babashka.impl.spec/gen-namespace) @@ -503,8 +506,8 @@ Use bb run --help to show this help output. (assoc opts-map :verbose? true)) ("--force") (recur (next options) - (assoc opts-map - :force? true)) + (assoc opts-map + :force? true)) ("--describe") (recur (next options) (assoc opts-map :describe? true)) @@ -833,8 +836,8 @@ Use bb run --help to show this help output. expressions (sci/binding [sci/file abs-path] (try - ; when evaluating expression(s), add in repl-requires so things like - ; pprint and dir are available + ; when evaluating expression(s), add in repl-requires so things like + ; pprint and dir are available (sci/eval-form sci-ctx `(apply require (quote ~clojure-main/repl-requires))) (loop [] (let [in (read-next *in*)] diff --git a/test-resources/lib_tests/babashka/run_all_libtests.clj b/test-resources/lib_tests/babashka/run_all_libtests.clj index 4e80dd70..f3fb075e 100644 --- a/test-resources/lib_tests/babashka/run_all_libtests.clj +++ b/test-resources/lib_tests/babashka/run_all_libtests.clj @@ -266,6 +266,10 @@ (test-namespaces 'hato.client-test) (test-namespaces 'better-cond.core-test) + +(test-namespaces 'exoscale.coax-test) +;; TODO, after @cldwalker finishes PR to specmonstah (test-namespaces 'reifyhealth.specmonstah.core-test) + ;;;; final exit code (let [{:keys [:test :fail :error] :as m} @status] diff --git a/test-resources/lib_tests/exoscale/coax_test.cljc b/test-resources/lib_tests/exoscale/coax_test.cljc new file mode 100644 index 00000000..a6e2c34c --- /dev/null +++ b/test-resources/lib_tests/exoscale/coax_test.cljc @@ -0,0 +1,437 @@ +(ns exoscale.coax-test + #?(:cljs (:require-macros [cljs.test :refer [deftest testing is are run-tests]] + [exoscale.coax :as sc])) + (:require + #?(:clj [clojure.test :refer [deftest testing is are]]) + [clojure.spec.alpha :as s] + [clojure.string :as str] + [clojure.test.check :as tc] + [clojure.test.check.generators] + [clojure.test.check.properties :as prop] + [clojure.spec.test.alpha :as st] + #?(:clj [clojure.test.check.clojure-test :refer [defspec]]) + #?(:cljs [clojure.test.check.clojure-test :refer-macros [defspec]]) + [exoscale.coax :as sc] + [exoscale.coax.coercer :as c]) + #?(:clj (:import (java.net URI)))) + +#?(:clj (st/instrument)) + +(s/def ::infer-int int?) +(s/def ::infer-and-spec (s/and int? #(> % 10))) +(s/def ::infer-and-spec-indirect (s/and ::infer-int #(> % 10))) +(s/def ::infer-form (s/coll-of int?)) +(s/def ::infer-nilable (s/nilable int?)) + +#?(:clj (s/def ::infer-decimal? decimal?)) + +(sc/def ::some-coercion c/to-long) + +(s/def ::first-layer int?) +(sc/def ::first-layer (fn [x _] (inc (c/to-long x nil)))) + +(s/def ::second-layer ::first-layer) +(s/def ::second-layer-and (s/and ::first-layer #(> % 10))) + +(s/def ::or-example (s/or :int int? :double double? :bool boolean?)) + +(s/def ::nilable-int (s/nilable ::infer-int)) +(s/def ::nilable-pos-int (s/nilable (s/and ::infer-int pos?))) +(s/def ::nilable-string (s/nilable string?)) + +(s/def ::nilable-set #{nil}) +(s/def ::int-set #{1 2}) +(s/def ::float-set #{1.2 2.1}) +(s/def ::boolean-set #{true}) +(s/def ::symbol-set #{'foo/bar 'bar/foo}) +(s/def ::ident-set #{'foo/bar :bar/foo}) +(s/def ::string-set #{"hey" "there"}) +(s/def ::keyword-set #{:a :b}) +(s/def ::uuid-set #{#uuid "d6e73cc5-95bc-496a-951c-87f11af0d839" + #uuid "a6e73cc5-95bc-496a-951c-87f11af0d839"}) +(s/def ::nil-set #{nil}) +#?(:clj (s/def ::uri-set #{(URI. "http://site.com") + (URI. "http://site.org")})) +#?(:clj (s/def ::decimal-set #{42.42M 1.1M})) + +(def enum-set #{:a :b}) +(s/def ::referenced-set enum-set) + +(def enum-map {:foo "bar" + :baz "qux"}) +(s/def ::calculated-set (->> enum-map keys (into #{}))) + +(s/def ::nilable-referenced-set (s/nilable enum-set)) +(s/def ::nilable-calculated-set (s/nilable (->> enum-map keys (into #{})))) + +(s/def ::nilable-referenced-set-kw (s/nilable ::referenced-set)) +(s/def ::nilable-calculated-set-kw (s/nilable ::calculated-set)) + +(s/def ::unevaluatable-spec (letfn [(pred [x] (string? x))] + (s/spec pred))) + +(sc/def ::some-coercion c/to-long) + +(deftest test-coerce-from-registry + (testing "it uses the registry to coerce a key" + (is (= (sc/coerce ::some-coercion "123") 123))) + + (testing "it returns original value when it a coercion can't be found" + (is (= (sc/coerce ::not-defined "123") "123"))) + + (testing "go over nilables" + (is (= (sc/coerce ::infer-nilable "123") 123)) + (is (= (sc/coerce ::infer-nilable nil) nil)) + (is (= (sc/coerce ::infer-nilable "") "")) + (is (= (sc/coerce ::nilable-int "10") 10)) + (is (= (sc/coerce ::nilable-int "10" {::sc/idents {`int? (fn [x _] (keyword x))}}) :10)) + (is (= (sc/coerce ::nilable-pos-int "10") 10)) + + (is (= (sc/coerce ::nilable-string nil) nil)) + (is (= (sc/coerce ::nilable-string 1) "1")) + (is (= (sc/coerce ::nilable-string "") "")) + (is (= (sc/coerce ::nilable-string "asdf") "asdf"))) + + (testing "specs given as sets" + (is (= (sc/coerce ::nilable-set nil) nil)) + (is (= (sc/coerce ::int-set "1") 1)) + (is (= (sc/coerce ::float-set "1.2") 1.2)) + (is (= (sc/coerce ::boolean-set "true") true)) + ;;(is (= (sc/coerce ::symbol-set "foo/bar") 'foo/bar)) + (is (= (sc/coerce ::string-set "hey") "hey")) + (is (= (sc/coerce ::keyword-set ":b") :b)) + (is (= (sc/coerce ::uuid-set "d6e73cc5-95bc-496a-951c-87f11af0d839") #uuid "d6e73cc5-95bc-496a-951c-87f11af0d839")) + ;;#?(:clj (is (= (sc/coerce ::uri-set "http://site.com") (URI. "http://site.com")))) + #?(:clj (is (= (sc/coerce ::decimal-set "42.42M") 42.42M))) + + ;; The following tests can't work without using `eval`. We will avoid this + ;; and hope that spec2 will give us a better way. + ;;(is (= (sc/coerce ::referenced-set ":a") :a)) + ;;(is (= (sc/coerce ::calculated-set ":foo") :foo)) + ;;(is (= (sc/coerce ::nilable-referenced-set ":a") :a)) + ;;(is (= (sc/coerce ::nilable-calculated-set ":foo") :foo)) + ;;(is (= (sc/coerce ::nilable-referenced-set-kw ":a") :a)) + ;;(is (= (sc/coerce ::nilable-calculated-set-kw ":foo") :foo)) + + (is (= (sc/coerce ::unevaluatable-spec "just a string") "just a string")))) + +(deftest test-coerce! + (is (= (sc/coerce! ::infer-int "123") 123)) + (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo :cljs js/Error) + #"Invalid coerced value" (sc/coerce! ::infer-int "abc")))) + +(deftest test-conform + (is (= (sc/conform ::or-example "true") [:bool true]))) + +(deftest test-coerce-from-predicates + (are [predicate input output] (= (sc/coerce predicate input) output) + `number? "42" 42 + `number? "foo" "foo" + `integer? "42" 42 + `int? "42" 42 + `int? 42.0 42 + `int? 42.5 42 + `(s/int-in 0 100) "42" 42 + `pos-int? "42" 42 + `neg-int? "-42" -42 + `nat-int? "10" 10 + `even? "10" 10 + `odd? "9" 9 + `float? "42.42" 42.42 + `double? "42.42" 42.42 + `double? 42.42 42.42 + `double? 42 42.0 + + `number? "42.42" 42.42 + `number? 42.42 42.42 + `number? 42 42 + + `(s/double-in 0 100) "42.42" 42.42 + `string? 42 "42" + `string? :a ":a" + `string? :foo/bar ":foo/bar" + `string? [] [] + `string? {} {} + `string? #{} #{} + `boolean? "true" true + `boolean? "false" false + `ident? ":foo/bar" :foo/bar + `ident? "foo/bar" 'foo/bar + `simple-ident? ":foo" :foo + `qualified-ident? ":foo/baz" :foo/baz + `keyword? "keyword" :keyword + `keyword? ":keyword" :keyword + `keyword? 'symbol :symbol + `simple-keyword? ":simple-keyword" :simple-keyword + `qualified-keyword? ":qualified/keyword" :qualified/keyword + `symbol? "sym" 'sym + `simple-symbol? "simple-sym" 'simple-sym + `qualified-symbol? "qualified/sym" 'qualified/sym + `uuid? "d6e73cc5-95bc-496a-951c-87f11af0d839" #uuid "d6e73cc5-95bc-496a-951c-87f11af0d839" + `nil? nil nil + `false? "false" false + `true? "true" true + `zero? "0" 0 + + `(s/coll-of int?) ["11" "31" "42"] [11 31 42] + `(s/coll-of int?) ["11" "foo" "42"] [11 "foo" 42] + `(s/coll-of int? :kind list?) ["11" "foo" "42"] '(11 "foo" 42) + `(s/coll-of int? :kind set?) ["11" "foo" "42"] #{11 "foo" 42} + `(s/coll-of int? :kind set?) #{"11" "foo" "42"} #{11 "foo" 42} + `(s/coll-of int? :kind vector?) '("11" "foo" "42") [11 "foo" 42] + `(s/every int?) ["11" "31" "42"] [11 31 42] + + `(s/map-of keyword? int?) {"foo" "42" "bar" "31"} {:foo 42 :bar 31} + `(s/map-of keyword? int?) "foo" "foo" + `(s/every-kv keyword? int?) {"foo" "42" "bar" "31"} {:foo 42 :bar 31} + + `(s/or :int int? :double double? :bool boolean?) "42" 42 + `(s/or :double double? :bool boolean?) "42.3" 42.3 + `(s/or :int int? :double double? :bool boolean?) "true" true + + `(s/or :b keyword? :a string?) "abc" "abc" + `(s/or :a string? :b keyword?) "abc" "abc" + `(s/or :b keyword? :a string?) :abc :abc + + `(s/or :str string? :kw keyword? :number? number?) :asdf :asdf + `(s/or :str string? :kw keyword? :number? number?) "asdf" "asdf" + `(s/or :kw keyword? :str string? :number? number?) "asdf" "asdf" + `(s/or :number? number? :kw keyword?) "1" 1 + `(s/or :number? number?) "1" 1 + `(s/or :number? number? :kw keyword? :str string?) "1" "1" + `(s/or :number? number? :kw keyword? :str string?) 1 1 + #{:a :b} "a" :a + #{1 2} "1" 1 + + #?@(:clj [`uri? "http://site.com" (URI. "http://site.com")]) + #?@(:clj [`decimal? "42.42" 42.42M + `decimal? "42.42M" 42.42M]))) + +(def test-gens + {`inst? (s/gen (s/inst-in #inst "1980" #inst "9999"))}) + +#?(:cljs + (defn ->js [var-name] + (-> (str var-name) + (str/replace #"/" ".") + (str/replace #"-" "_") + (str/replace #"\?" "_QMARK_") + (js/eval)))) + +(defn safe-gen [s sp] + (try + (or (test-gens s) + (s/gen sp)) + (catch #?(:clj Exception :cljs :default) _ nil))) + +#?(:clj + ;; FIXME won't run on cljs + (deftest test-coerce-generative + (doseq [s (->> (sc/registry) + ::sc/idents + (keys) + (filter symbol?)) + :let [sp #?(:clj @(resolve s) :cljs (->js s)) + gen (safe-gen s sp)] + :when gen] + (let [res (tc/quick-check 100 + (prop/for-all [v gen] + (s/valid? sp (sc/coerce s (-> (pr-str v) + (str/replace #"^#[^\"]+\"|\"]?$" + ""))))))] + (if-not (= true (:result res)) + (throw (ex-info (str "Error coercing " s) + {:symbol s + :spec sp + :result res}))))))) + +#?(:clj (deftest test-coerce-inst + (are [input output] (= (sc/coerce `inst? input) + output) + "2020-05-17T21:37:57.830-00:00" #inst "2020-05-17T21:37:57.830-00:00" + "2018-09-28" #inst "2018-09-28"))) + +(deftest test-coerce-inference-test + (are [keyword input output] (= (sc/coerce keyword input) output) + ::infer-int "123" 123 + ::infer-and-spec "42" 42 + ::infer-and-spec-indirect "43" 43 + ::infer-form ["20" "43"] [20 43] + ::infer-form '("20" "43") '(20 43) + ::infer-form (map str (range 2)) '(0 1) + ::second-layer "41" 42 + ::second-layer-and "41" 42 + + #?@(:clj [::infer-decimal? "123.4" 123.4M]) + #?@(:clj [::infer-decimal? 123.4 123.4M]) + #?@(:clj [::infer-decimal? 123.4M 123.4M]) + #?@(:clj [::infer-decimal? "" ""]) + #?@(:clj [::infer-decimal? [] []]))) + +(deftest test-coerce-structure + (is (= (sc/coerce-structure {::some-coercion "321" + ::not-defined "bla" + :sub {::infer-int "42"}}) + {::some-coercion 321 + ::not-defined "bla" + :sub {::infer-int 42}})) + (is (= (sc/coerce-structure {::some-coercion "321" + ::not-defined "bla" + :unqualified 12 + :sub {::infer-int "42"}} + {::sc/idents {::not-defined `keyword?}}) + {::some-coercion 321 + ::not-defined :bla + :unqualified 12 + :sub {::infer-int 42}})) + (is (= (sc/coerce-structure {::or-example "321"} + {::sc/op sc/conform}) + {::or-example [:int 321]}))) + +(s/def ::bool boolean?) +(s/def ::simple-keys (s/keys :req [::infer-int] + :opt [::bool])) +(s/def ::nested-keys (s/keys :req [::infer-form ::simple-keys] + :req-un [::bool])) + +(deftest test-coerce-keys + (is (= {::infer-int 123} + (sc/coerce ::simple-keys {::infer-int "123"}))) + (is (= {::infer-form [1 2 3] + ::simple-keys {::infer-int 456 + ::bool true} + :bool true} + (sc/coerce ::nested-keys {::infer-form ["1" "2" "3"] + ::simple-keys {::infer-int "456" + ::bool "true"} + :bool "true"}))) + (is (= "garbage" (sc/coerce ::simple-keys "garbage")))) + +(s/def ::head double?) +(s/def ::body int?) +(s/def ::arm int?) +(s/def ::leg double?) +(s/def ::arms (s/coll-of ::arm)) +(s/def ::legs (s/coll-of ::leg)) +(s/def ::name string?) +(s/def ::animal (s/keys :req [::head ::body ::arms ::legs] + :opt-un [::name ::id])) + +(deftest test-coerce-with-registry-overrides + (testing "it uses overrides when provided" + (is (= {::head 1 + ::body 16 + ::arms [4 4] + ::legs [7 7] + :foo "bar" + :name :john} + (sc/coerce ::animal + {::head "1" + ::body "16" + ::arms ["4" "4"] + ::legs ["7" "7"] + :foo "bar" + :name "john"} + {::sc/idents + {::head c/to-long + ::leg c/to-long + ::name c/to-keyword}})) + "Coerce with option form") + (is (= 1 (sc/coerce `string? "1" {::sc/idents {`string? c/to-long}})) + "overrides works on qualified-idents") + + (is (= [1] (sc/coerce `(s/coll-of string?) ["1"] + {::sc/idents {`string? c/to-long}})) + "overrides works on qualified-idents, also with composites") + + (is (= ["foo" "bar" "baz"] + (sc/coerce `vector? + "foo,bar,baz" + {::sc/idents {`vector? (fn [x _] (str/split x #"[,]"))}})) + "override on real world use case with vector?"))) + +(s/def ::foo int?) +(s/def ::bar string?) +(s/def ::qualified (s/keys :req [(or ::foo ::bar)])) +(s/def ::unqualified (s/keys :req-un [(or ::foo ::bar)])) + +(deftest test-or-conditions-in-qualified-keys + (is (= (sc/coerce ::qualified {::foo "1" ::bar "hi"}) + {::foo 1 ::bar "hi"}))) + +(deftest test-or-conditions-in-unqualified-keys + (is (= (sc/coerce ::unqualified {:foo "1" :bar "hi"}) + {:foo 1 :bar "hi"}))) + +(s/def ::tuple (s/tuple ::foo ::bar int?)) + +(deftest test-tuple + (is (= [0 "" 1] (sc/coerce ::tuple ["0" nil "1"]))) + (is (= "garbage" (sc/coerce ::tuple "garbage")))) + +(deftest test-merge + (s/def ::merge (s/merge (s/keys :req-un [::foo]) + ::unqualified + ;; TODO: add s/multi-spec test + )) + (is (= {:foo 1 :bar "1" :c {:a 2}} + (sc/coerce ::merge {:foo "1" :bar 1 :c {:a 2}})) + "Coerce new vals appropriately") + (is (= {:foo 1 :bar "1" :c {:a 2}} + (sc/coerce ::merge {:foo 1 :bar "1" :c {:a 2}})) + "Leave out ok vals") + + (s/def ::merge2 (s/merge (s/keys :req [::foo]) + ::unqualified)) + + (is (= {::foo 1 :bar "1" :c {:a 2} + :foo 1} + (sc/coerce ::merge2 {::foo "1" :foo "1" :bar "1" :c {:a 2}})) + "Leave out ok vals") + + (is (= "garbage" (sc/coerce ::merge "garbage")) + "garbage is passthrough") + + (s/def ::x qualified-keyword?) + (sc/def ::x (fn [x _] (keyword "y" x))) + (s/def ::m1 (s/keys :opt [::x])) + (s/def ::mm (s/merge ::m1 ::m1)) + (is (= {::x :y/quux} + (sc/coerce ::mm + {::x "quux"} + {::sc/cache? false})))) + +(def d :kw) +;; no vars in cljs +#?(:clj (defmulti multi #'d) :cljs (defmulti multi :kw)) +(defmethod multi :default [_] (s/keys :req-un [::foo])) +(defmethod multi :kw [_] ::unqualified) +(s/def ::multi (s/multi-spec multi :hit)) + +(deftest test-multi-spec + (is (= {:not "foo"} (sc/coerce ::multi {:not "foo"}))) + (is (= {:foo 1} (sc/coerce ::multi {:foo 1}))) + (is (= {:foo 1} (sc/coerce ::multi {:foo "1"}))) + (is (= {:foo 1 :d :kw} (sc/coerce ::multi {:d :kw :foo "1"}))) + (is (= "garbage" (sc/coerce ::multi "garbage")))) + +(deftest test-gigo + (is (= (sc/coerce `(some-unknown-form string?) 1) 1)) + (is (= (sc/coerce `(some-unknown-form) 1) 1))) + +(deftest invalidity-test + (is (= :exoscale.coax/invalid (sc/coerce* `int? [] {}))) + (is (= :exoscale.coax/invalid (sc/coerce* `(s/coll-of int?) 1 {}))) + (is (= :exoscale.coax/invalid (sc/coerce* ::int-set "" {})))) + + +(deftest test-caching + (s/def ::bs (s/keys :req [::bool])) + (is (= false (sc/coerce ::bool "false"))) + (is (= false (::bool (sc/coerce ::bs {::bool "false"})))) + (is (= false (sc/coerce ::bool + "false" + {:exoscale.coax/cache? false}))) + (is (= false (::bool (sc/coerce ::bs + {::bool "false"} + {:exoscale.coax/cache? false}))))) diff --git a/test-resources/lib_tests/reifyhealth/specmonstah/core_test.cljc b/test-resources/lib_tests/reifyhealth/specmonstah/core_test.cljc new file mode 100644 index 00000000..4bb0325e --- /dev/null +++ b/test-resources/lib_tests/reifyhealth/specmonstah/core_test.cljc @@ -0,0 +1,790 @@ +(ns reifyhealth.specmonstah.core-test + (:require #?(:clj [clojure.test :refer [deftest is are use-fixtures testing]] + :cljs [cljs.test :include-macros true :refer [deftest is are use-fixtures testing]]) + [clojure.spec.alpha :as s] + [clojure.spec.test.alpha :as stest] + [clojure.test.check.generators :as gen :include-macros true] + [reifyhealth.specmonstah.test-data :as td] + [reifyhealth.specmonstah.core :as sm] + [reifyhealth.specmonstah.spec-gen :as sg] + [loom.graph :as lg] + [loom.alg :as la] + [loom.attr :as lat])) + +(use-fixtures :each td/test-fixture) +(use-fixtures :once (fn [t] (stest/instrument) (t))) + +(defmacro is-graph= + "Breaks graph equality test into comparisons on graph keys to + pinpoint inequality more quickly" + [g1 g2] + (let [g1-sym 'returned + g2-sym 'expected] + `(let [~g1-sym ~g1 + ~g2-sym ~g2] + (are [k] (= (k ~g1-sym) (k ~g2-sym)) + :nodeset + :adj + :in + :attrs)))) + +(deftest test-relation-graph + (is-graph= (sm/relation-graph td/schema) + (lg/digraph [:project :todo-list] + [:project :user] + [:todo-list-watch :todo-list] + [:todo-list-watch :user] + [:todo :todo-list] + [:todo-list :user] + [:todo :user] + [:attachment :todo] + [:attachment :user]))) + +(defn strip-db + [db] + (dissoc db :relation-graph :types :type-order)) + +(deftest test-add-ents-empty + (is-graph= (strip-db (sm/add-ents {:schema td/schema} {})) + {:schema td/schema + :data (lg/digraph)})) + +(deftest test-bound-relation-attr-name + (is (= (sm/bound-relation-attr-name (sm/add-ents {:schema td/schema} {}) :tl-bound-p-0 :todo 1) + :t-bound-p-1))) + +(deftest test-add-ents-relationless-ent + (is-graph= (:data (sm/add-ents {:schema td/schema} {:user [[:u1]]})) + (-> (lg/digraph [:user :u1]) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u1 :type :ent) + (lat/add-attr :u1 :index 0) + (lat/add-attr :u1 :query-term [:u1]) + (lat/add-attr :u1 :ent-type :user)))) + +(deftest test-add-ents-mult-relationless-ents + (is-graph= (:data (strip-db (sm/add-ents {:schema td/schema} {:user [[3]]}))) + (-> (lg/digraph [:user :u0] [:user :u1] [:user :u2]) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :query-term [3]) + (lat/add-attr :u0 :ent-type :user) + + (lat/add-attr :u1 :type :ent) + (lat/add-attr :u1 :index 1) + (lat/add-attr :u1 :query-term [3]) + (lat/add-attr :u1 :ent-type :user) + + (lat/add-attr :u2 :type :ent) + (lat/add-attr :u2 :index 2) + (lat/add-attr :u2 :query-term [3]) + (lat/add-attr :u2 :ent-type :user)))) + +(deftest test-add-ents-one-level-relation + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo-list [[1]]})) + (-> (lg/digraph [:user :u0] [:todo-list :tl0] [:tl0 :u0]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :query-term [:_]) + (lat/add-attr :u0 :ent-type :user) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [1]) + + (lat/add-attr :tl0 :u0 :relation-attrs #{:created-by-id :updated-by-id})))) + +(deftest test-add-ents-one-level-relation-with-omit + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo-list [[1 {:refs {:created-by-id ::sm/omit + :updated-by-id ::sm/omit}}]]})) + (-> (lg/digraph [:todo-list :tl0]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [1 {:refs {:created-by-id ::sm/omit + :updated-by-id ::sm/omit}}])))) + +(deftest testadd-entsb-mult-ents-w-extended-query + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo-list [[2 {:refs {:created-by-id :bloop :updated-by-id :bloop}}]]})) + (-> (lg/digraph [:user :bloop] + [:todo-list :tl0] + [:todo-list :tl1] + [:tl0 :bloop] + [:tl1 :bloop]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :bloop :type :ent) + (lat/add-attr :bloop :index 0) + (lat/add-attr :bloop :query-term [:_]) + (lat/add-attr :bloop :ent-type :user) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [2 {:refs {:created-by-id :bloop :updated-by-id :bloop}}]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl1 :type :ent) + (lat/add-attr :tl1 :index 1) + (lat/add-attr :tl1 :ent-type :todo-list) + (lat/add-attr :tl1 :query-term [2 {:refs {:created-by-id :bloop :updated-by-id :bloop}}]) + + (lat/add-attr :tl0 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :tl1 :bloop :relation-attrs #{:created-by-id :updated-by-id})))) + +(deftest test-add-ents-one-level-relation-custom-related + (is-graph= (:data (strip-db (sm/add-ents {:schema td/schema} {:todo-list [[:_ {:refs {:created-by-id :owner0 + :updated-by-id :owner0}}]]}))) + (-> (lg/digraph [:user :owner0] [:todo-list :tl0] [:tl0 :owner0]) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :owner0 :type :ent) + (lat/add-attr :owner0 :index 0) + (lat/add-attr :owner0 :query-term [:_]) + (lat/add-attr :owner0 :ent-type :user) + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [:_ {:refs {:created-by-id :owner0 + :updated-by-id :owner0}}]) + (lat/add-attr :tl0 :owner0 :relation-attrs #{:updated-by-id :created-by-id})))) + +(deftest testadd-entsb-two-level-coll-relation + (testing "can specify how many ents to gen in a coll relationship" + (is-graph= (:data (strip-db (sm/add-ents {:schema td/schema} {:project [[:_ {:refs {:todo-list-ids 2}}]]}))) + (-> (lg/digraph [:user :u0] + [:todo-list :tl0] [:todo-list :tl1] [:tl0 :u0] [:tl1 :u0] + [:project :p0] [:p0 :u0] [:p0 :tl0] [:p0 :tl1] [:p0 :u0]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :query-term [:_]) + (lat/add-attr :u0 :ent-type :user) + + (lat/add-attr :project :type :ent-type) + (lat/add-attr :p0 :type :ent) + (lat/add-attr :p0 :index 0) + (lat/add-attr :p0 :query-term [:_ {:refs {:todo-list-ids 2}}]) + (lat/add-attr :p0 :ent-type :project) + (lat/add-attr :p0 :u0 :relation-attrs #{:created-by-id :updated-by-id}) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [:_]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl1 :type :ent) + (lat/add-attr :tl1 :index 1) + (lat/add-attr :tl1 :ent-type :todo-list) + (lat/add-attr :tl1 :query-term [:_]) + + (lat/add-attr :p0 :tl0 :relation-attrs #{:todo-list-ids}) + (lat/add-attr :p0 :tl1 :relation-attrs #{:todo-list-ids}) + (lat/add-attr :p0 :u0 :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :tl0 :u0 :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :tl1 :u0 :relation-attrs #{:created-by-id :updated-by-id}))))) + +(deftest test-add-ents-two-level-coll-relation-names + (testing "can specify names in a coll relationship" + (is-graph= (:data (strip-db (sm/add-ents {:schema td/schema} {:project [[:_ {:refs {:todo-list-ids [:mario :luigi]}}]]}))) + (-> (lg/digraph [:user :u0] + [:todo-list :mario] [:todo-list :luigi] [:mario :u0] [:luigi :u0] + [:project :p0] [:p0 :u0] [:p0 :mario] [:p0 :luigi] [:p0 :u0]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :query-term [:_]) + (lat/add-attr :u0 :ent-type :user) + + (lat/add-attr :project :type :ent-type) + (lat/add-attr :p0 :type :ent) + (lat/add-attr :p0 :index 0) + (lat/add-attr :p0 :query-term [:_ {:refs {:todo-list-ids [:mario :luigi]}}]) + (lat/add-attr :p0 :ent-type :project) + (lat/add-attr :p0 :u0 :relation-attrs #{:created-by-id :updated-by-id}) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :mario :type :ent) + (lat/add-attr :mario :index 0) + (lat/add-attr :mario :ent-type :todo-list) + (lat/add-attr :mario :query-term [:_]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :luigi :type :ent) + (lat/add-attr :luigi :index 1) + (lat/add-attr :luigi :ent-type :todo-list) + (lat/add-attr :luigi :query-term [:_]) + + (lat/add-attr :p0 :mario :relation-attrs #{:todo-list-ids}) + (lat/add-attr :p0 :luigi :relation-attrs #{:todo-list-ids}) + (lat/add-attr :p0 :u0 :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :mario :u0 :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :luigi :u0 :relation-attrs #{:created-by-id :updated-by-id}))))) + +(deftest test-add-ents-one-level-relation-binding + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo-list [[:_ {:bind {:user :bloop}}]]})) + (-> (lg/digraph [:user :bloop] [:todo-list :tl0] [:tl0 :bloop]) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :bloop :type :ent) + (lat/add-attr :bloop :index 0) + (lat/add-attr :bloop :query-term [:_ {:bind {:user :bloop}}]) + (lat/add-attr :bloop :ent-type :user) + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [:_ {:bind {:user :bloop}}]) + (lat/add-attr :tl0 :bloop :relation-attrs #{:created-by-id :updated-by-id})))) + +(deftest test-add-ents-two-level-relation-binding + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo [[:_ {:bind {:user :bloop}}]]})) + (-> (lg/digraph [:user :bloop] + [:todo :t0] + [:todo-list :tl-bound-t-0] + [:t0 :bloop] + [:t0 :tl-bound-t-0] + [:tl-bound-t-0 :bloop]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :bloop :type :ent) + (lat/add-attr :bloop :index 0) + (lat/add-attr :bloop :ent-type :user) + (lat/add-attr :bloop :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo :type :ent-type) + (lat/add-attr :t0 :type :ent) + (lat/add-attr :t0 :index 0) + (lat/add-attr :t0 :ent-type :todo) + (lat/add-attr :t0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl-bound-t-0 :type :ent) + (lat/add-attr :tl-bound-t-0 :index 0) + (lat/add-attr :tl-bound-t-0 :ent-type :todo-list) + (lat/add-attr :tl-bound-t-0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :t0 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :t0 :tl-bound-t-0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :tl-bound-t-0 :bloop :relation-attrs #{:created-by-id :updated-by-id})))) + +(deftest test-add-ents-multiple-two-level-relation-binding + (testing "only one bound todo list is created for the three todos" + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo [[3 {:bind {:user :bloop}}]]})) + (-> (lg/digraph [:user :bloop] + [:todo-list :tl-bound-t-0] + [:todo :t0] + [:t0 :bloop] + [:t0 :tl-bound-t-0] + [:todo :t1] + [:t1 :bloop] + [:t1 :tl-bound-t-0] + [:todo :t2] + [:t2 :bloop] + [:t2 :tl-bound-t-0] + [:tl-bound-t-0 :bloop]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :bloop :type :ent) + (lat/add-attr :bloop :index 0) + (lat/add-attr :bloop :ent-type :user) + (lat/add-attr :bloop :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo :type :ent-type) + (lat/add-attr :t0 :type :ent) + (lat/add-attr :t0 :index 0) + (lat/add-attr :t0 :ent-type :todo) + (lat/add-attr :t0 :query-term [3 {:bind {:user :bloop}}]) + + (lat/add-attr :todo :type :ent-type) + (lat/add-attr :t1 :type :ent) + (lat/add-attr :t1 :index 1) + (lat/add-attr :t1 :ent-type :todo) + (lat/add-attr :t1 :query-term [3 {:bind {:user :bloop}}]) + + (lat/add-attr :todo :type :ent-type) + (lat/add-attr :t2 :type :ent) + (lat/add-attr :t2 :index 2) + (lat/add-attr :t2 :ent-type :todo) + (lat/add-attr :t2 :query-term [3 {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl-bound-t-0 :type :ent) + (lat/add-attr :tl-bound-t-0 :index 0) + (lat/add-attr :tl-bound-t-0 :ent-type :todo-list) + (lat/add-attr :tl-bound-t-0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :t0 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :t0 :tl-bound-t-0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :t1 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :t1 :tl-bound-t-0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :t2 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :t2 :tl-bound-t-0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :tl-bound-t-0 :bloop :relation-attrs #{:created-by-id :updated-by-id}))))) + +(deftest test-add-ents-bound-and-uniq + (testing "create uniq bound todo lists per todo-list-watch uniq constraint" + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo-list-watch [[2 {:bind {:user :bloop}}]]})) + (-> (lg/digraph [:user :bloop] + [:todo-list :tl-bound-tlw-0] + [:tl-bound-tlw-0 :bloop] + [:todo-list :tl-bound-tlw-1] + [:tl-bound-tlw-1 :bloop] + [:todo-list-watch :tlw0] + [:tlw0 :bloop] + [:tlw0 :tl-bound-tlw-0] + [:todo-list-watch :tlw1] + [:tlw1 :bloop] + [:tlw1 :tl-bound-tlw-1]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :bloop :type :ent) + (lat/add-attr :bloop :index 0) + (lat/add-attr :bloop :ent-type :user) + (lat/add-attr :bloop :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list-watch :type :ent-type) + (lat/add-attr :tlw0 :type :ent) + (lat/add-attr :tlw0 :index 0) + (lat/add-attr :tlw0 :ent-type :todo-list-watch) + (lat/add-attr :tlw0 :query-term [2 {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list-watch :type :ent-type) + (lat/add-attr :tlw1 :type :ent) + (lat/add-attr :tlw1 :index 1) + (lat/add-attr :tlw1 :ent-type :todo-list-watch) + (lat/add-attr :tlw1 :query-term [2 {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl-bound-tlw-0 :type :ent) + (lat/add-attr :tl-bound-tlw-0 :index 0) + (lat/add-attr :tl-bound-tlw-0 :ent-type :todo-list) + (lat/add-attr :tl-bound-tlw-0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl-bound-tlw-1 :type :ent) + (lat/add-attr :tl-bound-tlw-1 :index 1) + (lat/add-attr :tl-bound-tlw-1 :ent-type :todo-list) + (lat/add-attr :tl-bound-tlw-1 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :tlw0 :bloop :relation-attrs #{:watcher-id}) + (lat/add-attr :tlw0 :tl-bound-tlw-0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :tlw1 :bloop :relation-attrs #{:watcher-id}) + (lat/add-attr :tlw1 :tl-bound-tlw-1 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :tl-bound-tlw-0 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :tl-bound-tlw-1 :bloop :relation-attrs #{:created-by-id :updated-by-id}))))) + +(deftest test-add-ents-three-level-relation-binding + (is-graph= (:data (sm/add-ents {:schema td/schema} {:attachment [[:_ {:bind {:user :bloop}}]]})) + (-> (lg/digraph [:user :bloop] + [:attachment :a0] + [:todo :t-bound-a-0] + [:todo-list :tl-bound-a-0] + [:a0 :bloop] + [:a0 :t-bound-a-0] + [:t-bound-a-0 :bloop] + [:t-bound-a-0 :tl-bound-a-0] + [:tl-bound-a-0 :bloop]) + + (lat/add-attr :user :type :ent-type) + (lat/add-attr :bloop :type :ent) + (lat/add-attr :bloop :index 0) + (lat/add-attr :bloop :ent-type :user) + (lat/add-attr :bloop :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo :type :ent-type) + (lat/add-attr :t-bound-a-0 :type :ent) + (lat/add-attr :t-bound-a-0 :index 0) + (lat/add-attr :t-bound-a-0 :ent-type :todo) + (lat/add-attr :t-bound-a-0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl-bound-a-0 :type :ent) + (lat/add-attr :tl-bound-a-0 :index 0) + (lat/add-attr :tl-bound-a-0 :ent-type :todo-list) + (lat/add-attr :tl-bound-a-0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :attachment :type :ent-type) + (lat/add-attr :a0 :type :ent) + (lat/add-attr :a0 :index 0) + (lat/add-attr :a0 :ent-type :attachment) + (lat/add-attr :a0 :query-term [:_ {:bind {:user :bloop}}]) + + (lat/add-attr :a0 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :a0 :t-bound-a-0 :relation-attrs #{:todo-id}) + + (lat/add-attr :t-bound-a-0 :bloop :relation-attrs #{:created-by-id :updated-by-id}) + (lat/add-attr :t-bound-a-0 :tl-bound-a-0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :tl-bound-a-0 :bloop :relation-attrs #{:created-by-id :updated-by-id})))) += +(deftest test-add-ents-uniq-constraint + (is-graph= (:data (sm/add-ents {:schema td/schema} {:todo-list-watch [[2]]})) + (-> (lg/digraph [:user :u0] + [:todo-list :tl0] + [:tl0 :u0] + [:todo-list :tl1] + [:tl1 :u0] + [:todo-list-watch :tlw0] + [:tlw0 :tl0] + [:tlw0 :u0] + [:todo-list-watch :tlw1] + [:tlw1 :tl1] + [:tlw1 :u0]) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :ent-type :user) + (lat/add-attr :u0 :query-term [:_]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :query-term [:_]) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl1 :type :ent) + (lat/add-attr :tl1 :index 1) + (lat/add-attr :tl1 :ent-type :todo-list) + (lat/add-attr :tl1 :query-term [:_]) + + (lat/add-attr :todo-list-watch :type :ent-type) + (lat/add-attr :tlw0 :type :ent) + (lat/add-attr :tlw0 :index 0) + (lat/add-attr :tlw0 :ent-type :todo-list-watch) + (lat/add-attr :tlw0 :query-term [2]) + + (lat/add-attr :todo-list-watch :type :ent-type) + (lat/add-attr :tlw1 :type :ent) + (lat/add-attr :tlw1 :index 1) + (lat/add-attr :tlw1 :ent-type :todo-list-watch) + (lat/add-attr :tlw1 :query-term [2]) + + (lat/add-attr :tl0 :u0 :relation-attrs #{:updated-by-id :created-by-id}) + (lat/add-attr :tl1 :u0 :relation-attrs #{:updated-by-id :created-by-id}) + + (lat/add-attr :tlw0 :tl0 :relation-attrs #{:todo-list-id}) + (lat/add-attr :tlw0 :u0 :relation-attrs #{:watcher-id}) + (lat/add-attr :tlw1 :tl1 :relation-attrs #{:todo-list-id}) + (lat/add-attr :tlw1 :u0 :relation-attrs #{:watcher-id})))) + +(deftest test-bound-descendants? + (is (sm/bound-descendants? (sm/init-db {:schema td/schema} {}) {:user :bibbity} :attachment)) + (is (not (sm/bound-descendants? (sm/init-db {:schema td/schema} {}) {:user :bibbity} :user))) + (is (not (sm/bound-descendants? (sm/init-db {:schema td/schema} {}) {:attachment :bibbity} :user)))) + +(deftest queries-can-have-anon-names + (is (= (:data (sm/add-ents {:schema td/schema} {:user [[:_] [:_]]})) + (-> (lg/digraph [:user :u0] [:user :u1] ) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :query-term [:_]) + (lat/add-attr :u0 :ent-type :user) + (lat/add-attr :u1 :type :ent) + (lat/add-attr :u1 :index 1) + (lat/add-attr :u1 :query-term [:_]) + (lat/add-attr :u1 :ent-type :user))))) + +(deftest handles-A->A-cycles + (testing "Handle cycles where two entities of the same type reference each other" + (is-graph= (:data (sm/add-ents {:schema td/cycle-schema} {:user [[:u0 {:refs {:updated-by-id :u1}}] + [:u1 {:refs {:updated-by-id :u0}}]]})) + (-> (lg/digraph [:user :u0] [:user :u1] [:u0 :u1] [:u1 :u0]) + (lat/add-attr :user :type :ent-type) + (lat/add-attr :u0 :type :ent) + (lat/add-attr :u0 :index 0) + (lat/add-attr :u0 :query-term [:u0 {:refs {:updated-by-id :u1}}]) + (lat/add-attr :u0 :ent-type :user) + (lat/add-attr :u0 :u1 :relation-attrs #{:updated-by-id}) + + (lat/add-attr :u1 :type :ent) + (lat/add-attr :u1 :index 1) + (lat/add-attr :u1 :query-term [:u1 {:refs {:updated-by-id :u0}}]) + (lat/add-attr :u1 :ent-type :user) + (lat/add-attr :u1 :u0 :relation-attrs #{:updated-by-id}))))) + +(deftest handles-A->B-cycles + (testing "Handle cycles where two entities of the different types reference each other" + (is-graph= (:data (sm/add-ents {:schema td/cycle-schema} {:todo [[:t0 {:refs {:todo-list-id :tl0}}]] + :todo-list [[:tl0 {:refs {:first-todo-id :t0}}]]})) + (-> (lg/digraph [:todo :t0] [:todo-list :tl0] [:tl0 :t0] [:t0 :tl0]) + (lat/add-attr :todo :type :ent-type) + (lat/add-attr :t0 :type :ent) + (lat/add-attr :t0 :index 0) + (lat/add-attr :t0 :query-term [:t0 {:refs {:todo-list-id :tl0}}]) + (lat/add-attr :t0 :ent-type :todo) + (lat/add-attr :t0 :tl0 :relation-attrs #{:todo-list-id}) + + (lat/add-attr :todo-list :type :ent-type) + (lat/add-attr :tl0 :type :ent) + (lat/add-attr :tl0 :index 0) + (lat/add-attr :tl0 :query-term [:tl0 {:refs {:first-todo-id :t0}}]) + (lat/add-attr :tl0 :ent-type :todo-list) + (lat/add-attr :tl0 :t0 :relation-attrs #{:first-todo-id}))))) + +;; view tests + +(deftest test-attr-map + (let [db (sm/add-ents {:schema td/schema} {:todo [[1]]})] + (is (= {:tl0 :todo-list + :t0 :todo + :u0 :user} + (sm/attr-map db :ent-type))) + (is (= {:u0 :user} + (sm/attr-map db :ent-type [:u0]))))) + +(deftest test-query-ents + (is (= [:t0] + (sm/query-ents (sm/add-ents {:schema td/schema} {:todo [[1]]})))) + + (is (= #{:t0 :u0} + (set (sm/query-ents (sm/add-ents {:schema td/schema} {:user [[1]] + :todo [[1]]})))))) + +(deftest test-add-ents-throws-exception-on-invalid-db + (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo + :cljs js/Object) + #"db is invalid" + (sm/add-ents {:schema []} {}))) + (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo + :cljs js/Object) + #"query is invalid" + (sm/add-ents {:schema td/schema} {:user [[]]})))) + +(deftest updates-node-attrs + (let [db (-> (sm/add-ents {:schema td/schema} {:user [[:_]]}) + (sm/visit-ents-once :custom-attr-key (constantly "yaaaaay a key")))] + (is (= (lat/attr (:data db) :u0 :custom-attr-key) + "yaaaaay a key")))) + +(deftest does-not-override-node-attr + (testing "If node already has attr, subsequent invocations of visit-ents-once will not overwrite it" + (let [db (-> (sm/add-ents {:schema td/schema} {:user [[:_]]}) + (sm/visit-ents-once :custom-attr-key (constantly "yaaaaay a key")) + (sm/visit-ents-once :custom-attr-key (constantly "overwrite!")))] + (is (= (lat/attr (:data db) :u0 :custom-attr-key) + "yaaaaay a key"))))) + +(deftest test-related-ents-by-attr + (let [db (sm/add-ents {:schema td/schema} {:todo [[1]] + :project [[1 {:refs {:todo-list-ids [:tl0 :tl1]}}]]})] + (is (= (sm/related-ents-by-attr db :t0 :todo-list-id) + :tl0)) + (is (= (sm/related-ents-by-attr db :t0 :created-by-id) + :u0)) + (is (= (sm/related-ents-by-attr db :p0 :todo-list-ids) + [:tl0 :tl1])))) + +(deftest polymorphic-refs + (is-graph= (:data (sm/add-ents {:schema td/polymorphic-schema} + {:watch [[1 {:refs {:watched-id :tc0} + :ref-types {:watched-id :topic-category}}]]})) + (-> (lg/digraph [:topic-category :tc0] [:watch :w0] [:w0 :tc0]) + (lat/add-attr :topic-category :type :ent-type) + (lat/add-attr :tc0 :type :ent) + (lat/add-attr :tc0 :index 0) + (lat/add-attr :tc0 :query-term [:_]) + (lat/add-attr :tc0 :ent-type :topic-category) + + (lat/add-attr :watch :type :ent-type) + (lat/add-attr :w0 :type :ent) + (lat/add-attr :w0 :index 0) + (lat/add-attr :w0 :query-term [1 {:refs {:watched-id :tc0} + :ref-types {:watched-id :topic-category}}]) + (lat/add-attr :w0 :ent-type :watch) + (lat/add-attr :w0 :tc0 :relation-attrs #{:watched-id})))) + +(deftest polymorphic-refs-with-ref-name-unspecified + ;; differs from above in that we leave out {:refs {:watched-id :tc0}} + (is-graph= (:data (sm/add-ents {:schema td/polymorphic-schema} + {:watch [[1 {:ref-types {:watched-id :topic-category}}]]})) + (-> (lg/digraph [:topic-category :tc0] [:watch :w0] [:w0 :tc0]) + (lat/add-attr :topic-category :type :ent-type) + (lat/add-attr :tc0 :type :ent) + (lat/add-attr :tc0 :index 0) + (lat/add-attr :tc0 :query-term [:_]) + (lat/add-attr :tc0 :ent-type :topic-category) + + (lat/add-attr :watch :type :ent-type) + (lat/add-attr :w0 :type :ent) + (lat/add-attr :w0 :index 0) + (lat/add-attr :w0 :query-term [1 {:ref-types {:watched-id :topic-category}}]) + (lat/add-attr :w0 :ent-type :watch) + (lat/add-attr :w0 :tc0 :relation-attrs #{:watched-id})))) + +(deftest polymorphic-refs-nested + ;; refer to topic instead of topic-category + ;; topic depends on topic-category and will create one + (is-graph= (:data (sm/add-ents {:schema td/polymorphic-schema} + {:watch [[1 {:refs {:watched-id :t0} + :ref-types {:watched-id :topic}}]]})) + (-> (lg/digraph [:topic-category :tc0] + [:topic :t0] + [:watch :w0] + [:w0 :t0] + [:t0 :tc0]) + (lat/add-attr :topic-category :type :ent-type) + (lat/add-attr :tc0 :type :ent) + (lat/add-attr :tc0 :index 0) + (lat/add-attr :tc0 :query-term [:_]) + (lat/add-attr :tc0 :ent-type :topic-category) + + (lat/add-attr :topic :type :ent-type) + (lat/add-attr :t0 :type :ent) + (lat/add-attr :t0 :index 0) + (lat/add-attr :t0 :query-term [:_]) + (lat/add-attr :t0 :ent-type :topic) + (lat/add-attr :t0 :tc0 :relation-attrs #{:topic-category-id}) + + (lat/add-attr :watch :type :ent-type) + (lat/add-attr :w0 :type :ent) + (lat/add-attr :w0 :index 0) + (lat/add-attr :w0 :query-term [1 {:refs {:watched-id :t0} + :ref-types {:watched-id :topic}}]) + (lat/add-attr :w0 :ent-type :watch) + (lat/add-attr :w0 :t0 :relation-attrs #{:watched-id})))) + +(deftest polymorphic-refs-with-binding + ;; refer to topic instead of topic-category + ;; topic depends on topic-category and will create one + (is-graph= (:data (sm/add-ents {:schema td/polymorphic-schema} + {:watch [[1 {:refs {:watched-id :t0} + :bind {:topic-category :tc100} + :ref-types {:watched-id :topic}}]]})) + (-> (lg/digraph [:topic-category :tc100] + [:topic :t0] + [:watch :w0] + [:w0 :t0] + [:t0 :tc100]) + (lat/add-attr :topic-category :type :ent-type) + (lat/add-attr :tc100 :type :ent) + (lat/add-attr :tc100 :index 0) + (lat/add-attr :tc100 :query-term [:_ {:bind {:topic-category :tc100}}]) + (lat/add-attr :tc100 :ent-type :topic-category) + + (lat/add-attr :topic :type :ent-type) + (lat/add-attr :t0 :type :ent) + (lat/add-attr :t0 :index 0) + (lat/add-attr :t0 :query-term [:_ {:bind {:topic-category :tc100}}]) + (lat/add-attr :t0 :ent-type :topic) + (lat/add-attr :t0 :tc100 :relation-attrs #{:topic-category-id}) + + (lat/add-attr :watch :type :ent-type) + (lat/add-attr :w0 :type :ent) + (lat/add-attr :w0 :index 0) + (lat/add-attr :w0 :query-term [1 {:refs {:watched-id :t0} + :bind {:topic-category :tc100} + :ref-types {:watched-id :topic}}]) + (lat/add-attr :w0 :ent-type :watch) + (lat/add-attr :w0 :t0 :relation-attrs #{:watched-id})))) + +(deftest test-coll-relation-attr? + (let [db (sm/add-ents {:schema td/schema} {:project [[1]]})] + (is (sm/coll-relation-attr? db :p0 :todo-list-ids)) + (is (not (sm/coll-relation-attr? db :p0 :created-by-id))))) + +(deftest test-ents-by-type + (let [db (sm/add-ents {:schema td/schema} {:project [[1]]})] + (is (= {:user #{:u0} + :todo-list #{:tl0} + :project #{:p0}} + (sm/ents-by-type db))) + (is (= {:user #{:u0}} + (sm/ents-by-type db [:u0]))))) + +(deftest test-ent-relations + (let [db (sm/add-ents {:schema td/schema} + {:project [[:p0 {:refs {:todo-list-ids 2}}]] + :todo [[1]]})] + (is (= {:created-by-id :u0 + :updated-by-id :u0 + :todo-list-ids #{:tl0 :tl1}} + (sm/ent-relations db :p0))) + (is (= {:created-by-id :u0 + :updated-by-id :u0 + :todo-list-id :tl0} + (sm/ent-relations db :t0))))) + +(deftest test-all-ent-relations + (let [db (sm/add-ents {:schema td/schema} + {:project [[:p0 {:refs {:todo-list-ids 2}}]]})] + (is (= {:project {:p0 {:created-by-id :u0 + :updated-by-id :u0 + :todo-list-ids #{:tl0 :tl1}}} + :user {:u0 {}} + :todo-list {:tl0 {:created-by-id :u0 + :updated-by-id :u0} + :tl1 {:created-by-id :u0 + :updated-by-id :u0}}} + (sm/all-ent-relations db))) + (is (= {:project {:p0 {:created-by-id :u0 + :updated-by-id :u0 + :todo-list-ids #{:tl0 :tl1}}} + :todo-list {:tl0 {:created-by-id :u0 + :updated-by-id :u0}}} + (sm/all-ent-relations db [:p0 :tl0]))) + (is (= {:project {:p0 {:created-by-id :u0 + :updated-by-id :u0 + :todo-list-ids #{:tl0 :tl1}}}} + (sm/all-ent-relations db [:p0]))))) + +(deftest assert-schema-refs-must-exist + (is (thrown-with-msg? #?(:clj java.lang.AssertionError + :cljs js/Error) + #"Your schema relations reference nonexistent types: " + (sm/add-ents {:schema {:user {:relations {:u1 [:circle :circle-id]}}}} + {})))) + +(deftest assert-no-dupe-prefixes + (is (thrown-with-msg? #?(:clj java.lang.AssertionError + :cljs js/Error) + #"You have used the same prefix for multiple entity types: " + (sm/add-ents {:schema {:user {:prefix :u} + :user2 {:prefix :u}}} + {})))) + +(deftest assert-constraints-must-ref-existing-relations + (is (thrown-with-msg? #?(:clj java.lang.AssertionError + :cljs js/Error) + #"Schema constraints reference nonexistent relation attrs: \{:user #\{:blarb\}\}" + (sm/add-ents {:schema {:user {:prefix :u + :constraints {:blarb :coll}}}} + {})))) + +(deftest assert-query-does-not-contain-unknown-ent-types + (is (thrown-with-msg? #?(:clj java.lang.AssertionError + :cljs js/Error) + #"The following ent types are in your query but aren't defined in your schema: #\{:bluser\}" + (sm/add-ents {:schema {:user {:prefix :u}}} + {:bluser [[1]]})))) + +(deftest enforces-coll-schema-constraints + (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo + :cljs js/Object) + #"Query-relations for coll attrs must be a number or vector" + (sm/add-ents {:schema td/schema} {:project [[:_ {:refs {:todo-list-ids :tl0}}]]})))) + +(deftest enforces-unary-schema-constraints + (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo + :cljs js/Object) + #"Query-relations for unary attrs must be a keyword" + (sm/add-ents {:schema td/schema} {:attachment [[:_ {:refs {:todo-id [:t0 :t1]}}]]})))) diff --git a/test-resources/lib_tests/reifyhealth/specmonstah/spec_gen_test.cljc b/test-resources/lib_tests/reifyhealth/specmonstah/spec_gen_test.cljc new file mode 100644 index 00000000..2e6bf03a --- /dev/null +++ b/test-resources/lib_tests/reifyhealth/specmonstah/spec_gen_test.cljc @@ -0,0 +1,283 @@ +(ns reifyhealth.specmonstah.spec-gen-test + (:require #?(:clj [clojure.test :refer [deftest is are use-fixtures testing]] + :cljs [cljs.test :include-macros true :refer [deftest is are use-fixtures testing]]) + [clojure.spec.alpha :as s] + [clojure.test.check.generators :as gen :include-macros true] + [reifyhealth.specmonstah.test-data :as td] + [reifyhealth.specmonstah.core :as sm] + [reifyhealth.specmonstah.spec-gen :as sg] + [medley.core :as medley])) + +(def gen-data-db (atom [])) +(def gen-data-cycle-db (atom [])) + +(defn reset-dbs [f] + (reset! gen-data-db []) + (reset! gen-data-cycle-db []) + (f)) + +(use-fixtures :each td/test-fixture reset-dbs) + +(defn ids-present? + [generated] + (every? pos-int? (map :id (vals generated)))) + +(defn only-has-ents? + [generated ent-names] + (= (set (keys generated)) + (set ent-names))) + +(defn ids-match? + "Reference attr vals equal their referent" + [generated matches] + (every? (fn [[ent id-path-map]] + (every? (fn [[attr id-path-or-paths]] + (if (vector? (first id-path-or-paths)) + (= (set (map (fn [id-path] (get-in generated id-path)) id-path-or-paths)) + (set (get-in generated [ent attr]))) + (= (get-in generated id-path-or-paths) + (get-in generated [ent attr])))) + id-path-map)) + matches)) + +(deftest test-spec-gen + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[1]]})] + (is (td/submap? {:u0 {:user-name "Luigi"}} gen)) + (is (ids-present? gen)) + (is (ids-match? gen + {:tl0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]}})) + (is (only-has-ents? gen #{:tl0 :u0})))) + +(deftest test-spec-gen-nested + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:project [[:_ {:refs {:todo-list-ids 3}}]]})] + (is (td/submap? {:u0 {:user-name "Luigi"}} gen)) + (is (ids-present? gen)) + (is (ids-match? gen + {:tl0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :tl1 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :tl2 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :p0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id] + :todo-list-ids [[:tl0 :id] + [:tl1 :id] + [:tl2 :id]]}})) + (is (only-has-ents? gen #{:tl0 :tl1 :tl2 :u0 :p0})))) + +(deftest test-spec-gen-manual-attr + (testing "Manual attribute setting for non-reference field" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo [[:_ {:spec-gen {:todo-title "pet the dog"}}]]})] + (is (td/submap? {:u0 {:user-name "Luigi"} + :t0 {:todo-title "pet the dog"}} + gen)) + (is (ids-present? gen)) + (is (ids-match? gen + {:tl0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :t0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id] + :todo-list-id [:tl0 :id]}})) + (is (only-has-ents? gen #{:tl0 :t0 :u0})))) + + (testing "Manual attribute setting for reference field" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo [[:_ {:spec-gen {:created-by-id 1}}]]})] + (is (td/submap? {:u0 {:user-name "Luigi"} + :t0 {:created-by-id 1}} + gen)) + (is (ids-present? gen)) + (is (ids-match? gen + {:tl0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :t0 {:updated-by-id [:u0 :id] + :todo-list-id [:tl0 :id]}})) + (is (only-has-ents? gen #{:tl0 :t0 :u0}))))) + +(deftest test-spec-gen-omit + (testing "Ref not created and attr is not present when omitted" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[:_ {:refs {:created-by-id ::sm/omit + :updated-by-id ::sm/omit}}]]})] + (is (ids-present? gen)) + (is (only-has-ents? gen #{:tl0})) + (is (= [:id] (keys (:tl0 gen)))))) + + (testing "Ref is created when at least 1 field references it, but omitted attrs are still not present" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[:_ {:refs {:updated-by-id ::sm/omit}}]]})] + (is (td/submap? {:u0 {:user-name "Luigi"}} gen)) + (is (ids-present? gen)) + (is (ids-match? gen + {:tl0 {:created-by-id [:u0 :id]}})) + (is (only-has-ents? gen #{:tl0 :u0})) + (is (= [:id :created-by-id] (keys (:tl0 gen)))))) + + (testing "Overwriting value of omitted ref with custom value" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[:_ {:refs {:updated-by-id ::sm/omit} + :spec-gen {:updated-by-id 42}}]]})] + (is (ids-present? gen)) + (is (= 42 (-> gen :tl0 :updated-by-id))))) + + (testing "Overwriting value of omitted ref with nil" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[:_ {:refs {:updated-by-id ::sm/omit} + :spec-gen {:updated-by-id nil}}]]})] + (is (ids-present? gen)) + (is (= nil (-> gen :tl0 :updated-by-id)))))) + +(deftest overwriting + (testing "Overwriting generated value with query map" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[:_ {:spec-gen {:updated-by-id 42}}]]})] + (is (ids-present? gen)) + (is (= 42 (-> gen :tl0 :updated-by-id))))) + + (testing "Overwriting generated value with query fn" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:todo-list [[:_ {:spec-gen #(assoc % :updated-by-id :foo)}]]})] + (is (ids-present? gen)) + (is (= :foo (-> gen :tl0 :updated-by-id))))) + + (testing "Overwriting generated value with schema map" + (let [gen (sg/ent-db-spec-gen-attr + {:schema (assoc-in td/schema [:todo :spec-gen :todo-title] "schema title")} + {:todo [[:_ {:spec-gen #(assoc % :updated-by-id :foo)}]]})] + (is (ids-present? gen)) + (is (= "schema title" (-> gen :t0 :todo-title))))) + + (testing "Overwriting generated value with schema fn" + (let [gen (sg/ent-db-spec-gen-attr + {:schema (assoc-in td/schema [:todo :spec-gen] #(assoc % :todo-title "boop whooop"))} + {:todo [[:_ {:spec-gen #(assoc % :updated-by-id :foo)}]]})] + (is (ids-present? gen)) + (is (= "boop whooop" (-> gen :t0 :todo-title)))))) + +(deftest test-idempotency + (testing "Gen traversal won't replace already generated data with newly generated data" + (let [gen-fn #(sg/ent-db-spec-gen % {:todo [[:t0 {:spec-gen {:todo-title "pet the dog"}}]]}) + first-pass (gen-fn {:schema td/schema})] + (is (= (:data first-pass) + (:data (gen-fn first-pass))))))) + + +(deftest test-coll-relval-order + (testing "When a relation has a `:coll` constraint, order its vals correctly") + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:project [[:_ {:refs {:todo-list-ids 3}}]]})] + (is (td/submap? {:u0 {:user-name "Luigi"}} gen)) + (is (ids-present? gen)) + (is (= (:todo-list-ids (:p0 gen)) + [(:id (:tl0 gen)) + (:id (:tl1 gen)) + (:id (:tl2 gen))])) + (is (only-has-ents? gen #{:tl0 :tl1 :tl2 :u0 :p0})))) + +(deftest test-sets-custom-relation-val + (let [gen (sg/ent-db-spec-gen-attr {:schema td/schema} {:user [[:custom-user {:spec-gen {:id 100}}]] + :todo-list [[:custom-tl {:refs {:created-by-id :custom-user + :updated-by-id :custom-user}}]]})] + (is (td/submap? {:custom-user {:user-name "Luigi" + :id 100}} + gen)) + (is (ids-present? gen)) + (is (ids-match? gen + {:custom-tl {:created-by-id [:custom-user :id] + :updated-by-id [:custom-user :id]}})) + (is (only-has-ents? gen #{:custom-tl :custom-user})))) + +;; testing inserting +(defn insert + [{:keys [data] :as db} {:keys [ent-name visit-key attrs]}] + (swap! gen-data-db conj [(:ent-type attrs) ent-name (sg/spec-gen-visit-key attrs)])) + +(deftest test-insert-gen-data + (-> (sg/ent-db-spec-gen {:schema td/schema} {:todo [[1]]}) + (sm/visit-ents-once :inserted-data insert)) + + ;; gen data is something like: + ;; [[:user :u0 {:id 1 :user-name "Luigi"}] + ;; [:todo-list :tl0 {:id 2 :created-by-id 1 :updated-by-id 1}] + ;; [:todo :t0 {:id 5 + ;; :todo-title "write unit tests" + ;; :created-by-id 1 + ;; :updated-by-id 1 + ;; :todo-list-id 2}]] + + (let [gen-data @gen-data-db] + (is (= (set (map #(take 2 %) gen-data)) + #{[:user :u0] + [:todo-list :tl0] + [:todo :t0]})) + + (let [ent-map (into {} (map #(vec (drop 1 %)) gen-data))] + (is (td/submap? {:u0 {:user-name "Luigi"} + :t0 {:todo-title "write unit tests"}} + ent-map)) + (is (ids-present? ent-map)) + (is (ids-match? ent-map + {:tl0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :t0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id] + :todo-list-id [:tl0 :id]}}))))) + +(deftest inserts-novel-data + (testing "Given a db with a todo already added, next call adds a new + todo that references the same todo list and user" + (let [db1 (-> (sg/ent-db-spec-gen {:schema td/schema} {:todo [[1]]}) + (sm/visit-ents-once :inserted-data insert))] + (-> (sg/ent-db-spec-gen db1 {:todo [[1]]}) + (sm/visit-ents-once :inserted-data insert)) + + (let [gen-data @gen-data-db] + (is (= (set (map #(take 2 %) gen-data)) + #{[:user :u0] + [:todo-list :tl0] + [:todo :t0] + [:todo :t1]})) + + (let [ent-map (into {} (map #(vec (drop 1 %)) gen-data))] + (is (td/submap? {:u0 {:user-name "Luigi"} + :t0 {:todo-title "write unit tests"} + :t1 {:todo-title "write unit tests"}} + ent-map)) + (is (ids-present? ent-map)) + (is (ids-match? ent-map + {:tl0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id]} + :t0 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id] + :todo-list-id [:tl0 :id]} + :t1 {:created-by-id [:u0 :id] + :updated-by-id [:u0 :id] + :todo-list-id [:tl0 :id]}}))))))) + +(defn insert-cycle + [db {:keys [ent-name visit-key]}] + (do (swap! gen-data-cycle-db conj ent-name) + (sm/ent-attr db ent-name sg/spec-gen-visit-key))) + +(deftest handle-cycles-with-constraints-and-reordering + (testing "todo-list is inserted before todo because todo requires todo-list" + (-> (sg/ent-db-spec-gen {:schema td/cycle-schema} {:todo [[1]]}) + (sm/visit-ents :insert-cycle insert-cycle)) + (is (= @gen-data-cycle-db + [:tl0 :t0])))) + +(deftest handles-cycle-ids + (testing "spec-gen correctly sets foreign keys for cycles" + (let [gen (sg/ent-db-spec-gen-attr {:schema td/cycle-schema} {:todo [[1]]})] + (is (ids-present? gen)) + (is (ids-match? gen + {:t0 {:todo-list-id [:tl0 :id]} + :tl0 {:first-todo-id [:t0 :id]}}))))) + +(deftest throws-exception-on-2nd-map-ent-attr-try + (testing "insert-cycle fails because the schema contains a :required cycle" + (is (thrown-with-msg? #?(:clj clojure.lang.ExceptionInfo + :cljs js/Object) + #"Can't sort ents: check for cycles in ent type relations" + (-> (sm/add-ents {:schema {:todo {:spec ::todo + :relations {:todo-list-id [:todo-list :id]} + :prefix :t} + :todo-list {:spec ::todo-list + :relations {:first-todo-id [:todo :id]} + :prefix :tl}}} + {:todo [[1]]}) + (sm/visit-ents :insert-cycle insert-cycle)))))) diff --git a/test-resources/lib_tests/reifyhealth/specmonstah/test_data.cljc b/test-resources/lib_tests/reifyhealth/specmonstah/test_data.cljc new file mode 100644 index 00000000..1019a1c9 --- /dev/null +++ b/test-resources/lib_tests/reifyhealth/specmonstah/test_data.cljc @@ -0,0 +1,110 @@ +(ns reifyhealth.specmonstah.test-data + (:require #?(:clj [clojure.test :refer [deftest is are use-fixtures testing]] + :cljs [cljs.test :include-macros true]) + [clojure.spec.alpha :as s] + [clojure.test.check.generators :as gen :include-macros true] + [clojure.data :as data])) + +;; Test helper functions +(defn submap? + "All vals in m1 are present in m2" + [m1 m2] + (nil? (first (data/diff m1 m2)))) + +(def id-seq (atom 0)) + +(defn test-fixture [f] + (reset! id-seq 0) + (f)) + +(s/def ::id + (s/with-gen + pos-int? + #(gen/fmap (fn [_] (swap! id-seq inc)) (gen/return nil)))) + + +(s/def ::user-name #{"Luigi"}) +(s/def ::user (s/keys :req-un [::id ::user-name])) + +(s/def ::created-by-id ::id) +(s/def ::updated-by-id ::id) + +(s/def ::todo-title string?) +(s/def ::todo (s/keys :req-un [::id ::todo-title ::created-by-id ::updated-by-id])) + +(s/def ::todo-id ::id) +(s/def ::attachment (s/keys :req-un [::id ::todo-id ::created-by-id ::updated-by-id])) + +(s/def ::todo-list (s/keys :req-un [::id ::created-by-id ::updated-by-id])) + +(s/def ::todo-list-id ::id) +(s/def ::watcher-id ::id) +(s/def ::todo-list-watch (s/keys :req-un [::id ::todo-list-id ::watcher-id])) + +;; In THE REAL WORLD todo-list would probably have a project-id, +;; rather than project having some coll of :todo-list-ids +(s/def ::todo-list-ids (s/coll-of ::todo-list-id)) +(s/def ::project (s/keys :req-un [::id ::todo-list-ids ::created-by-id ::updated-by-id])) + +(def schema + {:user {:spec ::user + :prefix :u} + :attachment {:spec ::attachment + :relations {:created-by-id [:user :id] + :updated-by-id [:user :id] + :todo-id [:todo :id]} + :prefix :a} + :todo {:spec ::todo + :relations {:created-by-id [:user :id] + :updated-by-id [:user :id] + :todo-list-id [:todo-list :id]} + :spec-gen {:todo-title "write unit tests"} + :prefix :t} + :todo-list {:spec ::todo-list + :relations {:created-by-id [:user :id] + :updated-by-id [:user :id]} + :prefix :tl} + :todo-list-watch {:spec ::todo-list-watch + :relations {:todo-list-id [:todo-list :id] + :watcher-id [:user :id]} + :constraints {:todo-list-id #{:uniq}} + :prefix :tlw} + :project {:spec ::project + :relations {:created-by-id [:user :id] + :updated-by-id [:user :id] + :todo-list-ids [:todo-list :id]} + :constraints {:todo-list-ids #{:coll}} + :prefix :p}}) + + +(def cycle-schema + {:user {:spec ::user + :prefix :u + :relations {:updated-by-id [:user :id]}} + :todo {:spec ::todo + :relations {:todo-list-id [:todo-list :id]} + :constraints {:todo-list-id #{:required}} + :spec-gen {:todo-title "write unit tests"} + :prefix :t} + :todo-list {:spec ::todo-list + :relations {:first-todo-id [:todo :id]} + :prefix :tl}}) + +(s/def ::topic-category (s/keys :req-un [::id])) + +(s/def ::topic-category-id ::id) +(s/def ::topic (s/keys :req-un [::id ::topic-category-id])) + +(s/def ::watched-id ::id) +(s/def ::watch (s/keys :req-un [::id ::watched-id])) + +(def polymorphic-schema + {:topic-category {:spec ::topic-category + :prefix :tc} + :topic {:spec ::topic + :relations {:topic-category-id [:topic-category :id]} + :prefix :t} + :watch {:spec ::watch + :relations {:watched-id #{[:topic-category :id] + [:topic :id]}} + :prefix :w}})