Merge pull request #16 from metosin/RingRouter

Ring router

src/reitit/core.cljc

@@ -56,13 +56,11 @@
     {} x))
 
 (defn resolve-routes [data {:keys [coerce] :as opts}]
-  (cond-> (->> (walk data opts)
+  (cond->> (->> (walk data opts) (map-meta merge-meta))
-               (map-meta merge-meta))
+           coerce (into [] (keep #(coerce % opts)))))
-          coerce (->> (mapv (partial coerce))
-                      (filterv identity))))
 
-(defn compile-route [compile [p m :as route]]
+(defn compile-route [[p m :as route] {:keys [compile] :as opts}]
-  [p m (if compile (compile route))])
+  [p m (if compile (compile route opts))])
 
 (defprotocol Routing
   (routes [this])
@@ -72,8 +70,9 @@
 (defrecord Match [template meta path handler params])
 
 (def default-router-options
-  {:coerce identity
+  {:expand expand
-   :compile (comp :handler second)})
+   :coerce (fn [route _] route)
+   :compile (fn [[_ {:keys [handler]}] _] handler)})
 
 (defrecord LinearRouter [routes data lookup]
   Routing
@@ -91,13 +90,12 @@
     ((lookup name) params)))
 
 (defn linear-router
-  "Creates a [[LinearRouter]] from routes and optional options.
+  "Creates a [[LinearRouter]] from resolved routes and optional
-  See [[router]] for available options"
+  expanded options. See [[router]] for available options"
   ([routes]
    (linear-router routes {}))
   ([routes opts]
-   (let [{:keys [compile]} (meta-merge default-router-options opts)
+   (let [compiled (map #(compile-route % opts) routes)
-         compiled (map (partial compile-route compile) routes)
          [data lookup] (reduce
                          (fn [[data lookup] [p {:keys [name] :as meta} handler]]
                            (let [route (impl/create [p meta handler])]
@@ -119,8 +117,8 @@
     ((lookup name) params)))
 
 (defn lookup-router
-  "Creates a [[LookupRouter]] from routes and optional options.
+  "Creates a [[LookupRouter]] from resolved routes and optional
-  See [[router]] for available options"
+  expanded options. See [[router]] for available options"
   ([routes]
    (lookup-router routes {}))
   ([routes opts]
@@ -130,8 +128,7 @@
          (str "can't create LookupRouter with wildcard routes: " route)
          {:route route
           :routes routes})))
-   (let [{:keys [compile]} (meta-merge default-router-options opts)
+   (let [compiled (map #(compile-route % opts) routes)
-         compiled (map (partial compile-route compile) routes)
          [data lookup] (reduce
                          (fn [[data lookup] [p {:keys [name] :as meta} handler]]
                            [(assoc data p (->Match p meta p handler {}))
@@ -151,11 +148,12 @@
   | `:routes`  | Initial resolved routes (default `[]`)
   | `:meta`    | Initial expanded route-meta vector (default `[]`)
   | `:expand`  | Function `arg => meta` to expand route arg to route meta-data (default `reitit.core/expand`)
-  | `:coerce`  | Function `[path meta] => [path meta]` to coerce resolved route, can throw or return `nil` (default `identity`)
+  | `:coerce`  | Function `[path meta] opts => [path meta]` to coerce resolved route, can throw or return `nil`
-  | `:compile` | Function `[path meta] => handler` to compile a route handler (default `(comp :handler second)`)"
+  | `:compile` | Function `[path meta] opts => handler` to compile a route handler"
   ([data]
    (router data {}))
   ([data opts]
-   (let [routes (resolve-routes data opts)]
+   (let [opts (meta-merge default-router-options opts)
+         routes (resolve-routes data opts)]
      ((if (some impl/contains-wilds? (map first routes))
         linear-router lookup-router) routes opts))))

src/reitit/ring.cljc

@@ -0,0 +1,97 @@
+(ns reitit.ring
+  (:require [meta-merge.core :refer [meta-merge]]
+            [reitit.core :as reitit]))
+
+(defprotocol ExpandMiddleware
+  (expand-middleware [this]))
+
+(extend-protocol ExpandMiddleware
+
+  #?(:clj  clojure.lang.APersistentVector
+     :cljs cljs.core.PersistentVector)
+  (expand-middleware [[f & args]]
+    (fn [handler]
+      (apply f handler args)))
+
+  #?(:clj  clojure.lang.Fn
+     :cljs function)
+  (expand-middleware [this] this)
+
+  nil
+  (expand-middleware [_]))
+
+(defn- ensure-handler! [path meta method]
+  (when-not (:handler meta)
+    (throw (ex-info
+             (str "path \"" path "\" doesn't have a :handler defined"
+                  (if method (str " for method " method)))
+             {:path path, :method method, :meta meta}))))
+
+(defn- compose-middleware [middleware]
+  (->> middleware
+       (keep identity)
+       (map expand-middleware)
+       (apply comp identity)))
+
+(defn- compile-handler
+  ([route opts]
+   (compile-handler route opts nil))
+  ([[path {:keys [middleware handler] :as meta}] _ method]
+   (ensure-handler! path meta method)
+   ((compose-middleware middleware) handler)))
+
+(defn simple-router [data]
+  (reitit/router data {:compile compile-handler}))
+
+(defn ring-handler [router]
+  (with-meta
+    (fn
+      ([request]
+       (if-let [match (reitit/match-by-path router (:uri request))]
+         ((:handler match) request)))
+      ([request respond raise]
+       (if-let [match (reitit/match-by-path router (:uri request))]
+         ((:handler match) request respond raise))))
+    {::router router}))
+
+(defn get-router [handler]
+  (some-> handler meta ::router))
+
+(def http-methods #{:get :head :patch :delete :options :post :put})
+(defrecord MethodHandlers [get head patch delete options post put])
+
+(defn- group-keys [meta]
+  (reduce-kv
+    (fn [[top childs] k v]
+      (if (http-methods k)
+        [top (assoc childs k v)]
+        [(assoc top k v) childs])) [{} {}] meta))
+
+(defn coerce-method-handler [[path meta] {:keys [expand]}]
+  [path (reduce
+          (fn [acc method]
+            (if (contains? acc method)
+              (update acc method expand)
+              acc)) meta http-methods)])
+
+(defn compile-method-handler [[path meta] opts]
+  (let [[top childs] (group-keys meta)]
+    (if-not (seq childs)
+      (compile-handler [path meta] opts)
+      (let [handlers (map->MethodHandlers
+                       (reduce-kv
+                         #(assoc %1 %2 (compile-handler [path (meta-merge top %3)] opts %2))
+                         {} childs))
+            default-handler (if (:handler top) (compile-handler [path meta] opts))
+            resolved-handler (fn [method] (or (method handlers) default-handler))]
+        (fn
+          ([request]
+           (if-let [handler (resolved-handler (:request-method request))]
+             (handler request)))
+          ([request respond raise]
+           (if-let [handler (resolved-handler (:request-method request))]
+             (handler request respond raise))))))))
+
+(defn method-router [data]
+  (reitit/router data {:coerce coerce-method-handler
+                       :compile compile-method-handler}))

test/cljc/reitit/core_test.cljc

@@ -1,5 +1,5 @@
 (ns reitit.core-test
-  (:require [clojure.test :refer [deftest testing is are]]
+  (:require [clojure.test :refer [deftest testing is]]
             [reitit.core :as reitit #?@(:cljs [:refer [Match LinearRouter LookupRouter]])])
   #?(:clj
      (:import (reitit.core Match LinearRouter LookupRouter)
@@ -58,10 +58,10 @@
   (testing "route coercion & compilation"
     (testing "custom compile"
       (let [compile-times (atom 0)
-            coerce (fn [[path meta]]
+            coerce (fn [[path meta] _]
                      (if-not (:invalid? meta)
                        [path (assoc meta :path path)]))
-            compile (fn [[path meta]]
+            compile (fn [[path meta] _]
                       (swap! compile-times inc)
                       (constantly path))
             router (reitit/router
@@ -89,7 +89,6 @@
             (is (= 2 @compile-times))))))
     (testing "default compile"
       (let [router (reitit/router ["/ping" (constantly "ok")])]
-        (println (reitit/match-by-path router "/ping"))
         (let [{:keys [handler]} (reitit/match-by-path router "/ping")]
           (is handler)
           (is (= "ok" (handler)))))))

test/cljc/reitit/ring_test.cljc

@@ -0,0 +1,124 @@
+(ns reitit.ring-test
+  (:require [clojure.test :refer [deftest testing is]]
+            [reitit.ring :as ring])
+  #?(:clj
+     (:import (clojure.lang ExceptionInfo))))
+
+(defn mw [handler name]
+  (fn
+    ([request]
+     (-> request
+         (update ::mw (fnil conj []) name)
+         (handler)
+         (update :body (fnil conj []) name)))
+    ([request respond raise]
+     (handler
+       (update request ::mw (fnil conj []) name)
+       #(respond (update % :body (fnil conj []) name))
+       raise))))
+
+(defn handler
+  ([{:keys [::mw]}]
+   {:status 200 :body (conj mw :ok)})
+  ([request respond raise]
+   (respond (handler request))))
+
+(deftest ring-test
+
+  (testing "simple-router"
+
+    (testing "all paths should have a handler"
+      (is (thrown-with-msg?
+            ExceptionInfo
+            #"path \"/ping\" doesn't have a :handler defined"
+            (ring/simple-router ["/ping"]))))
+
+    (testing "ring-handler"
+      (let [api-mw #(mw % :api)
+            router (ring/simple-router
+                     [["/ping" handler]
+                      ["/api" {:middleware [api-mw]}
+                       ["/ping" handler]
+                       ["/admin" {:middleware [[mw :admin]]}
+                        ["/ping" handler]]]])
+            app (ring/ring-handler router)]
+
+        (testing "router can be extracted"
+          (is (= router (ring/get-router app))))
+
+        (testing "not found"
+          (is (= nil (app {:uri "/favicon.ico"}))))
+
+        (testing "normal handler"
+          (is (= {:status 200, :body [:ok]}
+                 (app {:uri "/ping"}))))
+
+        (testing "with middleware"
+          (is (= {:status 200, :body [:api :ok :api]}
+                 (app {:uri "/api/ping"}))))
+
+        (testing "with nested middleware"
+          (is (= {:status 200, :body [:api :admin :ok :admin :api]}
+                 (app {:uri "/api/admin/ping"}))))
+
+        (testing "3-arity"
+          (let [result (atom nil)
+                respond (partial reset! result), raise ::not-called]
+            (app {:uri "/api/admin/ping"} respond raise)
+            (is (= {:status 200, :body [:api :admin :ok :admin :api]}
+                   @result)))))))
+
+  (testing "method-router"
+
+    (testing "all paths should have a handler"
+      (is (thrown-with-msg?
+            ExceptionInfo
+            #"path \"/ping\" doesn't have a :handler defined for method :get"
+            (ring/method-router ["/ping" {:get {}}]))))
+
+    (testing "ring-handler"
+      (let [api-mw #(mw % :api)
+            router (ring/method-router
+                     [["/api" {:middleware [api-mw]}
+                       ["/all" handler]
+                       ["/get" {:get handler}]
+                       ["/users" {:middleware [[mw :users]]
+                                  :get handler
+                                  :post {:handler handler
+                                         :middleware [[mw :post]]}
+                                  :handler handler}]]])
+            app (ring/ring-handler router)]
+
+        (testing "router can be extracted"
+          (is (= router (ring/get-router app))))
+
+        (testing "not found"
+          (is (= nil (app {:uri "/favicon.ico"}))))
+
+        (testing "catch all handler"
+          (is (= {:status 200, :body [:api :ok :api]}
+                 (app {:uri "/api/all" :request-method :get}))))
+
+        (testing "just get handler"
+          (is (= {:status 200, :body [:api :ok :api]}
+                 (app {:uri "/api/get" :request-method :get})))
+          (is (= nil (app {:uri "/api/get" :request-method :post}))))
+
+        (testing "expanded method handler"
+          (is (= {:status 200, :body [:api :users :ok :users :api]}
+                 (app {:uri "/api/users" :request-method :get}))))
+
+        (testing "method handler with middleware"
+          (is (= {:status 200, :body [:api :users :post :ok :post :users :api]}
+                 (app {:uri "/api/users" :request-method :post}))))
+
+        (testing "fallback handler"
+          (is (= {:status 200, :body [:api :users :ok :users :api]}
+                 (app {:uri "/api/users" :request-method :put}))))
+
+        (testing "3-arity"
+          (let [result (atom nil)
+                respond (partial reset! result), raise ::not-called]
+            (app {:uri "/api/users" :request-method :post} respond raise)
+            (is (= {:status 200, :body [:api :users :post :ok :post :users :api]}
+                   @result))))))))

test/cljs/reitit/doo_runner.cljs

@@ -1,7 +1,9 @@
 (ns reitit.doo-runner
   (:require [doo.runner :refer-macros [doo-tests]]
-            reitit.core-test))
+            reitit.core-test
+            reitit.ring-test))
 
 (enable-console-print!)
 
-(doo-tests 'reitit.core-test)
+(doo-tests 'reitit.core-test
+           'reitit.ring-test)