From 550ea6da58918424b8bb958182ccd068fc5f9604 Mon Sep 17 00:00:00 2001
From: Tommi Reiman <tommi@iki.fi>
Date: Sun, 21 May 2023 20:13:43 +0300
Subject: [PATCH] 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]]))))