luciano/babashka
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add coax tests

Browse source
This commit is contained in:
Michiel Borkent 2021-12-08 21:31:58 +01:00
parent 6d14ed61f1
commit f754578075
11 changed files with 1672 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
deps.edn
View file

@ -94,7 +94,9 @@
org.clj-commons/digest {:mvn/version "1.4.100"} org.clj-commons/digest {:mvn/version "1.4.100"}
hato/hato {:mvn/version "0.8.2"} hato/hato {:mvn/version "0.8.2"}
better-cond/better-cond {:mvn/version "2.1.1"} 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 :classpath-overrides {org.clojure/clojure nil
org.clojure/spec.alpha nil}} org.clojure/spec.alpha nil}}
:clj-nvd :clj-nvd

22
feature-test-check/babashka/impl/clojure/test/check.clj
View file

@ -175,3 +175,25 @@
(def test-check-namespace (def test-check-namespace
{'quick-check (sci/copy-var tc/quick-check tc-ns)}) {'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)})

1
src/babashka/impl/classes.clj
View file

@ -414,6 +414,7 @@
clojure.lang.LispReader$Resolver clojure.lang.LispReader$Resolver
clojure.lang.Named clojure.lang.Named
clojure.lang.Keyword clojure.lang.Keyword
clojure.lang.MultiFn
clojure.lang.PersistentArrayMap clojure.lang.PersistentArrayMap
clojure.lang.PersistentHashMap clojure.lang.PersistentHashMap
clojure.lang.PersistentHashSet clojure.lang.PersistentHashSet

7
src/babashka/impl/clojure/test.clj
View file

@ -282,6 +282,13 @@
`(sci/binding [sci/out @test-out] `(sci/binding [sci/out @test-out]
~@body)) ~@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 ;;; UTILITIES FOR REPORTING FUNCTIONS
(defn testing-vars-str (defn testing-vars-str

3
src/babashka/impl/test.clj
View file

@ -56,4 +56,5 @@
;; running tests: high level ;; running tests: high level
'run-tests (new-var 'run-tests (contextualize t/run-tests)) 'run-tests (new-var 'run-tests (contextualize t/run-tests))
'run-all-tests (new-var 'run-all-tests (contextualize t/run-all-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)})

23
src/babashka/main.clj
View file

@ -272,8 +272,8 @@ Use bb run --help to show this help output.
(let [f (io/file file)] (let [f (io/file file)]
(if (.exists f) (if (.exists f)
(as-> (slurp file) x (as-> (slurp file) x
;; remove shebang ;; remove shebang
(str/replace x #"^#!.*" "")) (str/replace x #"^#!.*" ""))
(throw (Exception. (str "File does not exist: " file)))))) (throw (Exception. (str "File does not exist: " file))))))
(defn load-file* [f] (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) 'demunge (sci/copy-var demunge clojure-main-ns)
'repl-requires (sci/copy-var clojure-main/repl-requires clojure-main-ns) 'repl-requires (sci/copy-var clojure-main/repl-requires clojure-main-ns)
'repl (sci/new-var 'repl 'repl (sci/new-var 'repl
(fn [& opts] (fn [& opts]
(let [opts (apply hash-map opts)] (let [opts (apply hash-map opts)]
(repl/start-repl! @common/ctx opts))) {:ns clojure-main-ns})} (repl/start-repl! @common/ctx opts))) {:ns clojure-main-ns})}
'clojure.test t/clojure-test-namespace 'clojure.test t/clojure-test-namespace
'babashka.classpath classpath-namespace 'babashka.classpath classpath-namespace
'clojure.pprint pprint-namespace 'clojure.pprint pprint-namespace
@ -402,7 +402,10 @@ Use bb run --help to show this help output.
'clojure.test.check.properties 'clojure.test.check.properties
@(resolve 'babashka.impl.clojure.test.check/properties-namespace) @(resolve 'babashka.impl.clojure.test.check/properties-namespace)
'clojure.test.check '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 features/spec-alpha? (-> (assoc ;; spec
'clojure.spec.alpha @(resolve 'babashka.impl.spec/spec-namespace) 'clojure.spec.alpha @(resolve 'babashka.impl.spec/spec-namespace)
'clojure.spec.gen.alpha @(resolve 'babashka.impl.spec/gen-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 (assoc opts-map
:verbose? true)) :verbose? true))
("--force") (recur (next options) ("--force") (recur (next options)
(assoc opts-map (assoc opts-map
:force? true)) :force? true))
("--describe") (recur (next options) ("--describe") (recur (next options)
(assoc opts-map (assoc opts-map
:describe? true)) :describe? true))
@ -833,8 +836,8 @@ Use bb run --help to show this help output.
expressions expressions
(sci/binding [sci/file abs-path] (sci/binding [sci/file abs-path]
(try (try
; when evaluating expression(s), add in repl-requires so things like ; when evaluating expression(s), add in repl-requires so things like
; pprint and dir are available ; pprint and dir are available
(sci/eval-form sci-ctx `(apply require (quote ~clojure-main/repl-requires))) (sci/eval-form sci-ctx `(apply require (quote ~clojure-main/repl-requires)))
(loop [] (loop []
(let [in (read-next *in*)] (let [in (read-next *in*)]

4
test-resources/lib_tests/babashka/run_all_libtests.clj
View file

@ -266,6 +266,10 @@
(test-namespaces 'hato.client-test) (test-namespaces 'hato.client-test)
(test-namespaces 'better-cond.core-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 ;;;; final exit code
(let [{:keys [:test :fail :error] :as m} @status] (let [{:keys [:test :fail :error] :as m} @status]

437
test-resources/lib_tests/exoscale/coax_test.cljc Normal file
View file

@ -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})))))

790
test-resources/lib_tests/reifyhealth/specmonstah/core_test.cljc Normal file
View file

@ -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]}}]]}))))

283
test-resources/lib_tests/reifyhealth/specmonstah/spec_gen_test.cljc Normal file
View file

@ -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))))))

110
test-resources/lib_tests/reifyhealth/specmonstah/test_data.cljc Normal file
View file

@ -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}})