Ring simple-router & method-router

src/reitit/ring.cljc

@@ -1,5 +1,6 @@
 (ns reitit.ring
-  (:require [reitit.core :as reitit]))
+  (:require [meta-merge.core :refer [meta-merge]]
+            [reitit.core :as reitit]))
 
 (defprotocol ExpandMiddleware
   (expand-middleware [this]))
@@ -19,25 +20,78 @@
   nil
   (expand-middleware [_]))
 
-(defn compile-handler [[path {:keys [middleware handler] :as meta}]]
-  (when-not handler
+(defn- ensure-handler! [path meta method]
+  (when-not (:handler meta)
     (throw (ex-info
-             (str "path '" path "' doesn't have a :handler defined")
-             {:path path, :meta meta})))
-  (let [wrap (->> middleware
+             (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))]
-    (wrap handler)))
+       (apply comp identity)))
 
-(defn router [data]
+(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)))))
+         ((: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)

test/cljc/reitit/ring_test.cljc

@@ -1,6 +1,5 @@
 (ns reitit.ring-test
-  (:require [clojure.test :refer [deftest testing is are]]
-            [reitit.core :as reitit]
+  (:require [clojure.test :refer [deftest testing is]]
             [reitit.ring :as ring])
   #?(:clj
      (:import (clojure.lang ExceptionInfo))))
@@ -20,11 +19,13 @@
 
 (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/router ["/ping"]))))
+            #"path \"/ping\" doesn't have a :handler defined"
+            (ring/simple-router ["/ping"]))))
 
     (testing "ring-handler"
       (let [api-mw #(mw % :api)
@@ -33,13 +34,19 @@
                        {:status 200 :body (conj mw :ok)})
                       ([request respond raise]
                        (respond (handle request))))
-          app (ring/ring-handler
-                (ring/router
+            router (ring/simple-router
                      [["/ping" handler]
                       ["/api" {:middleware [api-mw]}
                        ["/ping" handler]
                        ["/admin" {:middleware [[mw :admin]]}
-                     ["/ping" handler]]]]))]
+                        ["/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]}
@@ -53,12 +60,69 @@
           (is (= {:status 200, :body [:api :admin :ok :admin :api]}
                  (app {:uri "/api/admin/ping"}))))
 
-      (testing "not found"
-        (is (= nil (app {:uri "/favicon.ico"}))))
-
         (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)
+            handler (fn handle
+                      ([{:keys [::mw]}]
+                       {:status 200 :body (conj mw :ok)})
+                      ([request respond raise]
+                       (respond (handle request))))
+            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))))))))