From 9f58bb22e3bb151b6e548399cb8a17f58ceb49ed Mon Sep 17 00:00:00 2001 From: Tommi Reiman Date: Mon, 22 May 2023 20:28:20 +0300 Subject: [PATCH] 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))))