diff --git a/src/monger/internal/fn.clj b/src/monger/internal/fn.clj new file mode 100644 index 0000000..c3c69c4 --- /dev/null +++ b/src/monger/internal/fn.clj @@ -0,0 +1,73 @@ +;; Copyright (c) 2011-2012 Michael S. Klishin +;; +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns monger.internal.fn) + + +;; +;; Implementation +;; + +(defn- apply-to-values [m f] + "Applies function f to all values in map m" + (into {} (for [[k v] m] + [k (f v)]))) + +;; +;; API +;; + +(defn fpartial + "Like clojure.core/partial but prepopulates last N arguments (first is passed in later)" + [f & args] + (fn [arg & more] (apply f arg (concat args more)))) + +(defprotocol IFNExpansion + (expand-all [x] "Replaces functions with their invocation results, recursively expands maps, evaluates all other values to themselves") + (expand-all-with [x f] "Replaces functions with their invocation results that function f is applied to, recursively expands maps, evaluates all other values to themselves")) + +(extend-protocol IFNExpansion + java.lang.Integer + (expand-all [i] i) + (expand-all-with [i f] i) + + java.lang.Long + (expand-all [l] l) + (expand-all-with [l f] l) + + java.lang.String + (expand-all [s] s) + (expand-all-with [s f] s) + + java.lang.Float + (expand-all [fl] fl) + (expand-all-with [fl f] fl) + + java.lang.Double + (expand-all [d] d) + (expand-all-with [d f] d) + + ;; maps are also functions, so be careful here. MK. + clojure.lang.IPersistentMap + (expand-all [m] (apply-to-values m expand-all)) + (expand-all-with [m f] (apply-to-values m (fpartial expand-all-with f))) + + clojure.lang.PersistentVector + (expand-all [v] (map expand-all v)) + (expand-all-with [v f] (map (fpartial expand-all-with f) v)) + + ;; this distinguishes functions from maps, sets and so on, which are also + ;; clojure.lang.AFn subclasses. MK. + clojure.lang.AFunction + (expand-all [f] (f)) + (expand-all-with [f expander] (expander f)) + + Object + (expand-all [x] x) + (expand-all-with [x f] x)) diff --git a/src/monger/testing.clj b/src/monger/testing.clj index 492d3a7..bd85c25 100644 --- a/src/monger/testing.clj +++ b/src/monger/testing.clj @@ -8,7 +8,10 @@ ;; You must not remove this notice, or any other, from this software. (ns monger.testing - (:require [monger collection])) + (:require [monger.collection :as mc] + [monger.result :as mr]) + (:use [monger.internal.fn :only (expand-all expand-all-with) :as fntools]) + (:import [org.bson.types ObjectId])) ;; @@ -32,6 +35,82 @@ fn-name (symbol (str "purge-" entities))] `(defn ~fn-name [f#] - (monger.collection/remove ~coll-arg) + (mc/remove ~coll-arg) (f#) - (monger.collection/remove ~coll-arg)))) + (mc/remove ~coll-arg)))) + + + +(def factories (atom {})) +(def defaults (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) +(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" + [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" + [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))) + expanded))) + +(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 })) + diff --git a/test/monger/test/atomic_modifiers.clj b/test/monger/test/atomic_modifiers.clj index 8274bac..5cb8c6c 100644 --- a/test/monger/test/atomic_modifiers.clj +++ b/test/monger/test/atomic_modifiers.clj @@ -12,6 +12,8 @@ [monger.operators] [monger.test.fixtures])) +(helper/connect!) + (use-fixtures :each purge-docs purge-things purge-scores) diff --git a/test/monger/test/factory_dsl.clj b/test/monger/test/factory_dsl.clj new file mode 100644 index 0000000..5408116 --- /dev/null +++ b/test/monger/test/factory_dsl.clj @@ -0,0 +1,121 @@ +(ns monger.test.factory-dsl + (:use [clojure.test] + [monger testing joda-time] + [monger.test.fixtures] + [clj-time.core :only [days ago weeks now]]) + (:require [monger.collection :as mc] + [monger.test.helper :as helper]) + (:import [org.bson.types ObjectId] + [org.joda.time DateTime])) + + +(helper/connect!) + +(use-fixtures :each purge-domains purge-pages) + + + +(defaults-for "domains" + :ipv6-enabled false) + +(factory "domains" "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 "domains" "elixir" + :name "elixir-lang.org" + :created-at (fn [] (now)) + :topics (fn [] ["programming" "erlang" "beam" "ruby"]) + :related { + :terms (fn [] ["erlang" "python" "ruby"]) + }) + +(factory "pages" "http://clojure.org/rationale" + :name "/rationale" + :domain-id (parent-id "domains" "clojure")) +(factory "pages" "http://clojure.org/jvm_hosted" + :name "/jvm_hosted") +(factory "pages" "http://clojure.org/runtime_polymorphism" + :name "/runtime_polymorphism") +(factory "pages" "http://clojure.org/lisp" + :name "/lisp") + +(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 (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-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 (= 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))))) diff --git a/test/monger/test/fixtures.clj b/test/monger/test/fixtures.clj index db089f5..3d3a79a 100644 --- a/test/monger/test/fixtures.clj +++ b/test/monger/test/fixtures.clj @@ -11,4 +11,6 @@ (defcleaner things "things") (defcleaner libraries "libraries") (defcleaner scores "scores") -(defcleaner locations "locations") \ No newline at end of file +(defcleaner locations "locations") +(defcleaner domains "domains") +(defcleaner pages "pages") diff --git a/test/monger/test/internal/fn.clj b/test/monger/test/internal/fn.clj new file mode 100644 index 0000000..4d3f915 --- /dev/null +++ b/test/monger/test/internal/fn.clj @@ -0,0 +1,45 @@ +(ns monger.test.internal.fn + (:use [clojure.test] + [monger.internal.fn])) + + +(deftest test-expand-all + (are [i o] (is (= (expand-all i) o)) + { :int (fn [] 1) :str "Clojure" :float (Float/valueOf 11.0) } { :int 1 :str "Clojure" :float (Float/valueOf 11.0 )} + { :long (fn [] (Long/valueOf 11)) } { :long (Long/valueOf 11) } + { + :i 1 + :l (Long/valueOf 1111) + :s "Clojure" + :d (Double/valueOf 11.1) + :f (Float/valueOf 2.5) + :v [1 2 3] + :dyn-v [(fn [] 10) (fn [] 20) (fn [] 30)] + :dyn-i (fn [] 1) + :dyn-s (fn [] "Clojure (expanded)") + :m { :nested "String" } + :dyn-m { :abc (fn [] :abc) :nested { :a { :b { :c (fn [] "d") } } } } + } + { + :i 1 + :l (Long/valueOf 1111) + :s "Clojure" + :d (Double/valueOf 11.1) + :f (Float/valueOf 2.5) + :v [1 2 3] + :dyn-v [10 20 30] + :dyn-i 1 + :dyn-s "Clojure (expanded)" + :m { :nested "String" } + :dyn-m { + :abc :abc + :nested { :a { :b { :c "d" } } } + } + })) + +(deftest test-expand-all-with + (let [expander-fn (fn [f] + (* 3 (f)))] + (are [i o] (is (= (expand-all-with i expander-fn) o)) + { :a 1 :int (fn [] 3) } { :a 1 :int 9 } + { :v [(fn [] 1) (fn [] 11)] :m { :inner (fn [] 3) } :s "Clojure" } { :v [3 33] :m { :inner 9 } :s "Clojure" })))