Move construction of fact-filter predicates

src/midje/config.clj

@@ -3,7 +3,10 @@
   (:use midje.clojure.core
         [midje.util.exceptions :only [user-error]])
   (:require [midje.emission.levels :as levels]
-            [midje.util.ecosystem :as ecosystem]))
+            [midje.util.ecosystem :as ecosystem]
+            [midje.util.pile :as pile]
+            [midje.data.fact :as fact]))
+
 
 ;;; I consider whether we're running in the repl part of the config. This matters because
 ;;; threads can't examine the stack to see if they're in the repl. So we check once at
@@ -91,7 +94,33 @@
 (def at-or-above? (level-checker >=))
 (def above?(level-checker >))
 
-;; Fact functions
+;; Fact filters
+
+(def describes-name-matcher? stringlike?)
+(defn describes-callable-matcher? [arg]
+  (or (fn? arg) (keyword? arg)))
+
+(defn name-matcher-for [desired]
+  #(pile/stringlike-matches? desired (fact/name %)))
+(defn callable-matcher-for [desired]
+  (comp desired meta))
+
+(defn appropriate-matcher-for [desired]
+  ( (pred-cond desired
+               describes-name-matcher? name-matcher-for
+               describes-callable-matcher? callable-matcher-for
+               :else (throw (Error. (str "Program error: Bad matcher for " desired))))
+    desired))
+
+(defn mkfn:fact-filter-predicate [desireds]
+  (letfn [(make [fun source]
+            (vary-meta fun assoc :created-from source))]
+    (if (empty? desireds)
+      (let [default-filter (choice :fact-filter)]
+        (make (appropriate-matcher-for default-filter) [default-filter]))
+      (make (pile/any-pred-from (map appropriate-matcher-for desireds)) desireds))))
+
+
 
 (defn user-wants-fact-to-be-recorded? [fact]
   ((choice :fact-filter) fact))
@@ -101,3 +130,4 @@
 
 (defn load-config-files []
   (dorun (map load-file ecosystem/config-files)))
+

src/midje/parsing/other/arglists.clj

@@ -5,8 +5,7 @@
         [midje.util.exceptions :only [user-error]])
   (:require [midje.emission.levels :as levels]
             [midje.config :as config]
-            [midje.util.pile :as pile]
-            [midje.data.fact :as fact]))
+            [midje.util.pile :as pile]))
 
 
 ;;;                                           Print levels (keywords)
@@ -25,26 +24,6 @@
 ;;;                                           Metadata filters
 
 
