Finally get rid of the factory DSL
We did learn some things from it but it just did not work very well. A better solution is coming in the future.
This commit is contained in:
Michael Klishin
parent
3af05ef74c
commit
2012fed7c4
3 changed files with 3 additions and 269 deletions
|
|
@ -7,15 +7,9 @@
|
||||||
;; the terms of this license.
|
;; the terms of this license.
|
||||||
;; You must not remove this notice, or any other, from this software.
|
;; You must not remove this notice, or any other, from this software.
|
||||||
|
|
||||||
(ns ^{:doc "Monger TestKit is an experiment that turned out to be partially successful but partially need to be
|
(ns ^{:doc "Automated testing helpers"}
|
||||||
rethough, redesigned, integrated with MongoDB DB references and simply reimplemented from the ground up
|
|
||||||
one more time. For this exact reason, there is no documentation guide on it.
|
|
||||||
Please keep this in mind if you are considering using it."}
|
|
||||||
monger.testkit
|
monger.testkit
|
||||||
(:require [monger.collection :as mc]
|
(:require [monger.collection :as mc]))
|
||||||
[monger.result :as mr])
|
|
||||||
(:use [monger.internal.fn :only [expand-all expand-all-with]])
|
|
||||||
(:import org.bson.types.ObjectId))
|
|
||||||
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
|
@ -42,106 +36,3 @@
|
||||||
(mc/remove ~coll-arg)
|
(mc/remove ~coll-arg)
|
||||||
(f#)
|
(f#)
|
||||||
(mc/remove ~coll-arg))))
|
(mc/remove ~coll-arg))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(def factories (atom {}))
|
|
||||||
(def defaults (atom {}))
|
|
||||||
(def last-oids (atom {}))
|
|
||||||
|
|
||||||
(defn defaults-for
|
|
||||||
[f-group & { :as attributes }]
|
|
||||||
(swap! defaults (fn [v]
|
|
||||||
(assoc v (name f-group) attributes))))
|
|
||||||
|
|
||||||
(defn factory
|
|
||||||
[f-group f-name & { :as attributes }]
|
|
||||||
(swap! factories (fn [a]
|
|
||||||
(assoc-in a [(name f-group) (name f-name)] attributes))))
|
|
||||||
|
|
||||||
|
|
||||||
(declare build seed remember-oid)
|
|
||||||
(defn- expand-associate-for-building
|
|
||||||
[f]
|
|
||||||
(let [mt (meta f)
|
|
||||||
[f-group f-name] (f)]
|
|
||||||
(:_id (build f-group f-name))))
|
|
||||||
|
|
||||||
(defn- expand-for-building
|
|
||||||
"Expands functions, treating those with association metadata (see `parent-id` for example) specially"
|
|
||||||
[f]
|
|
||||||
(let [mt (meta f)]
|
|
||||||
(if (:associate-gen mt)
|
|
||||||
(expand-associate-for-building f)
|
|
||||||
(f))))
|
|
||||||
|
|
||||||
(defn- expand-associate-for-seeding
|
|
||||||
[f]
|
|
||||||
(let [mt (meta f)
|
|
||||||
[f-group f-name] (f)]
|
|
||||||
(:_id (seed f-group f-name))))
|
|
||||||
|
|
||||||
(defn- expand-for-seeding
|
|
||||||
"Expands functions, treating those with association metadata (see `parent-id` for example) specially,
|
|
||||||
making sure parent documents are persisted first"
|
|
||||||
[f]
|
|
||||||
(let [mt (meta f)]
|
|
||||||
(if (:associate-gen mt)
|
|
||||||
(expand-associate-for-seeding f)
|
|
||||||
(f))))
|
|
||||||
|
|
||||||
(defn build
|
|
||||||
"Generates a new document and returns it.
|
|
||||||
Unless _id field is defined by the factory, it is generated."
|
|
||||||
[f-group f-name & { :as overrides }]
|
|
||||||
(let [d (@defaults (name f-group))
|
|
||||||
attributes (get-in @factories [(name f-group) (name f-name)])
|
|
||||||
merged (merge { :_id (ObjectId.) } d attributes overrides)]
|
|
||||||
(expand-all-with merged expand-for-building)))
|
|
||||||
|
|
||||||
(defn seed
|
|
||||||
"Generates and inserts a new document, then returns it.
|
|
||||||
Unless _id field is defined by the factory, it is generated."
|
|
||||||
[f-group f-name & { :as overrides }]
|
|
||||||
(io!
|
|
||||||
(let [d (@defaults (name f-group))
|
|
||||||
attributes (get-in @factories [(name f-group) (name f-name)])
|
|
||||||
merged (merge { :_id (ObjectId.) } d attributes overrides)
|
|
||||||
expanded (expand-all-with merged expand-for-seeding)]
|
|
||||||
(assert (mr/ok? (mc/insert f-group expanded)))
|
|
||||||
(remember-oid f-group f-name (:_id expanded))
|
|
||||||
expanded)))
|
|
||||||
|
|
||||||
(defn seed-all
|
|
||||||
"Seeds all fixtures in the given collection"
|
|
||||||
[f-group]
|
|
||||||
(io!
|
|
||||||
(let [xs (vec (keys (get @factories f-group)))]
|
|
||||||
(doseq [f-name xs]
|
|
||||||
(seed f-group f-name)))))
|
|
||||||
|
|
||||||
(defn embedded-doc
|
|
||||||
[f-group f-name & { :as overrides }]
|
|
||||||
(fn []
|
|
||||||
(apply build f-group f-name (flatten (vec overrides)))))
|
|
||||||
|
|
||||||
(defn parent-id
|
|
||||||
[f-group f-name]
|
|
||||||
(with-meta (fn []
|
|
||||||
[f-group f-name]) { :associate-gen true :parent-gen true }))
|
|
||||||
|
|
||||||
(defn- remember-oid
|
|
||||||
[f-group f-name oid]
|
|
||||||
(swap! last-oids (fn [a]
|
|
||||||
(assoc-in a [(name f-group) (name f-name)] oid))))
|
|
||||||
|
|
||||||
(defn last-oid-of
|
|
||||||
"Returns last object id of a document inserted using given factory"
|
|
||||||
[f-group f-name]
|
|
||||||
(get-in @last-oids [(name f-group) (name f-name)]))
|
|
||||||
|
|
||||||
|
|
||||||
(def ^{ :doc "Returns a new object id. Generates it if needed, otherwise returns a cached version.
|
|
||||||
Useful for defining referenced associations between fixture documents." }
|
|
||||||
memoized-oid (memoize (fn [f-group f-name]
|
|
||||||
(ObjectId.))))
|
|
||||||
|
|
|
||||||
|
|
@ -1,156 +0,0 @@
|
||||||
(ns monger.test.factory-dsl-test
|
|
||||||
(:use clojure.test
|
|
||||||
[monger testkit]
|
|
||||||
monger.test.fixtures
|
|
||||||
[clj-time.core :only [days ago weeks now]])
|
|
||||||
(:require [monger.collection :as mc]
|
|
||||||
[monger.test.helper :as helper]
|
|
||||||
monger.joda-time)
|
|
||||||
(:import org.bson.types.ObjectId
|
|
||||||
org.joda.time.DateTime))
|
|
||||||
|
|
||||||
|
|
||||||
(helper/connect!)
|
|
||||||
|
|
||||||
(use-fixtures :each purge-domains purge-pages)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defaults-for "domains"
|
|
||||||
:ipv6-enabled false)
|
|
||||||
|
|
||||||
(let [coll "domains"]
|
|
||||||
(factory coll "clojure"
|
|
||||||
:name "clojure.org"
|
|
||||||
:created-at (-> 2 days ago)
|
|
||||||
:embedded [(embedded-doc "pages" "http://clojure.org/lisp")
|
|
||||||
(embedded-doc "pages" "http://clojure.org/jvm_hosted")
|
|
||||||
(embedded-doc "pages" "http://clojure.org/runtime_polymorphism")])
|
|
||||||
|
|
||||||
(factory coll "elixir"
|
|
||||||
:_id (memoized-oid coll "elixir")
|
|
||||||
:name "elixir-lang.org"
|
|
||||||
:created-at (fn [] (now))
|
|
||||||
:topics (fn [] ["programming" "erlang" "beam" "ruby"])
|
|
||||||
:related {
|
|
||||||
:terms (fn [] ["erlang" "python" "ruby"])
|
|
||||||
}))
|
|
||||||
|
|
||||||
(let [coll "pages"]
|
|
||||||
(factory coll "http://clojure.org/rationale"
|
|
||||||
:name "/rationale"
|
|
||||||
:domain-id (parent-id "domains" "clojure"))
|
|
||||||
(factory coll "http://clojure.org/jvm_hosted"
|
|
||||||
:name "/jvm_hosted")
|
|
||||||
(factory coll "http://clojure.org/runtime_polymorphism"
|
|
||||||
:name "/runtime_polymorphism")
|
|
||||||
(factory coll "http://clojure.org/lisp"
|
|
||||||
:name "/lisp")
|
|
||||||
(factory coll "http://elixir-lang.org/getting_started"
|
|
||||||
:name "/getting_started/1.html"
|
|
||||||
:domain-id (memoized-oid "domains" "elixir")))
|
|
||||||
|
|
||||||
|
|
||||||
(deftest test-building-documents-from-a-factory-case-1
|
|
||||||
(let [t (-> 2 weeks ago)
|
|
||||||
doc (build "domains" "clojure" :created-at t)]
|
|
||||||
(is (:_id doc))
|
|
||||||
(is (= t (:created-at doc)))
|
|
||||||
(is (= "clojure.org" (:name doc)))
|
|
||||||
(is (false? (:ipv6-enabled doc)))))
|
|
||||||
|
|
||||||
(deftest test-building-documents-from-a-factory-case-2
|
|
||||||
(let [oid (ObjectId.)
|
|
||||||
doc (build "domains" "clojure" :_id oid)]
|
|
||||||
(is (= oid (:_id doc)))
|
|
||||||
(is (= "clojure.org" (:name doc)))
|
|
||||||
(is (false? (:ipv6-enabled doc)))))
|
|
||||||
|
|
||||||
(deftest test-building-documents-from-a-factory-case-3
|
|
||||||
(let [oid (ObjectId.)
|
|
||||||
t (-> 3 weeks ago)
|
|
||||||
doc (build "domains" "clojure" :_id oid :created-at t :name "clojurewerkz.org" :ipv6-enabled true)]
|
|
||||||
(is (= oid (:_id doc)))
|
|
||||||
(is (= t (:created-at doc)))
|
|
||||||
(is (= "clojurewerkz.org" (:name doc)))
|
|
||||||
(is (:ipv6-enabled doc))
|
|
||||||
(is (= ["/lisp" "/jvm_hosted" "/runtime_polymorphism"]
|
|
||||||
(vec (map :name (:embedded doc)))))))
|
|
||||||
|
|
||||||
|
|
||||||
(deftest test-building-documents-from-a-factory-case-4
|
|
||||||
(let [doc (build "domains" "elixir")]
|
|
||||||
(is (:_id doc))
|
|
||||||
(is (= (:_id doc) (memoized-oid "domains" "elixir")))
|
|
||||||
(is (instance? DateTime (:created-at doc)))
|
|
||||||
(is (= ["erlang" "python" "ruby"] (get-in doc [:related :terms])))
|
|
||||||
(is (= "elixir-lang.org" (:name doc)))
|
|
||||||
(is (not (:ipv6-enabled doc)))))
|
|
||||||
|
|
||||||
(deftest test-building-child-documents-with-a-parent-ref-case-1
|
|
||||||
(let [doc (build "pages" "http://clojure.org/rationale")]
|
|
||||||
(is (:domain-id doc))))
|
|
||||||
|
|
||||||
(deftest test-building-child-documents-that-use-memoized-oids-for-parents
|
|
||||||
(let [doc (build "pages" "http://elixir-lang.org/getting_started")]
|
|
||||||
(is (= (:domain-id doc) (memoized-oid "domains" "elixir")))))
|
|
||||||
|
|
||||||
|
|
||||||
(deftest test-seeding-documents-using-a-factory-case-1
|
|
||||||
(is (mc/empty? "domains"))
|
|
||||||
(let [t (-> 2 weeks ago)
|
|
||||||
doc (seed "domains" "clojure" :created-at t)]
|
|
||||||
(is (= 1 (mc/count "domains")))
|
|
||||||
(is (:_id doc))
|
|
||||||
(is (= (:_id doc) (last-oid-of "domains" "clojure")))
|
|
||||||
(is (= t (:created-at doc)))
|
|
||||||
(is (= "clojure.org" (:name doc)))
|
|
||||||
(is (false? (:ipv6-enabled doc)))))
|
|
||||||
|
|
||||||
(deftest test-seeding-documents-using-a-factory-case-2
|
|
||||||
(is (mc/empty? "domains"))
|
|
||||||
(let [doc (seed "domains" "elixir")
|
|
||||||
loaded (first (mc/find-maps "domains"))]
|
|
||||||
(is (= 1 (mc/count "domains")))
|
|
||||||
(is (:_id doc))
|
|
||||||
(is (= (:_id doc) (:_id loaded)))
|
|
||||||
(is (instance? DateTime (:created-at loaded)))
|
|
||||||
(is (= ["erlang" "python" "ruby"] (get-in loaded [:related :terms])))
|
|
||||||
(is (= "elixir-lang.org" (:name loaded)))
|
|
||||||
(is (not (:ipv6-enabled loaded)))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(deftest test-seeding-child-documents-with-a-parent-ref-case-1
|
|
||||||
(is (mc/empty? "domains"))
|
|
||||||
(is (mc/empty? "pages"))
|
|
||||||
(let [page (seed "pages" "http://clojure.org/rationale")
|
|
||||||
domain (mc/find-map-by-id "domains" (:domain-id page))]
|
|
||||||
(is (= 1 (mc/count "domains")))
|
|
||||||
(is (= 1 (mc/count "pages")))
|
|
||||||
(is domain)
|
|
||||||
(is (:domain-id page))
|
|
||||||
(is (= "clojure.org" (:name domain)))
|
|
||||||
(is (= "/rationale" (:name page)))))
|
|
||||||
|
|
||||||
|
|
||||||
(deftest test-seeding-all-factories-in-a-group
|
|
||||||
(is (mc/empty? "domains"))
|
|
||||||
(is (mc/empty? "pages"))
|
|
||||||
(seed-all "pages")
|
|
||||||
(is (>= (mc/count "domains") 1))
|
|
||||||
(is (>= (mc/count "pages") 4)))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(deftest test-named-memoized-object-ids
|
|
||||||
(let [oid1 (memoized-oid "domains" "clojure.org")
|
|
||||||
oid2 (memoized-oid "domains" "python.org")]
|
|
||||||
(is (= oid1 (memoized-oid "domains" "clojure.org")))
|
|
||||||
(is (= oid1 (memoized-oid "domains" "clojure.org")))
|
|
||||||
(is (= oid1 (memoized-oid "domains" "clojure.org")))
|
|
||||||
(is (= oid1 (memoized-oid "domains" "clojure.org")))
|
|
||||||
(is (not (= oid1 oid2)))
|
|
||||||
(is (= oid2 (memoized-oid "domains" "python.org")))
|
|
||||||
(is (= oid2 (memoized-oid "domains" "python.org")))
|
|
||||||
(is (= oid2 (memoized-oid "domains" "python.org")))))
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
(ns monger.test.fixtures
|
(ns monger.test.fixtures
|
||||||
(:require [monger.collection :as mgcol])
|
(:use [monger.testkit :only [defcleaner]]))
|
||||||
(:use monger.testkit))
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; fixture functions
|
;; fixture functions
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue