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

Initial support for child => parent references in factories

Browse source
This commit is contained in:
Michael S. Klishin 2012-03-06 21:13:34 +04:00
parent 5a2ab1a22b
commit 94abe56605
2 changed files with 29 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/monger/testing.clj
View file

@ -10,7 +10,7 @@
(ns monger.testing (ns monger.testing
(:require [monger.collection :as mc] (:require [monger.collection :as mc]
[monger.result :as mr]) [monger.result :as mr])
(:use [monger.internal.fn :only (expand-all) :as fntools]) (:use [monger.internal.fn :only (expand-all expand-all-with) :as fntools])
(:import [org.bson.types ObjectId])) (:import [org.bson.types ObjectId]))
@ -55,12 +55,27 @@
(assoc-in a [(name f-group) (name f-name)] attributes)))) (assoc-in a [(name f-group) (name f-name)] attributes))))
(declare build seed)
(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
[f]
(let [mt (meta f)]
(if (:associate-gen mt)
(expand-associate-for-building f)
(f))))
(defn build (defn build
"Generates a new document and returns it" "Generates a new document and returns it"
[f-group f-name & { :as overrides }] [f-group f-name & { :as overrides }]
(let [d (@defaults (name f-group)) (let [d (@defaults (name f-group))
attributes (get-in @factories [(name f-group) (name f-name)])] attributes (get-in @factories [(name f-group) (name f-name)])
(expand-all (merge { :_id (ObjectId.) } d attributes overrides)))) merged (merge { :_id (ObjectId.) } d attributes overrides)]
(expand-all-with merged expand-for-building)))
(defn seed (defn seed
"Generates and inserts a new document, then returns it" "Generates and inserts a new document, then returns it"
@ -75,3 +90,9 @@
[f-group f-name & { :as overrides }] [f-group f-name & { :as overrides }]
(fn [] (fn []
(apply build f-group f-name (flatten (vec overrides))))) (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 }))

6
test/monger/test/factory_dsl.clj
View file

@ -34,7 +34,8 @@
}) })
(factory "pages" "http://clojure.org/rationale" (factory "pages" "http://clojure.org/rationale"
:name "/rationale") :name "/rationale"
:domain-id (parent-id "domains" "clojure"))
(factory "pages" "http://clojure.org/jvm_hosted" (factory "pages" "http://clojure.org/jvm_hosted"
:name "/jvm_hosted") :name "/jvm_hosted")
(factory "pages" "http://clojure.org/runtime_polymorphism" (factory "pages" "http://clojure.org/runtime_polymorphism"
@ -77,6 +78,9 @@
(is (= "elixir-lang.org" (:name doc))) (is (= "elixir-lang.org" (:name doc)))
(is (not (:ipv6-enabled 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))))