Rewrite to handle dynamic vars with sub-routes - resolve routes ring-style

2 files changed, 94 insertions, 28 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
diff --git a/test/reverse_routing/core_test.clj b/test/reverse_routing/core_test.clj
index d611dea..5dc50ba 100644
--- a/test/reverse_routing/core_test.clj
+++ b/test/reverse_routing/core_test.clj
@@ -4,6 +4,8 @@
         [compojure.core :only [GET]]))
 
 (defn make-request [handler uri]
+  ;; Technically most of this map is required by the ring spec
+  ;; I'm fairly sure we could get away with not having most of it
   (-> {:request-method :get
        :scheme :http
        :uri uri
@@ -25,7 +27,7 @@
     (is (thrown? java.lang.AssertionError (make-request handler "/fail1")))
     (is (thrown? java.lang.AssertionError (make-request handler "/fail2")))))
 
-(deftest test-contest-routes
+(deftest test-context-routes
   (let [handler (-> (routes
                      (register-route :user
                        (GET "/user/" [id] (str "user list")))
@@ -48,3 +50,45 @@
     (is (thrown? java.lang.AssertionError (make-request handler "/fail1")))
     (is (thrown? java.lang.AssertionError (make-request handler "/fail2")))
     (is (thrown? java.lang.AssertionError (make-request handler "/fail3")))))
+
+(deftest test-context-in-context-routes
+  (let [handler (-> (routes
+                     (context "/user" []
+                       (register-route :user
+                         (GET "/" [id] (str "user list")))
+                       (context "/:id" []
+                         (register-route :user
+                           (GET "/" [id] (str "user " id)))
+                         (register-route :edit-user
+                           (GET "/edit" [id] (str "edit user " id)))))
+                     (GET "/succeed1" [] (url-for :user))
+                     (GET "/succeed2" [] (url-for :user 10))
+                     (GET "/succeed3" [] (url-for :edit-user 10))
+                     (GET "/fail1" [] (url-for :user 10 20))
+                     (GET "/fail2" [] (url-for :edit-user))
+                     (GET "/fail3" [] (url-for :edit-user 10 20)))
+                    wrap-reverse-routing)]
+    (is (= (make-request handler "/succeed1") "/user/"))
+    (is (= (make-request handler "/succeed2") "/user/10/"))
+    (is (= (make-request handler "/succeed3") "/user/10/edit"))
+
+    (is (thrown? java.lang.AssertionError (make-request handler "/fail1")))
+    (is (thrown? java.lang.AssertionError (make-request handler "/fail2")))
+    (is (thrown? java.lang.AssertionError (make-request handler "/fail3")))))
+
+
+(def ^:dynamic *subroutes* (register-route :user
+                             (GET "/user" [] (str "user"))))
+(deftest test-with-rebinding-vars
+  (let [handler (-> (routes
+                     #'*subroutes*
+                     (GET "/succeed" [] (url-for :user))
+                     (GET "/fail" [] (url-for :user 10)))
+                    wrap-reverse-routing)]
+    (is (= (make-request handler "/succeed") "/user"))
+    (is (thrown? java.lang.AssertionError (make-request handler "/fail")))
+
+    (binding [*subroutes* (register-route :user
+                            (GET "/not-user" [] (str "user")))]
+      (is (= (make-request handler "/succeed") "/not-user"))
+      (is (thrown? java.lang.AssertionError (make-request handler "/fail"))))))