From d45dd151b757a3f017097e05b316cfce72e24215 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 21 May 2023 18:11:42 +0300 Subject: [PATCH 1/8] document meta-merge --- doc/advanced/configuring_routers.md | 2 +- modules/reitit-core/src/reitit/core.cljc | 29 ++++++++++++------------ 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/doc/advanced/configuring_routers.md b/doc/advanced/configuring_routers.md index 3bd4a982..223d9959 100644 --- a/doc/advanced/configuring_routers.md +++ b/doc/advanced/configuring_routers.md @@ -11,9 +11,9 @@ Routers can be configured via options. The following options are available for t | `:syntax` | Path-parameter syntax as keyword or set of keywords (default #{:bracket :colon}) | `:expand` | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`) | `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` -| `:meta-merge` | Function which follows the signature of `meta-merge.core/meta-merge`, useful for when you want to have more control over the meta merging | `:compile` | Function of `route opts => result` to compile a route handler | `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects | `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes | `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) +| `:meta-merge` | Function of `left right => merged` to merge route-data (default `meta-merge.core/meta-merge`) | `:router` | Function of `routes opts => router` to override the actual router implementation diff --git a/modules/reitit-core/src/reitit/core.cljc b/modules/reitit-core/src/reitit/core.cljc index 0b32fd73..cd3b092b 100644 --- a/modules/reitit-core/src/reitit/core.cljc +++ b/modules/reitit-core/src/reitit/core.cljc @@ -314,20 +314,21 @@ Selects implementation based on route details. The following options are available: - | key | description - | -------------|------------- - | `:path` | Base-path for routes - | `:routes` | Initial resolved routes (default `[]`) - | `:data` | Initial route data (default `{}`) - | `:spec` | clojure.spec definition for a route data, see `reitit.spec` on how to use this - | `:syntax` | Path-parameter syntax as keyword or set of keywords (default #{:bracket :colon}) - | `:expand` | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`) - | `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` - | `:compile` | Function of `route opts => result` to compile a route handler - | `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects - | `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes - | `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) - | `:router` | Function of `routes opts => router` to override the actual router implementation" + | key | description + | --------------|------------- + | `:path` | Base-path for routes + | `:routes` | Initial resolved routes (default `[]`) + | `:data` | Initial route data (default `{}`) + | `:spec` | clojure.spec definition for a route data, see `reitit.spec` on how to use this + | `:syntax` | Path-parameter syntax as keyword or set of keywords (default #{:bracket :colon}) + | `:expand` | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`) + | `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` + | `:compile` | Function of `route opts => result` to compile a route handler + | `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects + | `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes + | `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) + | `:meta-merge` | Function of `left right => merged` to merge route-data (default `meta-merge.core/meta-merge`) + | `:router` | Function of `routes opts => router` to override the actual router implementation" ([raw-routes] (router raw-routes {})) ([raw-routes opts] From 4d0e40f1353205ad29887356524d5cff2beb1fc3 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 21 May 2023 18:15:44 +0300 Subject: [PATCH 2/8] ctrl.* is such test --- test/cljc/ctrl/apply.cljc | 35 +++++++ test/cljc/ctrl/demo.cljc | 53 +++++++++++ .../src => test/cljc}/ctrl/merge.cljc | 95 +++---------------- 3 files changed, 101 insertions(+), 82 deletions(-) create mode 100644 test/cljc/ctrl/apply.cljc create mode 100644 test/cljc/ctrl/demo.cljc rename {modules/reitit-core/src => test/cljc}/ctrl/merge.cljc (53%) diff --git a/test/cljc/ctrl/apply.cljc b/test/cljc/ctrl/apply.cljc new file mode 100644 index 00000000..dea444a1 --- /dev/null +++ b/test/cljc/ctrl/apply.cljc @@ -0,0 +1,35 @@ +(ns ctrl.apply + (:refer-clojure :exclude [apply]) + (:require [clojure.core :as c])) + +(defn -match [path path-map] + (letfn [(match [x f] (if (fn? f) (f x) (= x f)))] + (reduce + (fn [_ [ps f]] + (let [match (loop [[p & pr] path, [pp & ppr] ps] + (cond (and p pp (match p pp)) (recur pr ppr) + (= nil p pp) true))] + (when match (reduced f)))) + nil path-map))) + +(defn -path-vals [m path-map] + (letfn [(-path-vals [l p m] + (reduce + (fn [l [k v]] + (let [p' (conj p k) + f (-match p' path-map)] + (cond + f (cons [p' (f v)] l) + (map? v) (-path-vals l p' v) + :else (cons [p' v] l)))) + l m))] + (-path-vals [] [] m))) + +(defn -assoc-in-path-vals [c] + (reduce (partial c/apply assoc-in) {} c)) + +(defn any [_] true) + +(defn apply [m path-map] + (-> (-path-vals m path-map) + (-assoc-in-path-vals))) diff --git a/test/cljc/ctrl/demo.cljc b/test/cljc/ctrl/demo.cljc new file mode 100644 index 00000000..ab2c3c5b --- /dev/null +++ b/test/cljc/ctrl/demo.cljc @@ -0,0 +1,53 @@ +(ns ctrl.demo + (:require [reitit.core :as r] + [reitit.ring :as ring] + [ctrl.merge :as cm] + [ctrl.apply :as ca])) + +(-> (ring/router + ["/api" {:parameters {:header [:map ["Api" :string]]}} + ["/math/:x" {:parameters {:path [:map [:x :int]] + :query [:map [:b :string]] + :header [:map ["Math" :string]]} + :responses {200 {:body [:map [:total :int]]} + 500 {:description "fail"}}} + ["/plus/:y" {:get {:parameters {:query ^:replace [:map [:a :int]] + :body [:map [:b :int]] + :header [:map ["Plus" :string]] + :path [:map [:y :int]]} + :responses {200 {:body [:map [:total2 :int]]} + 500 {:description "fail"}} + :handler (constantly {:status 200, :body "ok"})}}]]]) + (ring/ring-handler) + (ring/get-router) + (r/compiled-routes) + (last) + (last) + :get + :data) + +(def path-map [[[:parameters any?] vector] + [[any? :parameters any?] vector] + [[:responses any? :body] vector] + [[any? :responses any? :body] vector]]) + +;; using apply as pre-merge +(cm/merge + (ca/apply + {:parameters {:query [:map [:x :int]]} + :get {:parameters {:query [:map [:x :int]]} + :responses {200 {:body [:map [:total :int]]}}}} + path-map) + (ca/apply + {:parameters {:query [:map [:y :int]]} + :get {:parameters {:query [:map [:y :int]]} + :responses {200 {:body [:map [:total :int]]}}} + :post {:parameters {:query [:map [:y :int]]}}} + path-map)) +;{:get {:responses {200 {:body [[:map [:total :int]] +; [:map [:total :int]]]}}, +; :parameters {:query [[:map [:x :int]] +; [:map [:y :int]]]}}, +; :parameters {:query [[:map [:x :int]] +; [:map [:y :int]]]}, +; :post {:parameters {:query [[:map [:y :int]]]}}} diff --git a/modules/reitit-core/src/ctrl/merge.cljc b/test/cljc/ctrl/merge.cljc similarity index 53% rename from modules/reitit-core/src/ctrl/merge.cljc rename to test/cljc/ctrl/merge.cljc index f1c5d114..5b16385b 100644 --- a/modules/reitit-core/src/ctrl/merge.cljc +++ b/test/cljc/ctrl/merge.cljc @@ -67,12 +67,17 @@ (= nil p pp) true))] (when match (reduced f)))) nil path-map))) +(defrecord Acc [data]) +(defn accumulate? [x] (instance? Acc x)) +(defn unaccumulate [x] (if (accumulate? x) (:data x) x)) +(defn accumulate + ([x] (if (accumulate? x) x (->Acc [x]))) + ([x y] (update (accumulate x) :data into (unaccumulate y)))) + ;; ;; public api ;; -(defn any [_] true) - (defn merge ([] {}) ([left] left) @@ -83,6 +88,9 @@ (different-priority? left right) (pick-prioritized left right options) + (accumulate? left) + (accumulate left right) + custom-merge (custom-merge left right options) @@ -90,7 +98,9 @@ (let [merge-entry (fn [m e] (let [k (key e) v (val e)] (if (contains? m k) - (assoc m k (merge (get m k) v (update options ::path (fnil conj []) k))) + (assoc m k (merge (get m k) v (-> options + (update ::path (fnil conj []) k) + (update ::acc assoc (or path []) m)))) (assoc m k v)))) merge2 (fn [m1 m2] (reduce merge-entry (or m1 {}) (seq m2)))] @@ -108,82 +118,3 @@ (into (empty left) (concat left right))) :else right)))) - -;; -;; spike -;; - -(comment - (merge - {:parameters {:query {:x 1}}} - {:parameters {:query nil}} - {::replace-nil true})) - -(ns demo2) - -(require '[reitit.ring :as ring] - '[malli.util :as mu] - '[reitit.core :as r] - '[ctrl.merge :as cm]) - -(defn ring-path-map [f] - [[[:parameters cm/any] f] - [[ring/http-methods :parameters cm/any] f] - [[:responses cm/any :body] f] - [[ring/http-methods :responses cm/any :body] f]]) - -(defn malli-merge [x y _] (mu/merge x y)) - -(-> (ring/router - ["/api" {:parameters {:header [:map ["Api" :string]]}} - ["/math/:x" {:parameters {:path [:map [:x :int]] - :query [:map [:b :string]] - :header [:map ["Math" :string]]} - :responses {200 {:body [:map [:total :int]]} - 500 {:description "fail"}}} - ["/plus/:y" {:get {:parameters {:query ^:replace [:map [:a :int]] - :body [:map [:b :int]] - :header [:map ["Plus" :string]] - :path [:map [:y :int]]} - :responses {200 {:body [:map [:total2 :int]]} - 500 {:description "fail"}} - :handler (constantly {:status 200, :body "ok"})}}]]] - {:meta-merge #(cm/merge %1 %2 {::cm/path-map (ring-path-map malli-merge)})}) - (ring/ring-handler) - (ring/get-router) - (r/compiled-routes) - (last) - (last) - :get - :data) -;{:parameters {:header [:map -; ["Api" :string] -; ["Math" :string] -; ["Plus" :string]], -; :path [:map -; [:x :int] -; [:y :int]], -; :query [:map [:a :int]], -; :body [:map [:b :int]]}, -; :responses {200 {:body [:map -; [:total :int] -; [:total2 :int]]} -; 500 {:description "fail"}}, -; :handler #object[clojure.core$constantly$fn__5740]} - -(cm/merge - {:parameters {:query [:map [:x :int]]} - :get {:parameters {:query [:map [:x :int]]} - :responses {200 {:body [:map [:total :int]]}}}} - {:parameters {:query [:map [:y :int]]} - :get {:parameters {:query [:map [:y :int]]} - :responses {200 {:body [:map [:total :int]]}}} - :post {:parameters {:query [:map [:y :int]]}}} - {::cm/path-map [[[:parameters cm/any] malli-merge] - [[cm/any :parameters cm/any] malli-merge] - [[:responses cm/any :body] malli-merge] - [[cm/any :responses cm/any :body] malli-merge]]}) -;{:parameters {:query [:map [:x :int] [:y :int]]}, -; :get {:parameters {:query [:map [:x :int] [:y :int]]} -; :responses {200 {:body [:map [:total :int]]}}}, -; :post {:parameters {:query [:map [:y :int]]}}} From 550ea6da58918424b8bb958182ccd068fc5f9604 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 21 May 2023 20:13:43 +0300 Subject: [PATCH 3/8] path-update --- modules/reitit-core/src/reitit/impl.cljc | 45 ++++++++++++++++++++++++ test/cljc/reitit/impl_test.cljc | 15 ++++++++ 2 files changed, 60 insertions(+) diff --git a/modules/reitit-core/src/reitit/impl.cljc b/modules/reitit-core/src/reitit/impl.cljc index 8c6d1cbb..173c07c9 100644 --- a/modules/reitit-core/src/reitit/impl.cljc +++ b/modules/reitit-core/src/reitit/impl.cljc @@ -9,6 +9,51 @@ (:import (java.net URLEncoder URLDecoder) (java.util HashMap Map)))) +;; +;; path-update +;; + +(defn -match [path path-map] + (letfn [(match [x f] (if (fn? f) (f x) (= x f)))] + (reduce + (fn [_ [ps f]] + (let [match (loop [[p & pr] path, [pp & ppr] ps] + (cond (and p pp (match p pp)) (recur pr ppr) + (= nil p pp) true))] + (when match (reduced f)))) + nil path-map))) + +(defn -path-vals [m path-map] + (letfn [(-path-vals [l p m] + (reduce + (fn [l [k v]] + (let [p' (conj p k) + f (-match p' path-map)] + (cond + f (cons [p' (f v)] l) + (and (map? v) (seq v)) (-path-vals l p' v) + :else (cons [p' v] l)))) + l m))] + (reverse (-path-vals [] [] m)))) + +(defn -assoc-in-path-vals [c] + (reduce (partial apply assoc-in) {} c)) + +(defn path-update [m path-map] + (-> (-path-vals m path-map) + (-assoc-in-path-vals))) + +(defn accumulator? [x] + (-> x meta ::accumulator)) + +(defn accumulate + ([x] (if-not (accumulator? x) (with-meta [x] {::accumulator true}) x)) + ([x y] (into (accumulate x) y))) + +;; +;; impl +;; + (defn parse [path opts] (let [path #?(:clj (.intern ^String (trie/normalize path opts)) :cljs (trie/normalize path opts)) path-parts (trie/split-path path opts) diff --git a/test/cljc/reitit/impl_test.cljc b/test/cljc/reitit/impl_test.cljc index 0059723b..dee92921 100644 --- a/test/cljc/reitit/impl_test.cljc +++ b/test/cljc/reitit/impl_test.cljc @@ -171,3 +171,18 @@ :path-parts ["https://google.com"] :path-params #{}} (impl/parse "https://google.com" nil)))) + +(deftest path-update-test + (is (= {:get {:responses {200 {:body [[:map [:total :int]]]}} + :parameters {:query [[:map [:x :int]]]}}, + :parameters {:query [[:map [:x :int]]]} + :post {}} + (impl/path-update + {:parameters {:query [:map [:x :int]]} + :get {:parameters {:query [:map [:x :int]]} + :responses {200 {:body [:map [:total :int]]}}} + :post {}} + [[[:parameters any?] vector] + [[any? :parameters any?] vector] + [[:responses any? :body] vector] + [[any? :responses any? :body] vector]])))) From 3f265888a4c0e475b58f1a599b7adfd19d696feb Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 21 May 2023 20:16:45 +0300 Subject: [PATCH 4/8] cleanup --- .../reitit-frontend/src/reitit/frontend.cljs | 4 +- test/cljc/reitit/core_test.cljc | 8 +- test/cljc/reitit/openapi_test.clj | 262 +++++++++--------- test/cljc/reitit/swagger_test.clj | 3 +- 4 files changed, 138 insertions(+), 139 deletions(-) diff --git a/modules/reitit-frontend/src/reitit/frontend.cljs b/modules/reitit-frontend/src/reitit/frontend.cljs index f7183b40..ba122802 100644 --- a/modules/reitit-frontend/src/reitit/frontend.cljs +++ b/modules/reitit-frontend/src/reitit/frontend.cljs @@ -67,8 +67,8 @@ fragment (when (.hasFragment uri) (.getFragment uri)) match (assoc match - :query-params q - :fragment fragment) + :query-params q + :fragment fragment) ;; Return uncoerced values if coercion is not enabled - so ;; that tha parameters are always accessible from same property. parameters (or (coerce! match) diff --git a/test/cljc/reitit/core_test.cljc b/test/cljc/reitit/core_test.cljc index fc112239..ab93cce6 100644 --- a/test/cljc/reitit/core_test.cljc +++ b/test/cljc/reitit/core_test.cljc @@ -267,14 +267,14 @@ (let [pong (constantly "ok") routes ["/api" {:mw [:api]} ["/ping" :kikka] - ["/user/:id" {:parameters {:id "String"}} - ["/:sub-id" {:parameters {:sub-id "String"}}]] + ["/user/:id" {:parameters {:path {:id :string}}} + ["/:sub-id" {:parameters {:path {:sub-id :string}}}]] ["/pong" pong] ["/admin" {:mw [:admin] :roles #{:admin}} ["/user" {:roles ^:replace #{:user}}] ["/db" {:mw [:db]}]]] expected [["/api/ping" {:mw [:api], :name :kikka}] - ["/api/user/:id/:sub-id" {:mw [:api], :parameters {:id "String", :sub-id "String"}}] + ["/api/user/:id/:sub-id" {:mw [:api], :parameters {:path [{:id :string} {:sub-id :string}]}}] ["/api/pong" {:mw [:api], :handler pong}] ["/api/admin/user" {:mw [:api :admin], :roles #{:user}}] ["/api/admin/db" {:mw [:api :admin :db], :roles #{:admin}}]] @@ -282,7 +282,7 @@ (is (= expected (impl/resolve-routes routes (r/default-router-options)))) (is (= (r/map->Match {:template "/api/user/:id/:sub-id" - :data {:mw [:api], :parameters {:id "String", :sub-id "String"}} + :data {:mw [:api], :parameters {:path [{:id :string} {:sub-id :string}]}} :path "/api/user/1/2" :path-params {:id "1", :sub-id "2"}}) (r/match-by-path router "/api/user/1/2")))))) diff --git a/test/cljc/reitit/openapi_test.clj b/test/cljc/reitit/openapi_test.clj index a2d4c284..605f5e04 100644 --- a/test/cljc/reitit/openapi_test.clj +++ b/test/cljc/reitit/openapi_test.clj @@ -32,101 +32,101 @@ (def app (ring/ring-handler - (ring/router - ["/api" - {:openapi {:id ::math}} + (ring/router + ["/api" + {:openapi {:id ::math}} - ["/openapi.json" - {:get {:no-doc true - :openapi {:info {:title "my-api" - :version "0.0.1"}} - :handler (openapi/create-openapi-handler)}}] + ["/openapi.json" + {:get {:no-doc true + :openapi {:info {:title "my-api" + :version "0.0.1"}} + :handler (openapi/create-openapi-handler)}}] - ["/spec" {:coercion spec/coercion} - ["/plus/:z" - {:get {:summary "plus" - :tags [:plus :spec] - :parameters {:query {:x int?, :y int?} - :path {:z int?}} - :openapi {:operationId "spec-plus" - :deprecated true - :responses {400 {:description "kosh" - :content {"application/json" {:schema {:type "string"}}}}}} - :responses {200 {:description "success" - :body {:total int?}} - 500 {:description "fail"}} - :handler (fn [{{{:keys [x y]} :query - {:keys [z]} :path} :parameters}] - {:status 200, :body {:total (+ x y z)}})} - :post {:summary "plus with body" - :parameters {:body (ds/maybe [int?]) - :path {:z int?}} - :openapi {:responses {400 {:content {"application/json" {:schema {:type "string"}}} - :description "kosh"}}} - :responses {200 {:description "success" - :body {:total int?}} - 500 {:description "fail"}} - :handler (fn [{{{:keys [z]} :path - xs :body} :parameters}] - {:status 200, :body {:total (+ (reduce + xs) z)}})}}]] + ["/spec" {:coercion spec/coercion} + ["/plus/:z" + {:get {:summary "plus" + :tags [:plus :spec] + :parameters {:query {:x int?, :y int?} + :path {:z int?}} + :openapi {:operationId "spec-plus" + :deprecated true + :responses {400 {:description "kosh" + :content {"application/json" {:schema {:type "string"}}}}}} + :responses {200 {:description "success" + :body {:total int?}} + 500 {:description "fail"}} + :handler (fn [{{{:keys [x y]} :query + {:keys [z]} :path} :parameters}] + {:status 200, :body {:total (+ x y z)}})} + :post {:summary "plus with body" + :parameters {:body (ds/maybe [int?]) + :path {:z int?}} + :openapi {:responses {400 {:content {"application/json" {:schema {:type "string"}}} + :description "kosh"}}} + :responses {200 {:description "success" + :body {:total int?}} + 500 {:description "fail"}} + :handler (fn [{{{:keys [z]} :path + xs :body} :parameters}] + {:status 200, :body {:total (+ (reduce + xs) z)}})}}]] - ["/malli" {:coercion malli/coercion} - ["/plus/*z" - {:get {:summary "plus" - :tags [:plus :malli] - :parameters {:query [:map [:x int?] [:y int?]] - :path [:map [:z int?]]} - :openapi {:responses {400 {:description "kosh" - :content {"application/json" {:schema {:type "string"}}}}}} - :responses {200 {:description "success" - :body [:map [:total int?]]} - 500 {:description "fail"}} - :handler (fn [{{{:keys [x y]} :query - {:keys [z]} :path} :parameters}] - {:status 200, :body {:total (+ x y z)}})} - :post {:summary "plus with body" - :parameters {:body [:maybe [:vector int?]] - :path [:map [:z int?]]} - :openapi {:responses {400 {:description "kosh" - :content {"application/json" {:schema {:type "string"}}}}}} - :responses {200 {:description "success" - :body [:map [:total int?]]} - 500 {:description "fail"}} - :handler (fn [{{{:keys [z]} :path - xs :body} :parameters}] - {:status 200, :body {:total (+ (reduce + xs) z)}})}}]] + ["/malli" {:coercion malli/coercion} + ["/plus/*z" + {:get {:summary "plus" + :tags [:plus :malli] + :parameters {:query [:map [:x int?] [:y int?]] + :path [:map [:z int?]]} + :openapi {:responses {400 {:description "kosh" + :content {"application/json" {:schema {:type "string"}}}}}} + :responses {200 {:description "success" + :body [:map [:total int?]]} + 500 {:description "fail"}} + :handler (fn [{{{:keys [x y]} :query + {:keys [z]} :path} :parameters}] + {:status 200, :body {:total (+ x y z)}})} + :post {:summary "plus with body" + :parameters {:body [:maybe [:vector int?]] + :path [:map [:z int?]]} + :openapi {:responses {400 {:description "kosh" + :content {"application/json" {:schema {:type "string"}}}}}} + :responses {200 {:description "success" + :body [:map [:total int?]]} + 500 {:description "fail"}} + :handler (fn [{{{:keys [z]} :path + xs :body} :parameters}] + {:status 200, :body {:total (+ (reduce + xs) z)}})}}]] - ["/schema" {:coercion schema/coercion} - ["/plus/*z" - {:get {:summary "plus" - :tags [:plus :schema] - :parameters {:query {:x s/Int, :y s/Int} + ["/schema" {:coercion schema/coercion} + ["/plus/*z" + {:get {:summary "plus" + :tags [:plus :schema] + :parameters {:query {:x s/Int, :y s/Int} :path {:z s/Int}} - :openapi {:responses {400 {:content {"application/json" {:schema {:type "string"}}} - :description "kosh"}}} - :responses {200 {:description "success" - :body {:total s/Int}} - 500 {:description "fail"}} - :handler (fn [{{{:keys [x y]} :query - {:keys [z]} :path} :parameters}] - {:status 200, :body {:total (+ x y z)}})} - :post {:summary "plus with body" - :parameters {:body (s/maybe [s/Int]) - :path {:z s/Int}} - :openapi {:responses {400 {:content {"application/json" {:schema {:type "string"}}} - :description "kosh"}}} - :responses {200 {:description "success" - :body {:total s/Int}} - 500 {:description "fail"}} - :handler (fn [{{{:keys [z]} :path - xs :body} :parameters}] - {:status 200, :body {:total (+ (reduce + xs) z)}})}}]]] + :openapi {:responses {400 {:content {"application/json" {:schema {:type "string"}}} + :description "kosh"}}} + :responses {200 {:description "success" + :body {:total s/Int}} + 500 {:description "fail"}} + :handler (fn [{{{:keys [x y]} :query + {:keys [z]} :path} :parameters}] + {:status 200, :body {:total (+ x y z)}})} + :post {:summary "plus with body" + :parameters {:body (s/maybe [s/Int]) + :path {:z s/Int}} + :openapi {:responses {400 {:content {"application/json" {:schema {:type "string"}}} + :description "kosh"}}} + :responses {200 {:description "success" + :body {:total s/Int}} + 500 {:description "fail"}} + :handler (fn [{{{:keys [z]} :path + xs :body} :parameters}] + {:status 200, :body {:total (+ (reduce + xs) z)}})}}]]] - {:validate reitit.ring.spec/validate - :data {:middleware [openapi/openapi-feature - rrc/coerce-exceptions-middleware - rrc/coerce-request-middleware - rrc/coerce-response-middleware]}}))) + {:validate reitit.ring.spec/validate + :data {:middleware [openapi/openapi-feature + rrc/coerce-exceptions-middleware + rrc/coerce-request-middleware + rrc/coerce-response-middleware]}}))) (deftest openapi-test (testing "endpoints work" @@ -294,21 +294,21 @@ {:get {:no-doc true :handler (openapi/create-openapi-handler)}}] app (ring/ring-handler - (ring/router - [["/common" {:openapi {:id #{::one ::two}}} - ping-route] + (ring/router + [["/common" {:openapi {:id #{::one ::two}}} + ping-route] - ["/one" {:openapi {:id ::one}} - ping-route - spec-route] + ["/one" {:openapi {:id ::one}} + ping-route + spec-route] - ["/two" {:openapi {:id ::two}} - ping-route - spec-route - ["/deep" {:openapi {:id ::one}} - ping-route]] - ["/one-two" {:openapi {:id #{::one ::two}}} - spec-route]]))] + ["/two" {:openapi {:id ::two}} + ping-route + spec-route + ["/deep" {:openapi {:id ::one}} + ping-route]] + ["/one-two" {:openapi {:id #{::one ::two}}} + spec-route]]))] (is (= ["/common/ping" "/one/ping" "/two/deep/ping"] (spec-paths app "/one/openapi.json"))) (is (= ["/common/ping" "/two/ping"] @@ -318,9 +318,9 @@ (deftest openapi-ui-config-test (let [app (swagger-ui/create-swagger-ui-handler - {:path "/" - :url "/openapi.json" - :config {:jsonEditor true}})] + {:path "/" + :url "/openapi.json" + :config {:jsonEditor true}})] (is (= 302 (:status (app {:request-method :get, :uri "/"})))) (is (= 200 (:status (app {:request-method :get, :uri "/index.html"})))) (is (= {:jsonEditor true, :url "/openapi.json"} @@ -329,12 +329,12 @@ (deftest without-openapi-id-test (let [app (ring/ring-handler - (ring/router - [["/ping" - {:get (constantly "ping")}] - ["/openapi.json" - {:get {:no-doc true - :handler (openapi/create-openapi-handler)}}]]))] + (ring/router + [["/ping" + {:get (constantly "ping")}] + ["/openapi.json" + {:get {:no-doc true + :handler (openapi/create-openapi-handler)}}]]))] (is (= ["/ping"] (spec-paths app "/openapi.json"))) (is (= #{::openapi/default} (-> {:request-method :get :uri "/openapi.json"} @@ -342,14 +342,14 @@ (deftest with-options-endpoint-test (let [app (ring/ring-handler - (ring/router - [["/ping" - {:options (constantly "options")}] - ["/pong" - (constantly "options")] - ["/openapi.json" - {:get {:no-doc true - :handler (openapi/create-openapi-handler)}}]]))] + (ring/router + [["/ping" + {:options (constantly "options")}] + ["/pong" + (constantly "options")] + ["/openapi.json" + {:get {:no-doc true + :handler (openapi/create-openapi-handler)}}]]))] (is (= ["/ping" "/pong"] (spec-paths app "/openapi.json"))) (is (= #{::openapi/default} (-> {:request-method :get :uri "/openapi.json"} @@ -370,7 +370,7 @@ {:description (str "description " nom)})})] [#'spec/coercion (fn [nom] {nom (st/spec {:spec string? :description (str "description " nom)})})]]] - (testing coercion + (testing (str coercion) (let [app (ring/ring-handler (ring/router [["/parameters" @@ -414,9 +414,9 @@ :required true :description "description :p" :schema {:type "string"}}] - (-> spec - (get-in [:paths "/parameters" :post :parameters]) - normalize)))) + (-> spec + (get-in [:paths "/parameters" :post :parameters]) + normalize)))) (testing "body parameter" (is (match? (merge {:type "object" :properties {:b {:type "string"}} @@ -449,9 +449,9 @@ {:openapi/example {nom "EXAMPLE2"}}))] [#'spec/coercion (fn [nom] (assoc - (ds/spec ::foo {nom (st/spec string? {:openapi/example "EXAMPLE"})}) - :openapi/example {nom "EXAMPLE2"}))]]] - (testing coercion + (ds/spec ::foo {nom (st/spec string? {:openapi/example "EXAMPLE"})}) + :openapi/example {nom "EXAMPLE2"}))]]] + (testing (str coercion) (let [app (ring/ring-handler (ring/router [["/examples" @@ -489,9 +489,9 @@ :required true :schema {:type "string" :example "EXAMPLE"}}] - (-> spec - (get-in [:paths "/examples" :post :parameters]) - normalize)))) + (-> spec + (get-in [:paths "/examples" :post :parameters]) + normalize)))) (testing "body parameter" (is (match? {:schema {:type "object" :properties {:b {:type "string" @@ -531,7 +531,7 @@ [#'spec/coercion reitit.http.interceptors.multipart/bytes-part string?]]] - (testing coercion + (testing (str coercion) (let [app (ring/ring-handler (ring/router [["/upload" @@ -569,7 +569,7 @@ [[#'malli/coercion (fn [nom] [:map [nom :string]])] [#'schema/coercion (fn [nom] {nom s/Str})] [#'spec/coercion (fn [nom] {nom string?})]]] - (testing coercion + (testing (str coercion) (let [app (ring/ring-handler (ring/router [["/parameters" diff --git a/test/cljc/reitit/swagger_test.clj b/test/cljc/reitit/swagger_test.clj index d2d18c31..c00f9cd7 100644 --- a/test/cljc/reitit/swagger_test.clj +++ b/test/cljc/reitit/swagger_test.clj @@ -114,7 +114,6 @@ rrc/coerce-request-middleware rrc/coerce-response-middleware]}}))) -(require '[fipp.edn]) (deftest swagger-test (testing "endpoints work" (testing "spec" @@ -430,7 +429,7 @@ [#'spec/coercion reitit.http.interceptors.multipart/bytes-part string?]]] - (testing coercion + (testing (str coercion) (let [app (ring/ring-handler (ring/router [["/upload" From ce06214014499caf86d3abd65884a85e7004b53d Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 21 May 2023 20:32:40 +0300 Subject: [PATCH 5/8] welcome 2-phase schema compilation 1) use `:update-paths` to handle data in certain (loose) paths differently - accumulate schemas in all relevant routers into vector - we do not know the coercion here (ring/http have special handling of data, e.g. http-methods) 2) run coercion compiler for the model to merge the effective model - schema + malli = should work ok, spec = best effort 3) publish final schemas into compiled route data --- CHANGELOG.md | 9 +- doc/advanced/configuring_routers.md | 33 ++-- modules/reitit-core/src/reitit/coercion.cljc | 54 +++--- modules/reitit-core/src/reitit/core.cljc | 32 ++-- modules/reitit-core/src/reitit/impl.cljc | 6 +- modules/reitit-http/src/reitit/http.cljc | 12 +- .../src/reitit/coercion/malli.cljc | 163 +++++++++--------- modules/reitit-ring/src/reitit/ring.cljc | 31 +++- .../src/reitit/coercion/schema.cljc | 45 ++--- .../reitit-spec/src/reitit/coercion/spec.cljc | 59 +++---- test/cljc/reitit/coercion_test.cljc | 35 ++-- test/cljc/reitit/impl_test.cljc | 21 +++ test/cljc/reitit/ring_coercion_test.cljc | 44 +++-- 13 files changed, 299 insertions(+), 245 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 79db8dc8..cacbce06 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,7 +12,10 @@ We use [Break Versioning][breakver]. The version numbers follow a `.. data` to expand route arg to route data (default `reitit.core/expand`) -| `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` -| `:compile` | Function of `route opts => result` to compile a route handler -| `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects -| `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes -| `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) -| `:meta-merge` | Function of `left right => merged` to merge route-data (default `meta-merge.core/meta-merge`) -| `:router` | Function of `routes opts => router` to override the actual router implementation +| key | description +|-----------------|------------- +| `:path` | Base-path for routes +| `:routes` | Initial resolved routes (default `[]`) +| `:data` | Initial route data (default `{}`) +| `:spec` | clojure.spec definition for a route data, see `reitit.spec` on how to use this +| `:syntax` | Path-parameter syntax as keyword or set of keywords (default #{:bracket :colon}) +| `:expand` | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`) +| `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` +| `:compile` | Function of `route opts => result` to compile a route handler +| `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects +| `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes +| `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) +| `:meta-merge` | Function of `left right => merged` to merge route-data (default `meta-merge.core/meta-merge`) +| `:update-paths` | Sequence of Vectors with elements `update-path` and `function`, used to preprocess route data +| `:router` | Function of `routes opts => router` to override the actual router implementation + + diff --git a/modules/reitit-core/src/reitit/coercion.cljc b/modules/reitit-core/src/reitit/coercion.cljc index 2c1af0c7..0952bfab 100644 --- a/modules/reitit-core/src/reitit/coercion.cljc +++ b/modules/reitit-core/src/reitit/coercion.cljc @@ -94,8 +94,9 @@ (conj (:content model) [:default (:body model)]) [[:default model]]) format->coercer (some->> (for [[format schema] format-schema-pairs - :when schema] - [format (-request-coercer coercion (case style :request :body style) (->open schema))]) + :when schema + :let [type (case style :request :body style)]] + [format (-request-coercer coercion type (->open schema))]) (filter second) (seq) (into {}))] @@ -117,7 +118,8 @@ (defn response-coercer [coercion {:keys [content body]} {:keys [extract-response-format serialize-failed-result] :or {extract-response-format extract-response-format-default}}] (if coercion - (let [per-format-coercers (some->> (for [[format schema] content] + (let [per-format-coercers (some->> (for [[format schema] content + :when schema] [format (-response-coercer coercion schema)]) (filter second) (seq) @@ -152,25 +154,23 @@ response))) (defn request-coercers [coercion parameters opts] - (some->> (for [[k v] parameters - :when v] + (some->> (for [[k v] parameters, :when v] [k (request-coercer coercion k v opts)]) - (filter second) - (seq) - (into {}))) + (filter second) (seq) (into {}))) (defn response-coercers [coercion responses opts] (some->> (for [[status model] responses] [status (response-coercer coercion model opts)]) - (filter second) - (seq) - (into {}))) + (filter second) (seq) (into {}))) + +(defn -compile-parameters [data coercion] + (impl/path-update data [[[:parameters any?] #(-compile-model coercion % nil)]])) ;; ;; api-docs ;; -(defn -warn-unsupported-coercions [{:keys [parameters responses] :as data}] +(defn -warn-unsupported-coercions [{:keys [parameters responses] :as _data}] (when (:request parameters) (println "WARNING [reitit.coercion]: swagger apidocs don't support :request coercion")) (when (some :content (vals responses)) @@ -204,17 +204,29 @@ (defn compile-request-coercers "A router :compile implementation which reads the `:parameters` - and `:coercion` data to create compiled coercers into Match under - `:result. A pre-requisite to use [[coerce!]]." - [[_ {:keys [parameters coercion]}] opts] + and `:coercion` data to both compile the schemas and create compiled coercers + into Match under `:result with the following keys: + + | key | description + | ----------|------------- + | `:data` | data with compiled schemas + | `:coerce` | function of `Match -> coerced parameters` to coerce parameters + + A pre-requisite to use [[coerce!]]. + + NOTE: this is not needed with ring/http, where the coercion compilation is + managed in the request coercion middleware/interceptors." + [[_ {:keys [parameters coercion] :as data}] opts] (if (and parameters coercion) - (request-coercers coercion parameters opts))) + (let [{:keys [parameters] :as data} (-compile-parameters data coercion)] + {:data data + :coerce (request-coercers coercion parameters opts)}))) (defn coerce! - "Returns a map of coerced input parameters using pre-compiled - coercers under `:result` (provided by [[compile-request-coercers]]. - Throws `ex-info` if parameters can't be coerced - If coercion or parameters are not defined, return `nil`" + "Returns a map of coerced input parameters using pre-compiled coercers in `Match` + under path `[:result :coerce]` (provided by [[compile-request-coercers]]. + Throws `ex-info` if parameters can't be coerced. If coercion or parameters + are not defined, returns `nil`" [match] - (if-let [coercers (:result match)] + (if-let [coercers (-> match :result :coerce)] (coerce-request coercers match))) diff --git a/modules/reitit-core/src/reitit/core.cljc b/modules/reitit-core/src/reitit/core.cljc index cd3b092b..96264581 100644 --- a/modules/reitit-core/src/reitit/core.cljc +++ b/modules/reitit-core/src/reitit/core.cljc @@ -307,6 +307,7 @@ :coerce (fn coerce [route _] route) :compile (fn compile [[_ {:keys [handler]}] _] handler) :exception exception/exception + :update-paths [[[:parameters any?] impl/accumulate]] :conflicts (fn throw! [conflicts] (exception/fail! :path-conflicts conflicts))}) (defn router @@ -314,21 +315,22 @@ Selects implementation based on route details. The following options are available: - | key | description - | --------------|------------- - | `:path` | Base-path for routes - | `:routes` | Initial resolved routes (default `[]`) - | `:data` | Initial route data (default `{}`) - | `:spec` | clojure.spec definition for a route data, see `reitit.spec` on how to use this - | `:syntax` | Path-parameter syntax as keyword or set of keywords (default #{:bracket :colon}) - | `:expand` | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`) - | `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` - | `:compile` | Function of `route opts => result` to compile a route handler - | `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects - | `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes - | `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) - | `:meta-merge` | Function of `left right => merged` to merge route-data (default `meta-merge.core/meta-merge`) - | `:router` | Function of `routes opts => router` to override the actual router implementation" + | key | description + | ----------------|------------- + | `:path` | Base-path for routes + | `:routes` | Initial resolved routes (default `[]`) + | `:data` | Initial route data (default `{}`) + | `:spec` | clojure.spec definition for a route data, see `reitit.spec` on how to use this + | `:syntax` | Path-parameter syntax as keyword or set of keywords (default #{:bracket :colon}) + | `:expand` | Function of `arg opts => data` to expand route arg to route data (default `reitit.core/expand`) + | `:coerce` | Function of `route opts => route` to coerce resolved route, can throw or return `nil` + | `:compile` | Function of `route opts => result` to compile a route handler + | `:validate` | Function of `routes opts => ()` to validate route (data) via side-effects + | `:conflicts` | Function of `{route #{route}} => ()` to handle conflicting routes + | `:exception` | Function of `Exception => Exception ` to handle creation time exceptions (default `reitit.exception/exception`) + | `:meta-merge` | Function of `left right => merged` to merge route-data (default `meta-merge.core/meta-merge`) + | `:update-paths` | Sequence of Vectors with elements `update-path` and `function`, used to preprocess route data + | `:router` | Function of `routes opts => router` to override the actual router implementation" ([raw-routes] (router raw-routes {})) ([raw-routes opts] diff --git a/modules/reitit-core/src/reitit/impl.cljc b/modules/reitit-core/src/reitit/impl.cljc index 173c07c9..9eb87894 100644 --- a/modules/reitit-core/src/reitit/impl.cljc +++ b/modules/reitit-core/src/reitit/impl.cljc @@ -105,8 +105,10 @@ (defn map-data [f routes] (mapv (fn [[p ds]] [p (f p ds)]) routes)) -(defn meta-merge [left right opts] - ((or (:meta-merge opts) mm/meta-merge) left right)) +(defn meta-merge [left right {:keys [meta-merge update-paths]}] + (let [update (if update-paths #(path-update % update-paths) identity) + merge (or meta-merge mm/meta-merge)] + (merge (update left) (update right)))) (defn merge-data [opts p x] (reduce diff --git a/modules/reitit-http/src/reitit/http.cljc b/modules/reitit-http/src/reitit/http.cljc index bf0f3ae5..b6038555 100644 --- a/modules/reitit-http/src/reitit/http.cljc +++ b/modules/reitit-http/src/reitit/http.cljc @@ -22,11 +22,12 @@ compile (fn [[path data] opts scope] (interceptor/compile-result [path data] opts scope)) ->endpoint (fn [p d m s] - (let [compiled (compile [p d] opts s)] - (-> compiled - (map->Endpoint) - (assoc :path p) - (assoc :method m)))) + (let [d (ring/-compile-coercion d)] + (let [compiled (compile [p d] opts s)] + (-> compiled + (map->Endpoint) + (assoc :path p) + (assoc :method m))))) ->methods (fn [any? data] (reduce (fn [acc method] @@ -67,6 +68,7 @@ ([data opts] (let [opts (merge {:coerce coerce-handler :compile compile-result + :update-paths (ring/-update-paths impl/accumulate) ::default-options-endpoint ring/default-options-endpoint} opts)] (when (contains? opts ::default-options-handler) (ex/fail! (str "Option :reitit.http/default-options-handler is deprecated." diff --git a/modules/reitit-malli/src/reitit/coercion/malli.cljc b/modules/reitit-malli/src/reitit/coercion/malli.cljc index cb9ca777..6f4dff5b 100644 --- a/modules/reitit-malli/src/reitit/coercion/malli.cljc +++ b/modules/reitit-malli/src/reitit/coercion/malli.cljc @@ -139,85 +139,84 @@ parameters (dissoc parameters :request :body :multipart) ->schema-object (fn [schema opts] (let [current-opts (merge options opts)] - (json-schema/transform (coercion/-compile-model coercion schema current-opts) - current-opts)))] + (json-schema/transform schema current-opts)))] (merge - (when (seq parameters) - {:parameters - (->> (for [[in schema] parameters - :let [{:keys [properties required]} (->schema-object schema {:in in :type :parameter}) - required? (partial contains? (set required))] - [k schema] properties] - (merge {:in (name in) - :name k - :required (required? k) - :schema schema} - (select-keys schema [:description]))) - (into []))}) - (when body - ;; body uses a single schema to describe every :requestBody - ;; the schema-object transformer should be able to transform into distinct content-types - {:requestBody {:content (into {} - (map (fn [content-type] - (let [schema (->schema-object body {:in :requestBody + (when (seq parameters) + {:parameters + (->> (for [[in schema] parameters + :let [{:keys [properties required]} (->schema-object schema {:in in :type :parameter}) + required? (partial contains? (set required))] + [k schema] properties] + (merge {:in (name in) + :name k + :required (required? k) + :schema schema} + (select-keys schema [:description]))) + (into []))}) + (when body + ;; body uses a single schema to describe every :requestBody + ;; the schema-object transformer should be able to transform into distinct content-types + {:requestBody {:content (into {} + (map (fn [content-type] + (let [schema (->schema-object body {:in :requestBody + :type :schema + :content-type content-type})] + [content-type {:schema schema}]))) + content-types)}}) + + (when request + ;; request allow to different :requestBody per content-type + {:requestBody + {:content (merge + (when (:body request) + (into {} + (map (fn [content-type] + (let [schema (->schema-object (:body request) {:in :requestBody :type :schema :content-type content-type})] - [content-type {:schema schema}]))) - content-types)}}) - - (when request - ;; request allow to different :requestBody per content-type - {:requestBody - {:content (merge - (when (:body request) - (into {} - (map (fn [content-type] - (let [schema (->schema-object (:body request) {:in :requestBody - :type :schema - :content-type content-type})] - [content-type {:schema schema}]))) - content-types)) - (into {} - (map (fn [[content-type requestBody]] - (let [schema (->schema-object requestBody {:in :requestBody - :type :schema - :content-type content-type})] - [content-type {:schema schema}]))) - (:content request)))}}) - (when multipart - {:requestBody - {:content - {"multipart/form-data" - {:schema - (->schema-object multipart {:in :requestBody - :type :schema - :content-type "multipart/form-data"})}}}}) - (when responses - {:responses - (into {} - (map (fn [[status {:keys [body content] - :as response}]] - (let [content (merge - (when body - (into {} - (map (fn [content-type] - (let [schema (->schema-object body {:in :responses + [content-type {:schema schema}]))) + content-types)) + (into {} + (map (fn [[content-type requestBody]] + (let [schema (->schema-object requestBody {:in :requestBody + :type :schema + :content-type content-type})] + [content-type {:schema schema}]))) + (:content request)))}}) + (when multipart + {:requestBody + {:content + {"multipart/form-data" + {:schema + (->schema-object multipart {:in :requestBody + :type :schema + :content-type "multipart/form-data"})}}}}) + (when responses + {:responses + (into {} + (map (fn [[status {:keys [body content] + :as response}]] + (let [content (merge + (when body + (into {} + (map (fn [content-type] + (let [schema (->schema-object body {:in :responses + :type :schema + :content-type content-type})] + [content-type {:schema schema}]))) + content-types)) + (when content + (into {} + (map (fn [[content-type schema]] + (let [schema (->schema-object schema {:in :responses :type :schema :content-type content-type})] - [content-type {:schema schema}]))) - content-types)) + [content-type {:schema schema}]))) + content)))] + [status (merge (select-keys response [:description]) (when content - (into {} - (map (fn [[content-type schema]] - (let [schema (->schema-object schema {:in :responses - :type :schema - :content-type content-type})] - [content-type {:schema schema}]))) - content)))] - [status (merge (select-keys response [:description]) - (when content - {:content content}))]))) - responses)})))) + {:content content}))]))) + responses)})))) (defn create ([] @@ -226,7 +225,8 @@ (let [{:keys [transformers lite compile options error-keys encode-error] :as opts} (merge default-options opts) show? (fn [key] (contains? error-keys key)) transformers (walk/prewalk #(if (satisfies? TransformationProvider %) (-transformer % opts) %) transformers) - compile (if lite (fn [schema options] (compile (binding [l/*options* options] (l/schema schema)) options)) + compile (if lite (fn [schema options] + (compile (binding [l/*options* options] (l/schema schema)) options)) compile)] ^{:type ::coercion/coercion} (reify coercion/Coercion @@ -238,7 +238,7 @@ (if parameters {:parameters (->> (for [[in schema] parameters - parameter (extract-parameter in (compile schema options) options)] + parameter (extract-parameter in schema options)] parameter) (into []))}) (if responses @@ -250,16 +250,17 @@ (set/rename-keys $ {:body :schema}) (update $ :description (fnil identity "")) (if (:schema $) - (-> $ - (update :schema compile options) - (update :schema swagger/transform {:type :schema})) + (update $ :schema swagger/transform {:type :schema}) $))]))})) :openapi (-get-apidocs-openapi this data options) (throw (ex-info (str "Can't produce Schema apidocs for " specification) {:type specification, :coercion :schema})))) - (-compile-model [_ model _] (compile model options)) + (-compile-model [_ model _] + (if (= 1 (count model)) + (compile (first model) options) + (reduce (fn [x y] (mu/merge x y options)) (map #(compile % options) model)))) (-open-model [_ schema] schema) (-encode-error [_ error] (cond-> error @@ -270,8 +271,8 @@ (seq error-keys) (select-keys error-keys) encode-error (encode-error))) (-request-coercer [_ type schema] - (-coercer (compile schema options) type transformers :decode opts)) + (-coercer schema type transformers :decode opts)) (-response-coercer [_ schema] - (-coercer (compile schema options) :response transformers :encode opts)))))) + (-coercer schema :response transformers :encode opts)))))) (def coercion (create default-options)) diff --git a/modules/reitit-ring/src/reitit/ring.cljc b/modules/reitit-ring/src/reitit/ring.cljc index 5c292734..7a4cde7f 100644 --- a/modules/reitit-ring/src/reitit/ring.cljc +++ b/modules/reitit-ring/src/reitit/ring.cljc @@ -3,6 +3,7 @@ #?@(:clj [[ring.util.mime-type :as mime-type] [ring.util.response :as response]]) [reitit.core :as r] + [reitit.coercion :as coercion] [reitit.exception :as ex] [reitit.impl :as impl] [reitit.middleware :as middleware])) @@ -28,16 +29,37 @@ (update acc method expand opts) acc)) data http-methods)]) +(defn -update-paths [f] + (let [not-request? #(not= :request %) + http-method? #(contains? http-methods %)] + [;; default parameters and responses + [[:parameters not-request?] f] + [[http-method? :parameters not-request?] f] + [[:responses any? :body] f] + [[http-method? :responses any? :body] f] + + ;; openapi3 parameters and responses + [[:parameters :request :content any?] f] + [[http-method? :parameters :request :content any?] f] + [[:parameters :request :body] f] + [[http-method? :parameters :request :body] f] + [[:responses any? :content any?] f] + [[http-method? :responses any? :content any?] f]])) + +(defn -compile-coercion [{:keys [coercion] :as data}] + (cond-> data coercion (impl/path-update (-update-paths #(coercion/-compile-model coercion % nil))))) + (defn compile-result [[path data] {:keys [::default-options-endpoint expand] :as opts}] (let [[top childs] (group-keys data) childs (cond-> childs (and (not (:options childs)) (not (:handler top)) default-options-endpoint) (assoc :options (expand default-options-endpoint opts))) ->endpoint (fn [p d m s] - (-> (middleware/compile-result [p d] opts s) - (map->Endpoint) - (assoc :path p) - (assoc :method m))) + (let [d (-compile-coercion d)] + (-> (middleware/compile-result [p d] opts s) + (map->Endpoint) + (assoc :path p) + (assoc :method m)))) ->methods (fn [any? data] (reduce (fn [acc method] @@ -97,6 +119,7 @@ ([data opts] (let [opts (merge {:coerce coerce-handler :compile compile-result + :update-paths (-update-paths impl/accumulate) ::default-options-endpoint default-options-endpoint} opts)] (when (contains? opts ::default-options-handler) diff --git a/modules/reitit-schema/src/reitit/coercion/schema.cljc b/modules/reitit-schema/src/reitit/coercion/schema.cljc index ce66e153..3dc50bb1 100644 --- a/modules/reitit-schema/src/reitit/coercion/schema.cljc +++ b/modules/reitit-schema/src/reitit/coercion/schema.cljc @@ -54,28 +54,16 @@ :swagger (swagger/swagger-spec (merge (if parameters - {::swagger/parameters - (into - (empty parameters) - (for [[k v] parameters] - [k (coercion/-compile-model this v nil)]))}) + {::swagger/parameters parameters}) (if responses {::swagger/responses (into (empty responses) (for [[k response] responses] - [k (as-> response $ - (set/rename-keys $ {:body :schema}) - (if (:schema $) - (update $ :schema #(coercion/-compile-model this % nil)) - $))]))}))) + [k (set/rename-keys response {:body :schema})]))}))) :openapi (merge (when (seq (dissoc parameters :body :request :multipart)) - (openapi/openapi-spec {::openapi/parameters - (into - (empty parameters) - (for [[k v] (dissoc parameters :body :request)] - [k (coercion/-compile-model this v nil)]))})) + (openapi/openapi-spec {::openapi/parameters (dissoc parameters :body :request)})) (when (:body parameters) {:requestBody (openapi/openapi-spec {::openapi/content (zipmap content-types (repeat (:body parameters)))})}) @@ -92,23 +80,26 @@ (when responses {:responses (into - (empty responses) - (for [[k {:keys [body content] :as response}] responses] - [k (merge - (select-keys response [:description]) - (when (or body content) - (openapi/openapi-spec - {::openapi/content (merge - (when body - (zipmap content-types (repeat (coercion/-compile-model this body nil)))) - (when response - (:content response)))})))]))})) + (empty responses) + (for [[k {:keys [body content] :as response}] responses] + [k (merge + (select-keys response [:description]) + (when (or body content) + (openapi/openapi-spec + {::openapi/content (merge + (when body + (zipmap content-types (repeat body))) + (when response + (:content response)))})))]))})) (throw (ex-info (str "Can't produce Schema apidocs for " specification) {:type specification, :coercion :schema})))) - (-compile-model [_ model _] model) + (-compile-model [_ model _] + (if (= 1 (count model)) + (first model) + (apply st/merge model))) (-open-model [_ schema] (st/open-schema schema)) (-encode-error [_ error] (-> error diff --git a/modules/reitit-spec/src/reitit/coercion/spec.cljc b/modules/reitit-spec/src/reitit/coercion/spec.cljc index d5edd78b..77a630a9 100644 --- a/modules/reitit-spec/src/reitit/coercion/spec.cljc +++ b/modules/reitit-spec/src/reitit/coercion/spec.cljc @@ -1,7 +1,9 @@ (ns reitit.coercion.spec (:require [clojure.set :as set] [clojure.spec.alpha :as s] + [meta-merge.core :as mm] [reitit.coercion :as coercion] + [reitit.exception :as ex] [spec-tools.core :as st #?@(:cljs [:refer [Spec]])] [spec-tools.data-spec :as ds #?@(:cljs [:refer [Maybe]])] [spec-tools.openapi.core :as openapi] @@ -66,7 +68,7 @@ (st/create-spec {:spec this})) nil - (into-spec [this _])) + (into-spec [_ _])) (defn stringify-pred [pred] (str (if (seq? pred) (seq pred) pred))) @@ -92,44 +94,30 @@ :swagger (swagger/swagger-spec (merge (if parameters - {::swagger/parameters - (into - (empty parameters) - (for [[k v] parameters] - [k (coercion/-compile-model this v nil)]))}) + {::swagger/parameters parameters}) (if responses {::swagger/responses (into (empty responses) (for [[k response] responses] [k (as-> response $ - (set/rename-keys $ {:body :schema}) - (if (:schema $) - (update $ :schema #(coercion/-compile-model this % nil)) - $))]))}))) + (set/rename-keys $ {:body :schema}))]))}))) :openapi (merge (when (seq (dissoc parameters :body :request :multipart)) - (openapi/openapi-spec {::openapi/parameters - (into (empty parameters) - (for [[k v] (dissoc parameters :body :request)] - [k (coercion/-compile-model this v nil)]))})) + (openapi/openapi-spec {::openapi/parameters (dissoc parameters :body :request)})) (when (:body parameters) {:requestBody (openapi/openapi-spec - {::openapi/content (zipmap content-types (repeat (coercion/-compile-model this (:body parameters) nil)))})}) + {::openapi/content (zipmap content-types (repeat (:body parameters)))})}) (when (:request parameters) {:requestBody (openapi/openapi-spec {::openapi/content (merge (when-let [default (get-in parameters [:request :body])] - (zipmap content-types (repeat (coercion/-compile-model this default nil)))) - (into {} - (for [[format model] (:content (:request parameters))] - [format (coercion/-compile-model this model nil)])))})}) + (zipmap content-types (repeat default))) + (:content (:request parameters)))})}) (when (:multipart parameters) - {:requestBody - (openapi/openapi-spec - {::openapi/content - {"multipart/form-data" - (coercion/-compile-model this (:multipart parameters) nil)}})}) + {:requestBody + (openapi/openapi-spec + {::openapi/content {"multipart/form-data" (:multipart parameters)}})}) (when responses {:responses (into @@ -141,26 +129,33 @@ (openapi/openapi-spec {::openapi/content (merge (when body - (zipmap content-types (repeat (coercion/-compile-model this (:body response) nil)))) + (zipmap content-types (repeat (:body response)))) (when response - (into {} - (for [[format model] (:content response)] - [format (coercion/-compile-model this model nil)]))))})))]))})) + (:content response)))})))]))})) (throw (ex-info (str "Can't produce Spec apidocs for " specification) {:specification specification, :coercion :spec})))) (-compile-model [_ model name] - (into-spec model name)) + (into-spec + (cond + ;; we are safe! + (= (count model) 1) (first model) + ;; here be dragons, best effort + (every? map? model) (apply mm/meta-merge model) + ;; not sure if this is what we want + (every? s/spec? model) (reduce (fn [acc s] (st/merge acc s)) model) + ;; fail fast + :else (ex/fail! ::model-error {:message "Can't merge nested data-specs & specs together", :spec model})) + name)) (-open-model [_ spec] spec) (-encode-error [_ error] (let [problems (-> error :problems ::s/problems)] (-> error (update :spec (comp str s/form)) (assoc :problems (mapv #(update % :pred stringify-pred) problems))))) - (-request-coercer [this type spec] - (let [spec (coercion/-compile-model this spec nil) - {:keys [formats default]} (transformers type)] + (-request-coercer [_ type spec] + (let [{:keys [formats default]} (transformers type)] (fn [value format] (if-let [transformer (or (get formats format) default)] (let [coerced (st/coerce spec value transformer)] diff --git a/test/cljc/reitit/coercion_test.cljc b/test/cljc/reitit/coercion_test.cljc index 97ab0aae..7d689507 100644 --- a/test/cljc/reitit/coercion_test.cljc +++ b/test/cljc/reitit/coercion_test.cljc @@ -14,27 +14,28 @@ (deftest coercion-test (let [r (r/router [["/schema" {:coercion reitit.coercion.schema/coercion} - ["/:number/:keyword" {:parameters {:path {:number s/Int - :keyword s/Keyword} - :query (s/maybe {:int s/Int, :ints [s/Int], :map {s/Int s/Int}})}}]] + ["/:number" {:parameters {:path {:number s/Int}}} + ["/:keyword" {:parameters {:path {:keyword s/Keyword} + :query (s/maybe {:int s/Int, :ints [s/Int], :map {s/Int s/Int}})}}]]] ["/malli" {:coercion reitit.coercion.malli/coercion} - ["/:number/:keyword" {:parameters {:path [:map [:number int?] [:keyword keyword?]] - :query [:maybe [:map [:int int?] - [:ints [:vector int?]] - [:map [:map-of int? int?]]]]}}]] + ["/:number" {:parameters {:path [:map [:number int?]]}} + ["/:keyword" {:parameters {:path [:map [:keyword keyword?]] + :query [:maybe [:map [:int int?] + [:ints [:vector int?]] + [:map [:map-of int? int?]]]]}}]]] ["/malli-lite" {:coercion reitit.coercion.malli/coercion} - ["/:number/:keyword" {:parameters {:path {:number int? - :keyword keyword?} - :query (l/maybe {:int int? - :ints (l/vector int?) - :map (l/map-of int? int?)})}}]] + ["/:number" {:parameters {:path {:number int?}}} + ["/:keyword" {:parameters {:path {:keyword keyword?} + :query (l/maybe {:int int? + :ints (l/vector int?) + :map (l/map-of int? int?)})}}]]] ["/spec" {:coercion reitit.coercion.spec/coercion} - ["/:number/:keyword" {:parameters {:path {:number int? - :keyword keyword?} - :query (ds/maybe {:int int?, :ints [int?], :map {int? int?}})}}]] + ["/:number" {:parameters {:path {:number int?}}} + ["/:keyword" {:parameters {:path {:keyword keyword?} + :query (ds/maybe {:int int?, :ints [int?], :map {int? int?}})}}]]] ["/none" - ["/:number/:keyword" {:parameters {:path {:number int? - :keyword keyword?}}}]]] + ["/:number" {:parameters {:path {:number int?}}} + ["/:keyword" {:parameters {:path {:keyword keyword?}}}]]]] {:compile coercion/compile-request-coercers})] (testing "schema-coercion" diff --git a/test/cljc/reitit/impl_test.cljc b/test/cljc/reitit/impl_test.cljc index dee92921..c4ae1a39 100644 --- a/test/cljc/reitit/impl_test.cljc +++ b/test/cljc/reitit/impl_test.cljc @@ -186,3 +186,24 @@ [[any? :parameters any?] vector] [[:responses any? :body] vector] [[any? :responses any? :body] vector]])))) + +(deftest meta-merge-test + (is (= {:get {:responses {200 {:body [[:map [:total :int]] + [:map [:total :int]]]}}, + :parameters {:query [[:map [:x :int]] + [:map [:y :int]]]}}, + :parameters {:query [[:map [:x :int]] + [:map [:y :int]]]}, + :post {:parameters {:query [[:map [:y :int]]]}}} + (impl/meta-merge + {:parameters {:query [:map [:x :int]]} + :get {:parameters {:query [:map [:x :int]]} + :responses {200 {:body [:map [:total :int]]}}}} + {:parameters {:query [:map [:y :int]]} + :get {:parameters {:query [:map [:y :int]]} + :responses {200 {:body [:map [:total :int]]}}} + :post {:parameters {:query [:map [:y :int]]}}} + {:update-paths [[[:parameters any?] vector] + [[any? :parameters any?] vector] + [[:responses any? :body] vector] + [[any? :responses any? :body] vector]]})))) diff --git a/test/cljc/reitit/ring_coercion_test.cljc b/test/cljc/reitit/ring_coercion_test.cljc index 66d151ed..10aa8409 100644 --- a/test/cljc/reitit/ring_coercion_test.cljc +++ b/test/cljc/reitit/ring_coercion_test.cljc @@ -234,14 +234,12 @@ ([] {}) ([left] left) ([left right] - (if (and (map? left) (map? right) - (contains? left :parameters) - (contains? right :parameters)) - (-> (merge-with custom-meta-merge-checking-parameters left right) - (assoc :parameters (merge-with mu/merge - (:parameters left) - (:parameters right)))) - (meta-merge left right))) + (let [pleft (-> left :parameters :path) + pright (-> right :parameters :path)] + (if (and (map? left) (map? right) pleft pright) + (-> (merge-with custom-meta-merge-checking-parameters left right) + (assoc-in [:parameters :path] (reduce mu/merge (concat pleft pright)))) + (meta-merge left right)))) ([left right & more] (reduce custom-meta-merge-checking-parameters left (cons right more)))) @@ -586,43 +584,43 @@ (deftest per-content-type-test (doseq [[coercion json-request edn-request default-request json-response edn-response default-response] - [[#'malli/coercion + [[malli/coercion [:map [:request [:enum :json]] [:response any?]] [:map [:request [:enum :edn]] [:response any?]] [:map [:request [:enum :default]] [:response any?]] [:map [:request any?] [:response [:enum :json]]] [:map [:request any?] [:response [:enum :edn]]] [:map [:request any?] [:response [:enum :default]]]] - [#'schema/coercion + [schema/coercion {:request (s/eq :json) :response s/Any} {:request (s/eq :edn) :response s/Any} {:request (s/eq :default) :response s/Any} {:request s/Any :response (s/eq :json)} {:request s/Any :response (s/eq :edn)} {:request s/Any :response (s/eq :default)}] - [#'spec/coercion + [spec/coercion {:request (clojure.spec.alpha/spec #{:json}) :response any?} {:request (clojure.spec.alpha/spec #{:edn}) :response any?} {:request (clojure.spec.alpha/spec #{:default}) :response any?} {:request any? :response (clojure.spec.alpha/spec #{:json})} {:request any? :response (clojure.spec.alpha/spec #{:end})} {:request any? :response (clojure.spec.alpha/spec #{:default})}]]] - (testing coercion + (testing (str coercion) (let [app (ring/ring-handler (ring/router - [["/foo" {:post {:parameters {:request {:content {"application/json" json-request - "application/edn" edn-request} - :body default-request}} - :responses {200 {:content {"application/json" json-response - "application/edn" edn-response} - :body default-response}} - :handler (fn [req] - {:status 200 - :body (-> req :parameters :request)})}}]] - {:validate reitit.ring.spec/validate + ["/foo" {:post {:parameters {:request {:content {"application/json" json-request + "application/edn" edn-request} + :body default-request}} + :responses {200 {:content {"application/json" json-response + "application/edn" edn-response} + :body default-response}} + :handler (fn [req] + {:status 200 + :body (-> req :parameters :request)})}}] + {#_#_:validate reitit.ring.spec/validate :data {:middleware [rrc/coerce-request-middleware rrc/coerce-response-middleware] - :coercion @coercion}})) + :coercion coercion}})) call (fn [request] (try (app request) From 9ac713f0e5b70a5c1b78baccb5cdea4c4ae4d421 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 22 May 2023 09:16:57 +0300 Subject: [PATCH 6/8] doesn't work properly with spec --- CHANGELOG.md | 2 +- .../reitit-spec/src/reitit/coercion/spec.cljc | 4 +- test/cljc/reitit/coercion_test.cljc | 61 ++++++++++++++++--- 3 files changed, 54 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cacbce06..819f6776 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,7 +15,7 @@ We use [Break Versioning][breakver]. The version numbers follow a `. Date: Mon, 22 May 2023 20:23:47 +0300 Subject: [PATCH 7/8] review comments --- modules/reitit-core/src/reitit/impl.cljc | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/modules/reitit-core/src/reitit/impl.cljc b/modules/reitit-core/src/reitit/impl.cljc index 9eb87894..9afd570a 100644 --- a/modules/reitit-core/src/reitit/impl.cljc +++ b/modules/reitit-core/src/reitit/impl.cljc @@ -17,10 +17,8 @@ (letfn [(match [x f] (if (fn? f) (f x) (= x f)))] (reduce (fn [_ [ps f]] - (let [match (loop [[p & pr] path, [pp & ppr] ps] - (cond (and p pp (match p pp)) (recur pr ppr) - (= nil p pp) true))] - (when match (reduced f)))) + (when (and (>= (count path) (count ps)) (every? identity (map match path ps))) + (reduced f))) nil path-map))) (defn -path-vals [m path-map] @@ -30,11 +28,11 @@ (let [p' (conj p k) f (-match p' path-map)] (cond - f (cons [p' (f v)] l) + f (conj l [p' (f v)]) (and (map? v) (seq v)) (-path-vals l p' v) - :else (cons [p' v] l)))) + :else (conj l [p' v])))) l m))] - (reverse (-path-vals [] [] m)))) + (-path-vals [] [] m))) (defn -assoc-in-path-vals [c] (reduce (partial apply assoc-in) {} c)) From 9f58bb22e3bb151b6e548399cb8a17f58ceb49ed Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 22 May 2023 20:28:20 +0300 Subject: [PATCH 8/8] kill ctrl --- test/cljc/ctrl/apply.cljc | 35 ----------- test/cljc/ctrl/demo.cljc | 53 ----------------- test/cljc/ctrl/merge.cljc | 120 -------------------------------------- 3 files changed, 208 deletions(-) delete mode 100644 test/cljc/ctrl/apply.cljc delete mode 100644 test/cljc/ctrl/demo.cljc delete mode 100644 test/cljc/ctrl/merge.cljc diff --git a/test/cljc/ctrl/apply.cljc b/test/cljc/ctrl/apply.cljc deleted file mode 100644 index dea444a1..00000000 --- a/test/cljc/ctrl/apply.cljc +++ /dev/null @@ -1,35 +0,0 @@ -(ns ctrl.apply - (:refer-clojure :exclude [apply]) - (:require [clojure.core :as c])) - -(defn -match [path path-map] - (letfn [(match [x f] (if (fn? f) (f x) (= x f)))] - (reduce - (fn [_ [ps f]] - (let [match (loop [[p & pr] path, [pp & ppr] ps] - (cond (and p pp (match p pp)) (recur pr ppr) - (= nil p pp) true))] - (when match (reduced f)))) - nil path-map))) - -(defn -path-vals [m path-map] - (letfn [(-path-vals [l p m] - (reduce - (fn [l [k v]] - (let [p' (conj p k) - f (-match p' path-map)] - (cond - f (cons [p' (f v)] l) - (map? v) (-path-vals l p' v) - :else (cons [p' v] l)))) - l m))] - (-path-vals [] [] m))) - -(defn -assoc-in-path-vals [c] - (reduce (partial c/apply assoc-in) {} c)) - -(defn any [_] true) - -(defn apply [m path-map] - (-> (-path-vals m path-map) - (-assoc-in-path-vals))) diff --git a/test/cljc/ctrl/demo.cljc b/test/cljc/ctrl/demo.cljc deleted file mode 100644 index ab2c3c5b..00000000 --- a/test/cljc/ctrl/demo.cljc +++ /dev/null @@ -1,53 +0,0 @@ -(ns ctrl.demo - (:require [reitit.core :as r] - [reitit.ring :as ring] - [ctrl.merge :as cm] - [ctrl.apply :as ca])) - -(-> (ring/router - ["/api" {:parameters {:header [:map ["Api" :string]]}} - ["/math/:x" {:parameters {:path [:map [:x :int]] - :query [:map [:b :string]] - :header [:map ["Math" :string]]} - :responses {200 {:body [:map [:total :int]]} - 500 {:description "fail"}}} - ["/plus/:y" {:get {:parameters {:query ^:replace [:map [:a :int]] - :body [:map [:b :int]] - :header [:map ["Plus" :string]] - :path [:map [:y :int]]} - :responses {200 {:body [:map [:total2 :int]]} - 500 {:description "fail"}} - :handler (constantly {:status 200, :body "ok"})}}]]]) - (ring/ring-handler) - (ring/get-router) - (r/compiled-routes) - (last) - (last) - :get - :data) - -(def path-map [[[:parameters any?] vector] - [[any? :parameters any?] vector] - [[:responses any? :body] vector] - [[any? :responses any? :body] vector]]) - -;; using apply as pre-merge -(cm/merge - (ca/apply - {:parameters {:query [:map [:x :int]]} - :get {:parameters {:query [:map [:x :int]]} - :responses {200 {:body [:map [:total :int]]}}}} - path-map) - (ca/apply - {:parameters {:query [:map [:y :int]]} - :get {:parameters {:query [:map [:y :int]]} - :responses {200 {:body [:map [:total :int]]}}} - :post {:parameters {:query [:map [:y :int]]}}} - path-map)) -;{:get {:responses {200 {:body [[:map [:total :int]] -; [:map [:total :int]]]}}, -; :parameters {:query [[:map [:x :int]] -; [:map [:y :int]]]}}, -; :parameters {:query [[:map [:x :int]] -; [:map [:y :int]]]}, -; :post {:parameters {:query [[:map [:y :int]]]}}} diff --git a/test/cljc/ctrl/merge.cljc b/test/cljc/ctrl/merge.cljc deleted file mode 100644 index 5b16385b..00000000 --- a/test/cljc/ctrl/merge.cljc +++ /dev/null @@ -1,120 +0,0 @@ -(ns ctrl.merge - (:refer-clojure :exclude [merge]) - (:require [clojure.core :as c] - [clojure.set :as set])) - -(defn- meta* [obj] - (if #?(:clj (instance? clojure.lang.IObj obj) - :cljs (satisfies? IMeta obj)) - (meta obj))) - -(defn- with-meta* [obj m] - (if #?(:clj (instance? clojure.lang.IObj obj) - :cljs (satisfies? IWithMeta obj)) - (with-meta obj m) - obj)) - -(defn- displace? [obj] - (-> obj meta* :displace)) - -(defn- replace? [obj] - (-> obj meta* :replace)) - -(defn- top-displace? [obj] - (-> obj meta* :top-displace)) - -(defn- different-priority? [left right] - (boolean (or (some (some-fn nil? displace? replace?) [left right]) - (top-displace? left)))) - -(defn- remove-top-displace [obj {:keys [::replace-nil]}] - (cond replace-nil nil - (top-displace? obj) obj - :else (vary-meta obj dissoc :top-displace))) - -(defn- pick-prioritized [left right options] - (cond (nil? left) right - (nil? right) (remove-top-displace left options) - - (top-displace? left) right - - (and (displace? left) ;; Pick the rightmost - (displace? right)) ;; if both are marked as displaceable - (with-meta* right - (c/merge (meta* left) (meta* right))) - - (and (replace? left) ;; Pick the rightmost - (replace? right)) ;; if both are marked as replaceable - (with-meta* right - (c/merge (meta* left) (meta* right))) - - (or (displace? left) - (replace? right)) - (with-meta* right - (c/merge (-> left meta* (dissoc :displace)) - (-> right meta* (dissoc :replace)))) - - (or (replace? left) - (displace? right)) - (with-meta* left - (c/merge (-> right meta* (dissoc :displace)) - (-> left meta* (dissoc :replace)))))) - -(defn find-custom-merge [path path-map] - (letfn [(match [x f] (cond (keyword? f) (= x f) (or (fn? f) (ifn? f)) (f x)))] - (reduce (fn [_ [ps f]] (let [match (loop [[p & pr] path, [pp & ppr] ps] - (cond (and p pp (match p pp)) (recur pr ppr) - (= nil p pp) true))] - (when match (reduced f)))) nil path-map))) - -(defrecord Acc [data]) -(defn accumulate? [x] (instance? Acc x)) -(defn unaccumulate [x] (if (accumulate? x) (:data x) x)) -(defn accumulate - ([x] (if (accumulate? x) x (->Acc [x]))) - ([x y] (update (accumulate x) :data into (unaccumulate y)))) - -;; -;; public api -;; - -(defn merge - ([] {}) - ([left] left) - ([left right] (merge left right nil)) - ([left right {:keys [::path ::path-map] :as options}] - (let [custom-merge (find-custom-merge path path-map)] - (cond - (different-priority? left right) - (pick-prioritized left right options) - - (accumulate? left) - (accumulate left right) - - custom-merge - (custom-merge left right options) - - (and (map? left) (map? right)) - (let [merge-entry (fn [m e] - (let [k (key e) v (val e)] - (if (contains? m k) - (assoc m k (merge (get m k) v (-> options - (update ::path (fnil conj []) k) - (update ::acc assoc (or path []) m)))) - (assoc m k v)))) - merge2 (fn [m1 m2] - (reduce merge-entry (or m1 {}) (seq m2)))] - (reduce merge2 [left right])) - - (and (set? left) (set? right)) - (set/union right left) - - (and (coll? left) (coll? right)) - (if (or (-> left meta :prepend) - (-> right meta :prepend)) - (-> (into (empty left) (concat right left)) - (with-meta (c/merge (meta left) - (select-keys (meta right) [:displace])))) - (into (empty left) (concat left right))) - - :else right))))