luciano/reitit
1
0
Fork 0
mirror of https://github.com/metosin/reitit.git synced 2025-12-17 08:21:11 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

kill ctrl

Browse source
This commit is contained in:
Tommi Reiman 2023-05-22 20:28:20 +03:00
parent 3e6c3f589f
commit 9f58bb22e3
3 changed files with 0 additions and 208 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
test/cljc/ctrl/apply.cljc
View file

@ -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)))

53
test/cljc/ctrl/demo.cljc
View file

@ -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]]]}}}

120
test/cljc/ctrl/merge.cljc
View file

@ -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))))