Initial cut at resource abstraction

- Resource protocol
- basic routing logic
- basic representation matching logic

Codeblogged at http://combinate.us/2010/10/17/resrc-part-1-bootstrapping-an-abstraction/

src/resrc/core.clj

@@ -0,0 +1,76 @@
+(ns resrc.core
+  (:refer-clojure :exclude [get])
+  (:use [clout.core]))
+
+(defprotocol Resource
+  (get [resource request])
+  (put [resource request])
+  (delete [resource request])
+  (post [resource request]))
+
+;;; identifiers
+
+(defn find-resource
+  [routes path]
+  (some (fn [[path-spec resource]]
+          (when-let [params (route-matches path-spec path)]
+            [resource params]))
+        (partition 2 routes)))
+
+;;; representations
+
+(defn component-matches
+  [a b]
+  (or (= :* a) (= :* b) (= a b)))
+
+(defn type-matches
+  [[type-a subtype-a] [type-b subtype-b]]
+  (and (component-matches type-a type-b)
+       (component-matches subtype-a subtype-b)))
+
+(defn find-representation
+  [type representations]
+  (some (fn [[representation-type representation]]
+          (when (type-matches type representation-type)
+            [representation-type representation]))
+        representations))
+
+(defn find-acceptable
+  "accepts-list should be a preference-ordered list of type/subtype tuples like:
+  [[:text :html] [:* :*]]
+
+representations should be a list of type/subtype/representation tuples like:
+  [[[:text :plain] 1]
+   [[:text :html] 2]
+   [[:image :jpeg] 3]]
+
+note that both lists imply preference by their ordering - that is, items earlier
+in each list may be considered \"preferable\"
+ "
+  [accepts-list representations]
+  (some (fn [type] (find-representation type representations))
+        accepts-list))
+
+(def *representations-key* :resrc-representations)
+
+(defn with-representations
+  [obj representations]
+  (with-meta obj (assoc (meta obj) *representations-key* representations)))
+
+(defn representations
+  [obj]
+  (*representations-key* (meta obj)))
+
+;;; synthesis
+
+(defn process-request
+  "method should be a method supported by Resource.
+
+Assumes representations are functions from [resource request & rest] to response."
+  [routes method path accepts-list request]
+  (let [[resource _] (find-resource routes path)]
+    (if-let [[_ representation]
+             (find-acceptable accepts-list (representations resource))]
+      (representation resource (method resource request))
+      :not-acceptable)))
+

test/resrc/test/core.clj

@@ -0,0 +1,67 @@
+(ns resrc.test.core
+  (:refer-clojure :exclude [get])
+  (:use [resrc.core] :reload)
+  (:use [clojure.test]))
+
+
+(deftest test-Resource
+  (let [r (reify Resource
+                 (get [_ _] "fun"))]
+    (is (= "fun" (get r nil)))))
+
+(deftest test-find-resource
+  (let [routes ["/foo" 1
+                "/foo/:id" 2]]
+    (is (= [1 {}] (find-resource routes "/foo")))
+    (is (= [2 {"id" "bar"}] (find-resource routes "/foo/bar")))
+    (is (= nil (find-resource routes "/bar")))))
+
+(deftest test-component-matches
+  (is (component-matches :bar :*))
+  (is (component-matches :* :*))
+  (is (component-matches :foo :foo))
+  (is (not (component-matches :foo :bar))))
+
+(deftest test-type-matches
+  (is (type-matches [:* :*] [:foo :bar]))
+  (is (type-matches [:* :*] [:buz :bang]))
+  (is (type-matches [:foo :*] [:foo :bar]))
+  (is (type-matches [:foo :*] [:foo :baz]))
+  (is (type-matches [:foo :bar] [:foo :bar]))
+
+  (is (not (type-matches [:foo :bar] [:foo :baz])))
+  (is (not (type-matches [:foo :bar] [:fuz :baz])))
+  (is (not (type-matches [:foo :*] [:fuz :baz]))))
+
+(deftest test-find-representation
+  (let [f1 #(1)
+        f2 #(2)
+        f3 #(3)
+        representations
+          [[[:text :plain] f1]
+           [[:text :html] 22]
+           [[:image :jpeg] f3]]]
+    (is (= [[:text :plain] f1] (find-representation [:* :*] representations)))
+    (is (= [[:text :plain] f1] (find-representation [:text :*] representations)))
+    (is (= [[:text :plain] f1] (find-representation [:text :plain] representations)))
+    (is (= [[:text :html] f2] (find-representation [:text :html] representations)))
+    (is (= [[:image :jpeg] f3] (find-representation [:image :jpeg] representations)))))
+
+(deftest test-find-acceptable
+    (let [representations
+          [[[:text :plain] 1]
+           [[:text :html] 2]
+           [[:image :jpeg] 3]]]
+
+      (is (= [[:text :plain] 1] (find-acceptable [[:* :*]] representations)))
+      (is (= [[:text :plain] 1] (find-acceptable [[:text :plain]] representations)))
+      (is (= [[:text :html] 2] (find-acceptable [[:text :html] [:* :*]] representations)))
+      (is (= [[:image :jpeg] 3] (find-acceptable [[:image :jpeg] [:* :*]] representations)))))
+
+(deftest test-process-request
+  (let [resource
+        (with-representations
+          (reify Resource (get [_ request] (str request "bar ")))
+          [[[:text :plain] (fn [resource response] (str response "baz"))]])]
+   (is (= "foo bar baz"
+          (process-request ["/bar" resource] get "/bar" [[:text :plain]] "foo ")))))