Browse files

Better, faster, stronger resrc

- resource macro for succint resource definitions
- precompile resource router to make routing faster
- add ring specific versions of resource macro and request processing function

Codeblogged at http://combinate.us/2010/10/19/resrc-part-2-solidifying-the-abstraction/
  • Loading branch information...
1 parent 5791222 commit d92acc0d8799fc1e8711c7012dbf771f8564ae9d Travis Vachon committed Oct 17, 2010
Showing with 254 additions and 3 deletions.
  1. +39 −2 src/resrc/core.clj
  2. +99 −0 src/resrc/ring.clj
  3. +55 −1 test/resrc/test/core.clj
  4. +61 −0 test/resrc/test/ring.clj
View
41 src/resrc/core.clj
@@ -1,6 +1,6 @@
(ns resrc.core
(:refer-clojure :exclude [get])
- (:use [clout.core]))
+ (:use [clout.core :as clout]))
(defprotocol Resource
(get [resource request])
@@ -13,7 +13,7 @@
(defn find-resource
[routes path]
(some (fn [[path-spec resource]]
- (when-let [params (route-matches path-spec path)]
+ (when-let [params (clout/route-matches path-spec path)]
[resource params]))
(partition 2 routes)))
@@ -74,3 +74,40 @@ Assumes representations are functions from [resource request & rest] to response
(representation resource (method resource request))
:not-acceptable)))
+;;; sugar
+
+(defn emit-resource-handler
+ [[method & forms]]
+ `(~method [~'+resource ~'+request]
+ ~@forms))
+
+(defn split-type
+ [type]
+ [(keyword (namespace type)) (keyword (name type))])
+
+(defn emit-representations
+ [representations]
+ (apply vector
+ (map (fn [[type representation]] [(split-type type)
+ `(fn [~'+resource ~'+response] ~representation)])
+ (partition 2 representations))))
+
+
+(defmacro resource
+ [& args]
+ (let [[representations & specs] (reverse args)]
+ `(with-representations (reify Resource ~@(map emit-resource-handler specs))
+ ~(emit-representations representations))))
+
+;;; faster routing
+
+(defn compile-route
+ [[path-spec resource]]
+ (let [compiled-path-spec (clout/route-compile path-spec)]
+ (fn [path] (when-let [params (clout/route-matches compiled-path-spec path)]
+ [resource params]))))
+
+(defn compile-routes
+ [routes]
+ (let [compiled-routes (map compile-route (partition 2 routes))]
+ (fn [path] (some #(% path) compiled-routes))))
View
99 src/resrc/ring.clj
@@ -0,0 +1,99 @@
+(ns resrc.ring
+ (:require [resrc.core :as core]
+ [clojure.string :as s]))
+
+
+(defn emit-resource-handler
+ [[method & forms]]
+ `(~method [~'+resource {~'+server-port :server-port
+ ~'+server-name :server-name
+ ~'+remote-addr :remote-addr
+ ~'+uri :uri
+ ~'+query-string :query-string
+ ~'+scheme :scheme
+ ~'+request-method :request-method
+ ~'+content-type :content-type
+ ~'+content-length :content-length
+ ~'+character-encoding :character-encoding
+ ~'+headers :headers
+ ~'+body :body
+ :as ~'+request}]
+ ~@forms))
+
+;;(emit-resource-handler '(get (prn (+query-string))))
+
+(defmacro resource
+ [& args]
+ (let [[representations & specs] (reverse args)]
+ `(resrc.core/with-representations
+ (reify resrc.core/Resource ~@(map emit-resource-handler specs))
+ ~(resrc.core/emit-representations representations))))
+
+(defn parse-accept-params
+ "params is a seq of params like 'q=0.8' or 'level=1'"
+ [params]
+ (apply hash-map
+ (apply concat
+ (map #(let [[k v] (s/split % #"=")] [(keyword k) v]) params))))
+
+(defn add-accept-metadata
+ "accepts-type is a vector like [:text :plain]
+params is a map like {:q 0.8 :level 1}"
+ [accept-type params]
+ (with-meta accept-type
+ {:accept-q (Double. (or (:q params) "1"))}))
+
+(defn parse-accept-component
+ "component is a string like text/plain;q=0.8;level=1"
+ [component]
+ (let [[content-type & params] (s/split component #";")]
+ (let [[type subtype] (s/split content-type #"/")
+ params-map (parse-accept-params params)]
+ (add-accept-metadata [(keyword type) (keyword subtype)] params-map))))
+
+(defn sort-by-q-value
+ "accepts is a seq of accept types like [[:text :plainn] [:text :html]]
+
+each item in the seq must have an associated :accept-q metadatum"
+ [accepts]
+ (sort-by #(- 1.0 (:accept-q (meta %))) accepts))
+
+(defn parse-accept
+ "accepts-string is a string like
+text/*, text/html, text/html;level=1, */*"
+ [accept-string]
+ (sort-by-q-value
+ (map #(parse-accept-component (s/trim %))
+ (s/split accept-string #","))))
+
+(defn handle-not-acceptable
+ [response]
+ (if (= :not-acceptable response)
+ {:status 405
+ :headers {}}
+ response))
+
+(defn add-content-type
+ [response type-vector]
+ (assoc response
+ :headers
+ (assoc (:headers response)
+ "Content-Type" (s/join "/" (map name type-vector)))))
+
+(defn process-request
+ "method should be a method supported by Resource.
+
+Assumes representations are functions from [resource request & rest] to response."
+ [routes request]
+ (let [path (:uri request)
+ [resource path-params] (core/find-resource routes path)
+ method (ns-resolve 'resrc.core (symbol (name (:method request))))
+ accepts-list (parse-accept ((:headers request) "Accept"))]
+ (if-let [[response-type representation]
+ (core/find-acceptable accepts-list (core/representations resource))]
+ (add-content-type
+ (representation
+ resource
+ (method resource (assoc request :path-params path-params)))
+ response-type)
+ {:status 405 :headers {}})))
View
56 test/resrc/test/core.clj
@@ -39,7 +39,7 @@
f3 #(3)
representations
[[[:text :plain] f1]
- [[:text :html] 22]
+ [[:text :html] f2]
[[:image :jpeg] f3]]]
(is (= [[:text :plain] f1] (find-representation [:* :*] representations)))
(is (= [[:text :plain] f1] (find-representation [:text :*] representations)))
@@ -65,3 +65,57 @@
[[[:text :plain] (fn [resource response] (str response "baz"))]])]
(is (= "foo bar baz"
(process-request ["/bar" resource] get "/bar" [[:text :plain]] "foo ")))))
+
+
+(deftest test-emit-resource-handler
+ (is (= '(get [+resource +request] foo)
+ (emit-resource-handler '(get foo)))))
+
+(deftest test-emit-representations
+ (is (= '[[[:text :plain] (clojure.core/fn [+resource +response] foo)]
+ [[:text :html] (clojure.core/fn [+resource +response] bar)]]
+ (emit-representations '[:text/plain foo
+ :text/html bar]))))
+
+(deftest test-resource
+ (let [resource (resource
+ (get "fuz ")
+ (put +request)
+ [:text/html (str +response "representation")])]
+ (is (= "fuz representation"
+ (process-request ["/bar" resource] get "/bar" [[:text :html]] "foo ")))
+ (is (= "foo representation"
+ (process-request ["/bar" resource] put "/bar" [[:text :html]] "foo ")))))
+
+(comment
+ "Some lightweight perf tests for our routing code"
+ (def bunch-of-routes
+ ["/foo" :a
+ "/bar" :b
+ "/foo/:id" :c
+ "/foo/bar/baz" :d
+ "/bar/:id" :e])
+
+ (dotimes [_ 5] (time (find-resource bunch-of-routes "/bar/10")))
+ "Elapsed time: 1.774 msecs"
+ "Elapsed time: 1.694 msecs"
+ "Elapsed time: 1.461 msecs"
+ "Elapsed time: 2.743 msecs"
+ "Elapsed time: 1.588 msecs"
+
+ (def compiled-routes (compile-routes bunch-of-routes))
+
+ (dotimes [_ 5] (time (compiled-routes "/bar/10")))
+ ;; don't precompile path specs
+ "Elapsed time: 1.712 msecs"
+ "Elapsed time: 1.38 msecs"
+ "Elapsed time: 1.504 msecs"
+ "Elapsed time: 1.662 msecs"
+ "Elapsed time: 1.193 msecs"
+
+ ;; precompile path specs
+ "Elapsed time: 0.219 msecs"
+ "Elapsed time: 0.102 msecs"
+ "Elapsed time: 0.091 msecs"
+ "Elapsed time: 0.095 msecs"
+ "Elapsed time: 0.128 msecs")
View
61 test/resrc/test/ring.clj
@@ -0,0 +1,61 @@
+(ns resrc.test.ring
+ (:use [resrc.ring]
+ [clojure.test])
+ (:require [resrc.core :as core]))
+
+(deftest test-parse-accept
+ (is (= (seq [[:text :plain] [:text :html]])
+ (parse-accept "text/plain, text/html")))
+ ;; should sort by 'q' param
+ (is (= (seq [[:text :plain] [:text :html]])
+ (parse-accept "text/html;q=0.5, text/plain;q=0.8")))
+ ;; q defaults to 1
+ (is (= (seq [[:text :plain] [:text :html]])
+ (parse-accept "text/html;q=0.5, text/plain"))))
+
+
+(deftest test-process-request
+ (let [resource
+ (core/resource
+ (core/get "foo ")
+ [:text/plain {:body (str +response "bar")}])]
+ (is (= "foo bar"
+ (:body (process-request ["/bar" resource]
+ {:method :get
+ :uri "/bar"
+ :headers {"Accept" "text/plain"}}))))
+ (is (= 405
+ (:status (process-request ["/bar" resource]
+ {:method :get
+ :uri "/bar"
+ :headers {"Accept" "text/html"}}))))))
+
+(deftest test-resource
+ (let [resource (resource
+ (get "fuz ")
+ (put +body)
+ [:text/html {:body (str +response "representation")}])]
+ (is (= "fuz representation"
+ (:body (process-request ["/bar" resource]
+ {:method :get
+ :uri "/bar"
+ :headers {"Accept" "text/html"}
+ :body "foo "}))))
+ (is (= "foo representation"
+ (:body (process-request ["/bar" resource]
+ {:method :put
+ :uri "/bar"
+ :headers {"Accept" "text/html"}
+ :body "foo "}))))))
+
+
+(deftest test-resource
+ (let [resource (resource
+ (get +body)
+ [:text/html {:body (str +response "representation")}])]
+ (is (= "foo representation"
+ (:body (process-request ["/bar" resource]
+ {:method :get
+ :uri "/bar"
+ :headers {"Accept" "text/html"}
+ :body "foo "}))))))

0 comments on commit d92acc0

Please sign in to comment.