diff options
author | Carlo Zancanaro <carlo@clearboxsystems.com.au> | 2013-09-02 00:29:52 +1000 |
---|---|---|
committer | Carlo Zancanaro <carlo@clearboxsystems.com.au> | 2013-09-02 00:29:52 +1000 |
commit | c27eaaeef4ec415e8e5645cd5e477643aec56d2c (patch) | |
tree | de8825c8f56fb8fa012c6c28e6a9fa34dd338d51 /src/reverse_routing/core.clj | |
parent | d8bbc050c528f0ee358fdf16b564e0a0abaaf24a (diff) |
Rewrite to handle dynamic vars with sub-routes - resolve routes ring-style
Diffstat (limited to 'src/reverse_routing/core.clj')
-rw-r--r-- | src/reverse_routing/core.clj | 76 |
1 files changed, 49 insertions, 27 deletions
diff --git a/src/reverse_routing/core.clj b/src/reverse_routing/core.clj index cab8f33..627fe5e 100644 --- a/src/reverse_routing/core.clj +++ b/src/reverse_routing/core.clj @@ -3,56 +3,78 @@ compojure.core [clojure.string :as string])) -(def ^:private ^:dynamic *reverse-routes* nil) +(def ^:private ^:dynamic *lookup-route* nil) (def ^:private ^:dynamic *root* nil) (defn wrap-reverse-routing [handler & {:keys [root] :or {:root ""}}] (fn [request] - (binding [*reverse-routes* (->> handler meta ::routes) + (binding [*lookup-route* (->> handler meta ::lookup) *root* root] (handler request)))) +(defn ^:private deref-if-var [arg] + (if (var? arg) + (deref arg) + arg)) + +(defn ^:private lookup-route [route & handlers] + (->> handlers + (map (comp ::lookup meta deref-if-var)) + (some #(if % (% route))))) + (defn ^:private routing [request & handlers] (some #(% request) handlers)) -(defmacro routes [& handlers] - (let [routes-map (->> handlers - (map (comp ::routes meta macroexpand)) - (into {}))] - (vary-meta `(vary-meta (fn [request#] - (#'routing request# ~@handlers)) - assoc ::routes ~routes-map) - assoc ::routes routes-map))) +(defn routes [& handlers] + (vary-meta #(apply routing % handlers) + assoc ::lookup #(apply lookup-route % handlers))) + +(defmacro let-routes [bindings & handlers] + `(let ~bindings (routes ~@handlers))) + +(defmacro when-routes [cond & handlers] + `(when ~cond (routes ~@handlers))) (defmacro defroutes [name & handlers] `(def ~name (routes ~@handlers))) (defmacro context [path args & routes] (let [string-path (if (vector? path) (first path) path) - routes-map (let [path-keys (:keys (clout.core/route-compile string-path)) - keylen (count path-keys)] - (->> (for [route (map (comp ::routes meta macroexpand) routes) - [[path num] {:keys [uri args type]}] route] - [[path (+ num keylen)] {:uri (str string-path uri) - :args (vec (concat path-keys args)) - :type type}]) - (into {})))] - (vary-meta `(vary-meta (compojure.core/context ~path ~args ~@routes) - assoc ::routes ~routes-map) - assoc ::routes routes-map))) + path-keys (vec (:keys (clout.core/route-compile string-path))) + keylen (count path-keys) + lookup-fn `(fn [[route-name# args-count#]] + (let [r# (#'lookup-route [route-name# (- args-count# ~keylen)] + ~@routes) + {uri# :uri, args# :args} r#] + (if r# + (assoc r# + :uri (str ~string-path uri#) + :args (vec (concat ~path-keys args#))))))] + `(vary-meta (compojure.core/context ~path ~args + (routes ~@routes)) + assoc ::lookup ~lookup-fn))) (defmacro register-route [route-name [type path args & body :as route]] (let [string-path (if (vector? path) (first path) path) route-args (:keys (clout.core/route-compile string-path)) route-id [route-name (count route-args)] - routes-map {route-id {:uri string-path - :type (keyword (string/lower-case (name type))) - :args (vec route-args)}}] - (vary-meta `(vary-meta ~route assoc ::routes ~routes-map) - assoc ::routes routes-map))) + routes-map {:uri string-path + :type (keyword (string/lower-case (name type))) + :args (vec route-args)}] + `(vary-meta ~route + assoc ::lookup (fn [signature#] + (if (= signature# ~route-id) + ~routes-map))))) + +((-> (register-route :user + (GET "/user/" [] + 123)) + meta + ::lookup) + [:user 0]) (defn url-for [route & arg-values] - (let [{:keys [uri type args]} (get *reverse-routes* [route (count arg-values)]) + (let [{:keys [uri type args]} (*lookup-route* [route (count arg-values)]) root-path *root*] (assert uri) (str root-path |