Commits

Steve Losh  committed 2c76d55

Initial commit.

  • Participants

Comments (0)

Files changed (8)

+/target
+/lib
+/classes
+/checkouts
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins
+syntax: glob
+target/
+lib/
+classes/
+checkouts/
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins

File README.markdown

+# red-tape
+
+A Clojure library designed to ... well, that part is up to you.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2012 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.
+(defproject red-tape "0.1.0"
+  :description "Web forms in Clojure."
+  :url "http://sjl.bitbucket.org/red-tape/"
+  :license {:name "MIT/X11"}
+  :dependencies [[org.clojure/clojure "1.4.0"]
+                 [slingshot "0.10.3"]])

File src/red_tape/cleaners.clj

+(ns red-tape.cleaners
+  (:require [slingshot.slingshot :refer [try+ throw+]]))
+
+(defmacro ensure-is [value f msg]
+  `(let [v# ~value]
+     (if-not (~f v#)
+       (throw+ ~msg)
+       v#)))
+
+(defmacro ensure-not [value f msg]
+  `(let [v# ~value]
+     (if (~f v#)
+       (throw+ ~msg)
+       v#)))
+
+
+(defn non-blank [s]
+  (ensure-not s #(= "" %1)
+              "This field is required."))
+
+(defn to-long [s]
+  (Long. s))
+
+(defn positive [n]
+  (ensure-is n pos?
+             "Please enter a positive number."))
+
+(defn negative [n]
+  (ensure-is n neg?
+             "Please enter a negative number."))
+
+(defn min-length [n s]
+  (ensure-not s #(< (count %) n)
+              (str "This field must be at least " n " characters.")))
+
+(defn max-length [n s]
+  (ensure-not s #(> (count %) n)
+              (str "This field must be at most " n " characters.")))
+(defn choices [cs v]
+  (ensure-is v #(contains? cs %)
+             "Invalid choice."))
+
+(defn to-nil [s]
+  (if (= s "")
+    nil
+    s))

File src/red_tape/core.clj

+(ns red-tape.core
+  (:require [slingshot.slingshot :refer [try+ throw+]]))
+
+
+(defmacro map-for [& body]
+  `(into {} (for ~@body)))
+
+
+(defn pipe-through
+  "Pipe the data through each function.
+
+  Returns a [results error] pair, one of which will always be nil.
+
+  "
+  [data fns]
+  (try+
+    [(reduce #(%2 %1) data fns) nil]
+    (catch Object error
+      [nil error])))
+
+
+(defn zip-fields
+  "Zip the fields and data together into a unified vector.
+
+  Fields should be a vector of pairs of keys and cleaners:
+
+  [
+  [:username [...cleaners...]]
+  [:password [...cleaners...]]
+  [:bio      [...cleaners...]]
+  ]
+
+  Data should be a map of those keys (as strings or keywords) to their data.  If
+  no data is given an empty string will be used:
+
+  {
+  \"username\" \"sjl\"
+  :password \"hunter2\"
+  }
+
+  This will result in a vector of triples:
+
+  [
+  [:username \"sjl\"     [...cleaners...]]
+  [:password \"hunter2\" [...cleaners...]]
+  [:bio      \"\"        [...cleaners...]]
+  ]
+
+  "
+  [fields data]
+  (for [[field-name cleaners] fields]
+    [field-name (get data (keyword field-name) "") cleaners]))
+
+(defn process-fields
+  "Process the zipped fields and return a map of the outcome.
+
+  The map returned will contain two entries:
+
+  {:results ... :errors ...}
+
+  One of these will always be nil.  The other will be a map of field keys to the
+  outcome:
+
+  {:results {:username \"cleaned-username\"} :errors nil}
+  {:errors {:username \"This field cannot be blank.\"} :results nil}
+
+  "
+  [zipped-fields]
+  (let [results (for [[k data cleaners] zipped-fields
+                      :let [[value error] (pipe-through data cleaners)]]
+                  [k value error])
+        values (map-for [[k v _] results]
+                         [k v])
+        errors (map-for [[k _ e] results
+                         :when (not (nil? e))]
+                        [k e])]
+    (if (empty? errors)
+      {:results values :errors nil}
+      {:results nil :errors errors})))
+
+(defn get-cleaners
+  "Return a set of form-cleaner sequences.
+
+  clean can be given as one of the following:
+
+  nil
+  single fn
+  a collection of fns
+  a set of (single fn or collection of fns)
+
+  "
+  [clean]
+  (letfn [(cleaner-to-cleaner-seq [c]
+            (if (coll? c)
+              c
+              [c]))]
+    (cond
+      (nil? clean)  #{}
+      (set? clean)  (set (map cleaner-to-cleaner-seq clean))
+      (coll? clean) #{clean}
+      :else         #{[clean]})))
+
+(defn clean-results
+  "Run the whole-form cleaners over the results.
+
+  Takes the preliminary set of results (from per-field cleaning) and run the
+  whole-form cleaners on them.
+
+  Assumes that there were no errors on the per-field cleaning side of things.
+
+  Returns a [results errors] pair.  One of these will always be nil.
+
+  Results is a map of the cleaned values.
+
+  Errors is a vector of errors from the various form-cleaning sequences.
+
+  "
+  [results cleaner-set]
+  (loop [results results
+         errors []
+         [c & cs] (vec cleaner-set)]
+    (if-not c
+      (if (empty? errors)
+        [results nil]
+        [nil errors])
+      (let [[cleaned-results error] (pipe-through results c)]
+        (if error
+          (recur results (conj errors error) cs)
+          (recur cleaned-results errors cs))))))
+
+
+(defn process-result
+  "Take the preliminary, per-field-cleaned results and process them.
+
+  clean-spec is the cleaners option given in the defform, which can be a single
+  function, a sequence of functions, or a set of either of the above.
+
+  "
+  [{:keys [results errors]} clean-spec]
+  (if errors
+    ; If the individual fields had some errors, we don't even bother trying to
+    ; clean the form as a whole.  Just bail.
+    {:results nil
+     :errors errors
+     :valid false}
+    (let [form-cleaners (get-cleaners clean-spec)
+          [results form-errors] (clean-results results form-cleaners)]
+      (if form-errors
+        {:results nil
+         :errors {:form form-errors}
+         :valid false}
+        {:results results
+         :errors nil
+         :valid true}))))
+
+
+(defn initial-data
+  "Return the initial data for a fresh form."
+  [field-keys initial]
+  (let [blank (into {} (map #(vector % "") field-keys))]
+    (merge blank initial)))
+
+(defn zip-map [a b]
+  (into {} (map vector a b)))
+
+(defn form-guts
+  "For internal use only.  You probably want form or defform.  Turn back now.
+
+  Return the guts of a form, suitable for splicing into (fn ..)
+  or (defn name ...).
+
+  "
+  [{:keys [bindings initial clean]} fields]
+  (let [initial (or initial {})
+        bindings (or bindings [])
+        binding-keys (map keyword bindings)
+
+        ; Create the binding map, which is a map of keywords to symbols:
+        ;
+        ; {:f1 f1 :f2 f2}
+        ;
+        ; This will end up being the body for (part of) the form function:
+        ;
+        ; (defn foo-form [f1 f2]
+        ;   {:bindings {:f1 f1 :f2 f2}})
+        binding-map (zip-map binding-keys bindings)
+
+        ; Transform fields from:
+        ;
+        ; [:f1 [a] :f2 [b]]
+        ;
+        ; into vector pairs like:
+        ;
+        ; [[:f1 [a]]
+        ;  [:f2 [b]]]
+        fields (mapv vec (partition 2 fields))
+
+        ; Get a vector of just the field keys like [:f1 :f2].
+        field-keys (mapv first fields)
+
+        ; A fresh, unbound form simply returns a map.
+        fresh-body `{:fresh true
+                     :bindings {}
+                     :data (initial-data ~field-keys ~initial)
+                     :valid nil
+                     :errors nil
+                     :results nil}
+
+        ; A fresh, bound form includes the bindings in the map.
+        fresh-body-bound (assoc fresh-body :bindings binding-map)]
+    (remove nil?
+            [`([] ~fresh-body)
+             (when-not (empty? bindings)
+               `([~@bindings] ~fresh-body-bound))
+             `([~@bindings data#]
+               (-> ~fields
+                 (zip-fields data#)
+                 process-fields
+                 (process-result ~clean)
+                 (assoc :fresh false
+                        :data data#
+                        :bindings ~binding-map)))])))
+
+
+(defmacro form
+  [{:keys [bindings initial clean] :as options} & fields]
+  `(fn ~@(form-guts options fields)))
+
+(defmacro defform
+  [form-name {:keys [bindings initial clean] :as options} & fields]
+  `(defn ~form-name ~@(form-guts options fields)))
+

File test/red_tape/cleaners_test.clj

+(ns red-tape.cleaners-test
+  (:require [clojure.test :refer :all]
+            [red-tape.cleaners :as cl]
+            [slingshot.slingshot :refer [try+]]))
+
+
+(defmacro throws [& body]
+  `(~'is (not (nil? (try+ (do ~@body nil)
+                        (catch Object e# e#))))))
+
+(defmacro are-bad [msg test-fn & values]
+  `(testing ~msg
+     ~@(map (fn [v]
+         `(throws (~test-fn ~v))) values)))
+
+
+(deftest test-non-blank
+  (testing
+    "non-blank passes through non-blank values"
+    (are [s] (= s (cl/non-blank s))
+         "a"
+         "foo"
+         " "))
+
+  (are-bad
+    "non-blank throws on blank values"
+    cl/non-blank
+    ""))
+
+(deftest test-to-long
+  (testing
+    "to-long converts strings to longs"
+    (are [s result] (= (cl/to-long s) result)
+         "0" 0
+         "10" 10
+         "-20" -20))
+
+  (are-bad
+    "to-long throws on bad data"
+    cl/to-long
+    ""
+    "dogs"
+    "a10"
+    "   10"
+    "10a"))
+
+(deftest test-positive
+  (testing
+    "positive passes through positive numbers"
+    (are [n] (= n (cl/positive n))
+         10
+         20
+         10.5
+         0.2
+         100000))
+
+  (are-bad
+    "positive throws on non-positive numbers (and garbage)"
+    cl/positive
+    ""
+    "10"
+    "dogs"
+    0
+    -10
+    -1.5))
+
+(deftest test-negative
+  (testing
+    "negative passes through negative numbers"
+    (are [n] (= n (cl/negative n))
+         -10
+         -20
+         -10.5
+         -0.2
+         -100000))
+
+  (are-bad
+    "negative throws on non-negative numbers (and garbage)"
+    cl/negative
+    ""
+    "-10"
+    "dogs"
+    0))

File test/red_tape/core_test.clj

+(ns red-tape.core-test
+  (:require [clojure.test :refer :all]
+            [red-tape.core :refer [defform]]
+            [red-tape.cleaners :as cs]
+            ))
+
+
+(defform number-form {}
+  :n [cs/to-long])
+
+(defform numbers-form {}
+  :n [cs/to-long]
+  :m [cs/to-long])
+
+(defform stripping-number-form {}
+  :n [clojure.string/trim cs/to-long])
+
+(defform state-form {:bindings [states]}
+  :state [clojure.string/trim (partial cs/choices states)])
+
+
+(deftest test-number-form
+  (are [n result]
+       (= (:results (number-form {:n n}))
+          {:n result})
+       "10" 10
+       "1" 1
+       "-42" -42))
+
+(deftest test-numbers-form
+  (are [n m rn rm]
+       (= (:results (numbers-form {:m m :n n}))
+          {:n rn :m rm})
+       "10" "0" 10 0
+       "1" "2" 1 2))
+
+(deftest test-stripping-number-form
+  (are [n result]
+       (= (:results (stripping-number-form {:n n}))
+          {:n result})
+       "     10"   10
+       "1   "       1
+       "   -42  " -42))
+(deftest test-state-form
+  (are [available-states data result]
+       (= (:results (state-form available-states {:state data}))
+          {:state result})
+       #{"pa" "ny"} " ny"   "ny"
+       #{"ny"}      " ny  " "ny"
+       #{"ny"}      "ny"    "ny")
+  (are [available-states data errors]
+       (= (:errors (state-form available-states {:state data}))
+          errors)
+       #{"pa" "ny"} "nj" {:state "Invalid choice."}))
+