From c27eaaeef4ec415e8e5645cd5e477643aec56d2c Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <carlo@clearboxsystems.com.au>
Date: Mon, 2 Sep 2013 00:29:52 +1000
Subject: Rewrite to handle dynamic vars with sub-routes - resolve routes
 ring-style

---
 src/reverse_routing/core.clj | 76 ++++++++++++++++++++++++++++----------------
 1 file changed, 49 insertions(+), 27 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3