josf · April 13, 2016 09:36
diff --git a/core.clj b/core.clj

 (defn arg-find
  "Helper function for defroute that extracts code from the body and
  organizes it as bindings, symbols and body. Function calls within
  the body are replaced by their corresponding gensyms. (:symbols is
  just a list of the gensyms in :bindings, for convenience)"
  [body]
  (reduce (fn [acc [k v]]
            (if (list? v)
              (let [sym (gensym (str (name k) "-"))]
                (-> acc
                  (update-in [:bindings] #(vec (concat % [sym v])))
                  (update-in [:symbols] #(conj % sym))
                  (assoc-in [:body k] sym)))
              (assoc-in [:body k] v)))
    {:bindings [] :body {}}
    body))

 (defn path-tokens
  [path]
  (map (fn [part]
         (if-let [[_ sym] (re-find #"^\$\{([^}]+)\}$" part)]
           (symbol sym)
           part))
    (filter (complement empty?) (clojure.string/split path #"/"))))

 (defn path-parse
  "Returns a list of pairs, mapping symbols to their respective indexs
  in the path, so that /part/${arg} would produce [arg 1]."
  [tokens]
  (filter identity
    (map-indexed (fn [idx t]
                   (when (symbol? t) [t idx]))
      tokens)))

 (defn node-path
  "Rebuild a node compatible path. This is very imperfect of course,
  since we're just grabbing with *, but I hope it conveys the
  idea..."
  [path-tokens]
  (clojure.string/join
    "/"
    (map (fn [part] (if (symbol? part) "*" part)) path-tokens)))


 (defn path-bindings
  "Produces a vector of bindings to be used in the defroute macro.
  Takes the output of path-parse."
  [parsed]
  (vec
   (mapcat (fn [[sym idx]]
             `(~sym (nth req-path ~idx))) parsed)))

 (defmacro defroute
  "body is a map. When values are function calls, they are evaluated
  and their return values, which should be maps, are checked
  for :server-error or :client-error keys. If either of these is
  found, the appropriate error is returned to the client. Otherwise,
  the initial map in body is reconstituted with the appropriate values
  and returned. "
  [method path body]
  (let [m-meth (get  {'GET '.get
                      'POST '.post
                      'PUT '.put
                      'DELETE '.delete
                      'HEAD '.head} method)
        {bindings :bindings ret :body syms :symbols} (arg-find body)
        path-tks (path-tokens path)
        npath (node-path path-tks)]
    `(let [resp-fn 
           (fn [req res]
             (let [req-path (.-path req)]
               (let ~(path-bindings (path-parse path-tks))
                 (let ~bindings
                   (cond
                     (some :server-error [~@syms]) (.send (.status res 500) "Server error")
                     (some :client-error [~@syms]) (.send (.status res 400) "Client error")
                     true (.send res ~ret))))))]
       (~m-meth  ~'app ~npath resp-fn))))



 ;;; this expands into this (after removing the namespace cruft):
 (macroexpand-1 '(defroute GET "/z1/customer/${id}" {:customer (get-customer id)}))

 (let [resp-fn (fn [req res]
                (let [req-path (.-path req)]
                  (let [id (nth req-path 2)]
                    (let [customer-21529 (get-customer id)]
                      (cond
                        (some :server-error [customer-21529])
                        (.send (.status res 500) "Server error")
                        (some :client-error [customer-21529])
                        (.send (.status res 400) "Client error")
                        true (.send res {:customer customer-21529}))))))]
  (.get app "z1/customer/*" resp-fn))

 ;;; it allows for multiple internal calls too, so something like this would be possible:
 (defroute GET "/z1/customer/${id}/order/${orderid}"
  {:customer (get-customer id)
   :order (get-order orderid)})

	(defn arg-find
	"Helper function for defroute that extracts code from the body and
	organizes it as bindings, symbols and body. Function calls within
	the body are replaced by their corresponding gensyms. (:symbols is
	just a list of the gensyms in :bindings, for convenience)"
	[body]
	(reduce (fn [acc [k v]]
	(if (list? v)
	(let [sym (gensym (str (name k) "-"))]
	(-> acc
	(update-in [:bindings] #(vec (concat % [sym v])))
	(update-in [:symbols] #(conj % sym))
	(assoc-in [:body k] sym)))
	(assoc-in [:body k] v)))
	{:bindings [] :body {}}
	body))

	(defn path-tokens
	[path]
	(map (fn [part]
	(if-let [[_ sym] (re-find #"^\$\{([^}]+)\}$" part)]
	(symbol sym)
	part))
	(filter (complement empty?) (clojure.string/split path #"/"))))

	(defn path-parse
	"Returns a list of pairs, mapping symbols to their respective indexs
	in the path, so that /part/${arg} would produce [arg 1]."
	[tokens]
	(filter identity
	(map-indexed (fn [idx t]
	(when (symbol? t) [t idx]))
	tokens)))

	(defn node-path
	"Rebuild a node compatible path. This is very imperfect of course,
	since we're just grabbing with *, but I hope it conveys the
	idea..."
	[path-tokens]
	(clojure.string/join
	"/"
	(map (fn [part] (if (symbol? part) "*" part)) path-tokens)))


	(defn path-bindings
	"Produces a vector of bindings to be used in the defroute macro.
	Takes the output of path-parse."
	[parsed]
	(vec
	(mapcat (fn [[sym idx]]
	`(~sym (nth req-path ~idx))) parsed)))

	(defmacro defroute
	"body is a map. When values are function calls, they are evaluated
	and their return values, which should be maps, are checked
	for :server-error or :client-error keys. If either of these is
	found, the appropriate error is returned to the client. Otherwise,
	the initial map in body is reconstituted with the appropriate values
	and returned. "
	[method path body]
	(let [m-meth (get {'GET '.get
	'POST '.post
	'PUT '.put
	'DELETE '.delete
	'HEAD '.head} method)
	{bindings :bindings ret :body syms :symbols} (arg-find body)
	path-tks (path-tokens path)
	npath (node-path path-tks)]
	`(let [resp-fn
	(fn [req res]
	(let [req-path (.-path req)]
	(let ~(path-bindings (path-parse path-tks))
	(let ~bindings
	(cond
	(some :server-error [~@syms]) (.send (.status res 500) "Server error")
	(some :client-error [~@syms]) (.send (.status res 400) "Client error")
	true (.send res ~ret))))))]
	(~m-meth ~'app ~npath resp-fn))))



	;;; this expands into this (after removing the namespace cruft):
	(macroexpand-1 '(defroute GET "/z1/customer/${id}" {:customer (get-customer id)}))

	(let [resp-fn (fn [req res]
	(let [req-path (.-path req)]
	(let [id (nth req-path 2)]
	(let [customer-21529 (get-customer id)]
	(cond
	(some :server-error [customer-21529])
	(.send (.status res 500) "Server error")
	(some :client-error [customer-21529])
	(.send (.status res 400) "Client error")
	true (.send res {:customer customer-21529}))))))]
	(.get app "z1/customer/*" resp-fn))

	;;; it allows for multiple internal calls too, so something like this would be possible:
	(defroute GET "/z1/customer/${id}/order/${orderid}"
	{:customer (get-customer id)
	:order (get-order orderid)})