Merge branch 'factories'

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

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

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)
 
 

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

test/monger/test/fixtures.clj

@@ -12,3 +12,5 @@
 (defcleaner libraries "libraries")
 (defcleaner scores    "scores")
 (defcleaner locations "locations")
+(defcleaner domains   "domains")
+(defcleaner pages     "pages")

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