-(def describes-name-matcher? stringlike?)
-(defn describes-callable-matcher? [arg]
-  (or (fn? arg) (keyword? arg)))
-
-(defn name-matcher-for [desired]
-  #(stringlike-matches? desired (fact/name %)))
-(defn callable-matcher-for [desired]
-  (comp desired meta))
-
-(defn appropriate-matcher-for [desired]
-  ( (if (describes-name-matcher? desired) name-matcher-for callable-matcher-for) 
-    desired))
-
-(defn desired-fact-predicate-from [default-filter desireds]
-  (letfn [(make [fun source]
-            (vary-meta fun assoc :created-from source))]
-    (if (empty? desireds)
-      (make (appropriate-matcher-for default-filter) default-filter)
-      (make (pile/any-pred-from (map appropriate-matcher-for desireds)) desireds))))
-
 (defn separate-filters [args plain-argument?]
   (let [[filters remainder]
         (separate #(and (not (plain-argument? %))

src/midje/parsing/util/core.clj

@@ -25,16 +25,6 @@
   (matches-symbols-in-semi-sweet-or-sweet-ns? '(expect fake not-called data-fake) loc))
 
 
-(defn stringlike-matches? [stringlike given]
-  (cond (not (string? given))
-        false
-
-        (string? stringlike)
-        (.contains given stringlike)
-
-        :else
-        (boolean (re-find stringlike given))))
-
 (defn symbol-named?
   "Is the thing a symbol with the name given by the string?"
   [x string]

src/midje/util/pile.clj

@@ -18,7 +18,6 @@
 (defn name-object [object name]
   (vary-meta object assoc :name name))
 
-
 ;;; Maps
 
 (defn tack-on-to
@@ -99,3 +98,16 @@
 
 (defn form-guid [form]
   (DigestUtils/shaHex (pr-str form)))
+
+;;; Randomness
+
+(defn stringlike-matches? [stringlike given]
+  (cond (not (string? given))
+        false
+
+        (string? stringlike)
+        (.contains given stringlike)
+
+        :else
+        (boolean (re-find stringlike given))))
+

test/midje/parsing/other/t_arglists.clj

@@ -55,47 +55,7 @@
       => (just [] an-argument-list))))
 
 
-(facts "about converting filters into functions"
-  (let [a-fact (fn [metadata] (with-meta '[] metadata))]
-    (fact "keywords check for the truthiness of the key in the metadata"
-      (let [fun (desired-fact-predicate-from :default [:property])]
-        (fun (a-fact {:property 'truthy})) => truthy
-        (fun (a-fact {:property false})) => falsey
-        (fun (a-fact {})) => falsey))
-
-    (fact "regexes check the fact's name property"
-      (let [fun (desired-fact-predicate-from :default [#"regex"])]
-        (fun (a-fact {:midje/name "something containing regex."})) => truthy
-        (fun (a-fact {:midje/name "not a match"})) => falsey
-        (fun (a-fact {})) => falsey))
-
-    (fact "strings are treated as substrings"
-      (let [fun (desired-fact-predicate-from :default ["str"])]
-        (fun (a-fact {:midje/name "something str like"})) => truthy
-        (fun (a-fact {:midje/name "not a match"})) => falsey
-        (fun (a-fact {})) => falsey))
-
-    (fact "functions are applied to arguments"
-      (let [fun (desired-fact-predicate-from :default [(fn [meta] (= "yes" (:something meta)))])]
-        (fun (a-fact {:something "yes"})) => truthy
-        (fun (a-fact {:something "no"})) => falsey
-        (fun (a-fact {})) => falsey))
-
-    (fact "multiple arguments are OR'd together"
-      (let [fun (desired-fact-predicate-from :default [#"foo" :valiant])]
-        (fun (a-fact {:midje/name "ofoop"})) => truthy
-        (fun (a-fact {:valiant true})) => truthy
-        (fun (a-fact {})) => falsey))
-
-    (fact "filter predicates know why they were created"
-      (meta (desired-fact-predicate-from :default [:oddity :valiant]))
-      => (contains {:created-from [:oddity :valiant]}))
-
-    (fact "A default function (callable) is used if there are no filter arguments"
-      (let [fun (desired-fact-predicate-from :has-this-meta-key [])]
-        (fun (a-fact {})) => falsey
-        (fun (a-fact {:has-this-meta-key true})) => truthy
-        (meta fun) => (contains {:created-from :has-this-meta-key})))))
+
 
 (fact "arglist parser with :options"
   (let [flag-descriptions [[:dirs :dir] [:interval]]

test/midje/parsing/util/t_core.clj

@@ -20,15 +20,6 @@
           skippable (-> z zip/down zip/next zip/down)]
       skippable => semi-sweet-keyword?)))
 
-(fact "stringlike-matches?"
-  (stringlike-matches? "foo" "ofoop") => true
-  (stringlike-matches? "foo" "ooop") => false
-  (stringlike-matches? "foo" nil) => false
-  (stringlike-matches? "foo" [1 2 3]) => false
-  (stringlike-matches? #"fo." "ofop") => true
-  (stringlike-matches? #"fo." "ooop") => false
-  (stringlike-matches? #"fo." false) => false)
-
 (facts "a form's reader-assigned line-number can be extracted"
   (reader-line-number (with-meta '(fact (this that)) {:line 23})) => 23
   "or, failing that: try top-level subforms"

test/midje/t_config.clj

@@ -47,3 +47,48 @@
     (config/with-augmented-config {:print-level 0}
       (config/choice :print-level) => 0)))
 
+
+
+(facts "about converting filters into functions"
+  (let [a-fact (fn [metadata] (with-meta '[] metadata))]
+    (fact "keywords check for the truthiness of the key in the metadata"
+      (let [fun (config/mkfn:fact-filter-predicate [:property])]
+        (fun (a-fact {:property 'truthy})) => truthy
+        (fun (a-fact {:property false})) => falsey
+        (fun (a-fact {})) => falsey))
+
+    (fact "regexes check the fact's name property"
+      (let [fun (config/mkfn:fact-filter-predicate [#"regex"])]
+        (fun (a-fact {:midje/name "something containing regex."})) => truthy
+        (fun (a-fact {:midje/name "not a match"})) => falsey
+        (fun (a-fact {})) => falsey))
+
+    (fact "strings are treated as substrings"
+      (let [fun (config/mkfn:fact-filter-predicate ["str"])]
+        (fun (a-fact {:midje/name "something str like"})) => truthy
+        (fun (a-fact {:midje/name "not a match"})) => falsey
+        (fun (a-fact {})) => falsey))
+
+    (fact "functions are applied to arguments"
+      (let [fun (config/mkfn:fact-filter-predicate [(fn [meta] (= "yes" (:something meta)))])]
+        (fun (a-fact {:something "yes"})) => truthy
+        (fun (a-fact {:something "no"})) => falsey
+        (fun (a-fact {})) => falsey))
+
+    (fact "multiple arguments are OR'd together"
+      (let [fun (config/mkfn:fact-filter-predicate [#"foo" :valiant])]
+        (fun (a-fact {:midje/name "ofoop"})) => truthy
+        (fun (a-fact {:valiant true})) => truthy
+        (fun (a-fact {})) => falsey))
+
+    (fact "filter predicates know why they were created"
+      (meta (config/mkfn:fact-filter-predicate [:oddity :valiant]))
+      => (contains {:created-from [:oddity :valiant]}))
+
+    (fact "If there are no filter arguments, the fact filter is constructed from the default"
+      ;; Note that the default is not aware it works on metadata.
+      (config/with-augmented-config {:fact-filter :has-this-meta-key}
+        (let [fun (config/mkfn:fact-filter-predicate [])]
+          (fun (a-fact {})) => falsey
+          (fun (a-fact {:has-this-meta-key true})) => truthy
+          (meta fun) => (contains {:created-from [:has-this-meta-key]}))))))

test/midje/util/t_pile.clj

@@ -29,3 +29,12 @@
   ;; Any empty list means that everything matches
   ((any-pred-from []) 3) => true)
 
+(fact "stringlike-matches?"
+  (stringlike-matches? "foo" "ofoop") => true
+  (stringlike-matches? "foo" "ooop") => false
+  (stringlike-matches? "foo" nil) => false
+  (stringlike-matches? "foo" [1 2 3]) => false
+  (stringlike-matches? #"fo." "ofop") => true
+  (stringlike-matches? #"fo." "ooop") => false
+  (stringlike-matches? #"fo." false) => false)
+