From 4d0e40f1353205ad29887356524d5cff2beb1fc3 Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Sun, 21 May 2023 18:15:44 +0300 Subject: [PATCH] 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]]}}}