Sketch for named routes

gistfile1.clj

(ns named-routes
  (:require [compojure.core :as c])
  (:require [clojure.string :as str])
  (:import [java.net URLEncoder]))

(defn add-meta
  "Merges metadata from maps ms into current metadata for obj."
  [obj & ms]
  (with-meta obj (apply merge (meta obj) ms)))

(defn preserve-routes
  "Returns a version of f that preserves routing metadata present on it's argument function."
  [f]
  (fn [handler]
    (add-meta (f handler) (select-keys (meta handler) [::name ::path ::routes]))))

(defn middleware
  "Wraps a handler in a way that preserves named routes."
  [middleware handler]
  ((preserve-routes middleware) handler))

(defmacro route
  "Like compojure.core/GET but with named route support."
  ([name [method path args & body]]
     (let [method-fn (find-var (symbol "compojure.core" (str method)))]
       `(let [p# ~path
              handler (~method-fn p# ~args ~body)]
          (add-meta handler {::name ~name ::path p#})))))

(defn routes
  "Like compojure.core/routes but with named route support."
  [& handlers]
  (add-meta (apply c/routes handlers) {::routes handlers}))

(defmacro context
  "Like compojure.core/context but with named route support."
  [path args & handlers]
  (let [hs (gensym "handlers_")]
    `(let [~hs [~@handlers]
           p# ~path
           h# (apply routes ~hs)]
       (add-meta (c/context p# ~args ~hs)
                 {::path p#}
                 (select-keys (meta h#) [::routes])))))

(defn routes->urls
  "Takes a handler and walks it to find all named routes."
  ([handler] (routes->urls handler ""))
  ([handler prefix]
     (let [m (meta handler)
           name (::name m)
           urls (when name {name (str prefix (::path m))})
           prefix (str prefix (::path m))
           handlers (::routes m)]
       (apply merge urls (map #(routes->urls % prefix) handlers)))))

;; TODO:
;; - validation of path and args
;; - check that all placeholders are replaced
;; - check that no args remain
(defn- fill-placeholders
  "Given a clout route and a seq of args, replaces placeholders and wildcards to form a proper URL."
  [path args]
  (assert (empty? (filter #(.contains % "/") args)))
  (reduce #(str/replace-first %1 #":[^/]+|\*" (URLEncoder/encode (str %2))) path args))

(defn url-for
  "Returns the URL for a named route, after filling in the specified args."
  [url-map url args]
  (when-let [path (get url-map url)]
    (fill-placeholders path args)))

(defn routes->url-mapper
  "Returns a function to build URLs for named routes and args."
  [app]
  (let [url-map (routes->urls app)]
    (fn [url args] (url-for url-map url args))))

Instead of the route macro above, an alternative is to directly define reversable-routing versions of the GET, POST, PUT, DELETE, ANY macros that Compojure provides. We can decide based upon preferred syntax and any complications/limitations the current route macro may have.