From 809dee0523d267c49b970a91a5cbe7aa119627fd Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <carlo@clearboxsystems.com.au>
Date: Sat, 10 Aug 2013 00:53:06 +1000
Subject: Initial commit.

---
 .hgignore                    | 13 +++++++
 project.clj                  |  7 ++++
 src/reverse_routing/core.clj | 82 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 102 insertions(+)
 create mode 100644 .hgignore
 create mode 100644 project.clj
 create mode 100644 src/reverse_routing/core.clj

diff --git a/.hgignore b/.hgignore
new file mode 100644
index 0000000..6b052fa
--- /dev/null
+++ b/.hgignore
@@ -0,0 +1,13 @@
+syntax: glob
+target
+lib
+classes
+checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins
+.lein-repl-history
diff --git a/project.clj b/project.clj
new file mode 100644
index 0000000..431b954
--- /dev/null
+++ b/project.clj
@@ -0,0 +1,7 @@
+(defproject reverse-routing "0.1.0-SNAPSHOT"
+  :description "FIXME: write description"
+  :url "http://example.com/FIXME"
+  :license {:name "Eclipse Public License"
+            :url "http://www.eclipse.org/legal/epl-v10.html"}
+  :dependencies [[org.clojure/clojure "1.5.1"]
+                 [compojure "1.1.5"]])
diff --git a/src/reverse_routing/core.clj b/src/reverse_routing/core.clj
new file mode 100644
index 0000000..4936064
--- /dev/null
+++ b/src/reverse_routing/core.clj
@@ -0,0 +1,82 @@
+(ns reverse-routing.core
+  (:require [clojure.string :as string]))
+
+(defn wrap-reverse-routing [handler & {:keys [root] :or {:root ""}}]
+  (fn [request]
+    (let [route-table (->> handler meta ::routes)
+          request (assoc request
+                    ::reverse-routes route-table
+                    ::root root)]
+      (handler request))))
+
+(defn ^:private routing [request & handlers]
+  (some #(% request) handlers))
+
+(defn routes [& handlers]
+  (let [merge-first (partial merge-with (fn [x y] x))]
+    (apply vary-meta #(apply routing % handlers)
+           update-in [::routes]
+           merge-first (map (comp ::routes meta) handlers))))
+
+(defmacro context [path args & routes]
+  (let [string-path (if (vector? path) (first path) path)]
+    `(with-meta (compojure.core/context ~path ~args ~@routes)
+       {::routes (let [path-keys# (:keys (clout.core/route-compile ~string-path))
+                       ~args [] ;; wow. could this be hackier? I doubt it.
+                       ]
+                   (->> (for [routes# (map (comp ::routes meta) (list ~@routes))
+                              [key# val#] routes#]
+                          [key# {:uri (str ~string-path (:uri val#))
+                                 :args (concat path-keys# (:args val#))
+                                 :type (:type val#)}])
+                        (into {})))})))
+
+(defmacro register-route [route-name [type path args & body :as route]]
+  (let [string-path (if (vector? path) (first path) path)]
+    `(with-meta ~route
+       {::routes {~route-name {:uri ~string-path
+                               :type ~(keyword (string/lower-case (name type)))
+                               :args (:keys (clout.core/route-compile ~string-path))}}})))
+
+(defn url-for [request route & arg-values]
+  (let [{:keys [uri type args]} (-> request ::reverse-routes route)
+        root-path (::root request)]
+    (str root-path
+         (reduce (fn [string [name val]]
+                   (clojure.string/replace string (str name) (str val)))
+                 uri (map vector args arg-values)))))
+
+(comment
+
+  (require '[compojure.core :refer [GET]])
+
+  (def test-routes 
+    (-> (routes
+         (->> (GET "/user/:id" {{id :id} :params :as request}
+                (url-for request :get-something id))
+              (register-route :get-user))
+         (->> (GET "/person/:id" {{id :id} :params :as request}
+                (url-for request :get-user id))
+              (register-route :get-person))
+         (context "/something/:id" [id]
+           (GET "/nom" []
+             "something, blah!")
+           (->> (GET "/name" {:as request}
+                  (url-for request :get-person id))
+                (register-route :get-something))
+           (->> (GET ["/nam/:blah", :blah #"1\d+"] {{bloo :blah} :params :as request}
+                  (url-for request :get-something-else id 10))
+                (register-route :get-something-else))))
+        wrap-reverse-routing))
+
+  (test-routes {:request-method :get
+                :scheme :http
+                ;;:uri "/something/15/name"
+                ;;:uri "/person/15"
+                :uri "/user/15"
+                ;;:uri "/something/15/nam/12"
+                ;;:uri "/something/10/nom"
+                :remote-addr "127.0.0.1"
+                :server-port 8080
+                :server-name "something"})
+  )
-- 
cgit v1.2.3