From 817fd6e04cde7eaf2a94f71f914f8aefc036aa57 Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Thu, 23 Apr 2026 14:41:58 +0800 Subject: [PATCH 1/7] perf(remote): Skip ILookup in read error detection walk --- .../src/sg/flybot/pullable/remote/http.cljc | 293 ++++++++++++++++-- 1 file changed, 266 insertions(+), 27 deletions(-) diff --git a/remote/src/sg/flybot/pullable/remote/http.cljc b/remote/src/sg/flybot/pullable/remote/http.cljc index 344cb43..4c2cd05 100644 --- a/remote/src/sg/flybot/pullable/remote/http.cljc +++ b/remote/src/sg/flybot/pullable/remote/http.cljc @@ -600,40 +600,255 @@ error-map))) (defn- detect-path-error - "Walk path checking for errors at each step via detect-fn. - Only checks standard maps (via `map?` guard) — pure ILookup implementations - pass through unchecked because `map?` returns false for reified ILookup, - and calling detect-fn on them could trigger side effects or lazy evaluation. - Returns [value nil] on success, [nil err-map] with :path on error." - [data path detect-fn] + "Walk a path through data, checking `detect-fn` on plain-map nodes. + Returns [value nil] on success, [nil err-map-with-:path] on error. + + By default stops at the first non-map node (ILookup/Collection/reify) and + returns it without invoking `get` — detection must be a pure predicate, it + must not drive side-effecting lookups. + + With `:deep? true` walks THROUGH non-map nodes via `get` (invoking + ILookup/Collection valAt). Used as a fallback only, to surface errors + inside a collection after match failure or nil-var binding." + [data path detect-fn & {:keys [deep?]}] (loop [m data, [k & ks] path, traversed []] - (if-not k - [m nil] + (cond + (nil? k) [m nil] + (and (not deep?) (not (map? m))) [m nil] + :else (if-let [err (when (and detect-fn (map? m)) (detect-fn m))] [nil (assoc err :path traversed)] (recur (get m k) ks (conj traversed k)))))) +^:rct/test +(comment + (def err-detect #(get % :error)) + + ;; --- shallow (default) --- + (detect-path-error {:a {:b 42}} [:a :b] err-detect) + ;=> [42 nil] + + (detect-path-error {:a {:error {:type :forbidden}} :b 1} [:a :b] err-detect) + ;=> [nil {:type :forbidden :path [:a]}] + + ;; Stops at non-map, never invokes it + (let [stub (reify clojure.lang.ILookup + (valAt [_ _] (throw (ex-info "should not be called" {}))))] + (detect-path-error {:x stub} [:x :y] err-detect)) + ;=>> [some? nil] + + ;; --- :deep? true — walks through ILookup --- + (let [stub (reify clojure.lang.ILookup + (valAt [_ k] (case k :resource {:error {:type :forbidden}} nil)) + (valAt [this k _] (.valAt this k)))] + (detect-path-error {:role stub} [:role :resource :name] err-detect :deep? true)) + ;=> [nil {:type :forbidden :path [:role :resource]}] + + ;; Empty path / nil detect-fn + (detect-path-error {:x 1} [] err-detect) ;=> [{:x 1} nil] + (detect-path-error {:a {:b 42}} [:a :b] nil) ;=> [42 nil] + ) + (defn- detect-read-errors - "Detect errors along var paths, including through ILookup. - Checks both intermediate nodes (via detect-path-error) and leaf values. + "For each var-path, record any error found by `detect-path-error`. + With `:deep? true` also checks the leaf value reached through ILookup — + catches cases like an ILookup that returns `{:error ...}` directly. Returns {path error-data} map, or nil if no errors." - [data var-paths detect-fn] + [data var-paths detect-fn & {:keys [deep?]}] (when detect-fn (let [errors (reduce (fn [acc path] - (let [[val err] (detect-path-error data path detect-fn)] - (if err + (let [[val err] (detect-path-error data path detect-fn :deep? deep?)] + (cond + err (let [ep (:path err)] (cond-> acc (not (contains? acc ep)) (assoc ep (dissoc err :path)))) - (if-let [leaf-err (when (map? val) (detect-fn val))] + + (and deep? (map? val)) + (if-let [leaf-err (detect-fn val)] (cond-> acc (not (contains? acc path)) (assoc path leaf-err)) - acc)))) + acc) + + :else acc))) {} var-paths)] (when (seq errors) errors)))) +^:rct/test +(comment + (def err-detect #(get % :error)) + + ;; --- shallow (default) — hibou happy path: stub guards valAt --- + (let [stub (reify clojure.lang.ILookup + (valAt [_ _] (throw (ex-info "should not be called" {}))) + (valAt [_ _ _] (throw (ex-info "should not be called" {}))))] + (detect-read-errors {:analytics2 {:raw stub}} + [[:analytics2 :raw {:q 1}]] + err-detect)) + ;=> nil + + ;; Plain-map intermediate error + (detect-read-errors {:dashboards {:user {:error {:type :forbidden}}}} + [[:dashboards :user :dashboard]] + err-detect) + ;=> {[:dashboards :user] {:type :forbidden}} + + ;; No detect-fn → nil (walk skipped) + (detect-read-errors {:a {:error {}}} [[:a :x]] nil) ;=> nil + + ;; --- :deep? true — walks through ILookup --- + (let [stub (reify clojure.lang.ILookup + (valAt [_ k] (case k :resource {:error {:type :forbidden}} nil)) + (valAt [this k _] (.valAt this k)))] + (detect-read-errors {:role stub} [[:role :resource :name]] err-detect :deep? true)) + ;=> {[:role :resource] {:type :forbidden}} + + ;; :deep? true — leaf error (stub returns error map directly) + (let [stub (reify clojure.lang.ILookup + (valAt [_ k] (case k :name {:error {:type :forbidden}} nil)) + (valAt [this k _] (.valAt this k)))] + (detect-read-errors {:user stub} [[:user :name]] err-detect :deep? true)) + ;=> {[:user :name] {:type :forbidden}} + ) + +(defn- var-binding + "If `x` is a pattern variable (simple `?x` or extended `(?x :when ...)`), + returns the bound symbol that the matcher uses in `:vars` (`?x` → `'x`). + Returns nil otherwise." + [x] + (let [sym (cond + (and (symbol? x) + (str/starts-with? (name x) "?")) + x + + (and (sequential? x) (not (vector? x)) + (symbol? (first x)) + (str/starts-with? (name (first x)) "?")) + (first x))] + (when sym (symbol (subs (name sym) 1))))) + +(defn- extract-var-bindings + "Extract {bound-symbol path-vec} mapping from pattern." + [pattern] + (letfn [(walk [p prefix] + (cond + (map? p) + (reduce-kv (fn [acc k v] (merge acc (walk v (conj prefix k)))) + {} p) + + :else + (if-let [sym (var-binding p)] + {sym prefix} + {})))] + (walk pattern []))) + +^:rct/test +(comment + ;; var-binding — unified predicate+strip + (var-binding '?x) ;=> 'x + (var-binding '?result) ;=> 'result + (var-binding 'x) ;=> nil ; not a var (no ? prefix) + (var-binding :keyword) ;=> nil + (var-binding "?x") ;=> nil ; string, not symbol + (var-binding '(?x :when string?)) ;=> 'x ; extended form + (var-binding '(not-a-var :when x)) ;=> nil + + ;; extract-var-bindings + (extract-var-bindings '{:a ?x}) + ;=> {'x [:a]} + + (extract-var-bindings '{:analytics2 {:raw ?result}}) + ;=> {'result [:analytics2 :raw]} + + (extract-var-bindings '{:ok {:name ?n} :err {:name ?e}}) + ;=>> {'n [:ok :name] 'e [:err :name]} + + (extract-var-bindings '{:a (?x :when string?)}) + ;=> {'x [:a]} + + (extract-var-bindings '{:q {{:id 1} ?user}}) + ;=> {'user [:q {:id 1}]} + + (extract-var-bindings '{:a "literal"}) + ;=> {} + + (extract-var-bindings '{:a {:b :c}}) + ;=> {} + ) + +(defn- detect-var-errors + "After match success, check each bound variable's value for error maps via + detect-fn. Uses var-bindings ({sym path}) to attach the originating path + to each detected error." + [vars var-bindings detect-fn] + (when (and detect-fn (seq vars)) + (let [errors (reduce-kv + (fn [acc sym val] + (if-let [err (when (map? val) (detect-fn val))] + (if-let [path (get var-bindings sym)] + (cond-> acc + (not (contains? acc path)) (assoc path err)) + acc) + acc)) + {} + vars)] + (when (seq errors) errors)))) + +^:rct/test +(comment + (def err-detect #(get % :error)) + + ;; No vars bound → nil + (detect-var-errors {} {} err-detect) + ;=> nil + + ;; Var bound to plain value → no error + (detect-var-errors '{result [:records 1 2 3]} + '{result [:analytics2 :raw]} + err-detect) + ;=> nil + + ;; Var bound to error map → records error at that var's path + (detect-var-errors '{e {:error {:type :forbidden}}} + '{e [:err :name]} + err-detect) + ;=> {[:err :name] {:type :forbidden}} + + ;; Mixed: one var non-error, one var error → only the error path recorded + (detect-var-errors '{n "Alice" + e {:error {:type :forbidden}}} + '{n [:ok :name] + e [:err :name]} + err-detect) + ;=> {[:err :name] {:type :forbidden}} + + ;; Var bound to nil → not a map, skipped + (detect-var-errors '{n nil} + '{n [:role :resource :name]} + err-detect) + ;=> nil + + ;; Var bound to non-map (string, vector) → skipped + (detect-var-errors '{x "hello" y [1 2]} + '{x [:a] y [:b]} + err-detect) + ;=> nil + + ;; No detect-fn → nil + (detect-var-errors '{e {:error {}}} + '{e [:x]} + nil) + ;=> nil + + ;; Sym in vars but not in var-bindings → skipped (defensive) + (detect-var-errors '{orphan {:error {}}} + {} + err-detect) + ;=> nil + ) + (defn- execute-mutation "Execute a mutation against the API collection. Path can be flat [:posts] or nested [:member :posts]. @@ -675,20 +890,25 @@ (defn- execute-read "Execute a read pattern against api-fn data. - Detects errors along var paths (via detect-path-error, works through ILookup), - trims pattern at error paths, compiles, matches, and classifies the result." + Symmetric with execute-mutation: + 1. Shallow pre-walk (plain maps only) to catch role/auth errors early + without invoking ILookup/Collection. + 2. Compile + run matcher (single ILookup invocation per accessed key). + 3. Post-match: check matched var bindings for `{:error ...}` leaves. + 4. Fallback: deep detect walk (invokes ILookup) on paths whose var is + nil or whose matcher failed, to surface errors inside a collection." [api-fn ctx pattern opts] (let [{:keys [data schema errors]} (api-fn ctx) - detect-fn (make-detect-fn (:detect errors)) - var-paths (extract-var-paths pattern) - error-map (detect-read-errors data var-paths detect-fn) - error-paths (when (seq error-map) (set (keys error-map))) - trimmed (if error-paths - (trim-pattern pattern error-paths) - pattern) - detected (error-map->errors error-map)] + detect-fn (make-detect-fn (:detect errors)) + var-paths (extract-var-paths pattern) + var-bindings (extract-var-bindings pattern) + pre-errors (detect-read-errors data var-paths detect-fn) + error-paths (when (seq pre-errors) (set (keys pre-errors))) + trimmed (if error-paths + (trim-pattern pattern error-paths) + pattern)] (-> (if-not trimmed - (failure detected) + (failure (error-map->errors pre-errors)) (let [compiled (pattern/compile-pattern trimmed (cond-> (select-keys opts [:resolve :eval-fn]) @@ -696,7 +916,26 @@ (not (:eval-fn opts)) (assoc :eval-fn safe-eval) schema (assoc :schema schema))) result (compiled (pattern/vmr data))] - (classify-result result detected))) + (if (pattern/failure? result) + (let [deep-errors (detect-read-errors data var-paths detect-fn :deep? true) + combined (merge pre-errors deep-errors)] + (classify-result result (error-map->errors combined))) + (let [leaf-errors (detect-var-errors (:vars result) var-bindings detect-fn) + nil-paths (vec (keep (fn [[sym path]] + (when (nil? (get (:vars result) sym)) + path)) + var-bindings)) + val-errors (when (seq nil-paths) + (detect-read-errors (:val result) nil-paths detect-fn)) + combined (merge pre-errors leaf-errors val-errors) + err-paths (keys combined) + all-covered? (and (seq combined) + (every? (fn [vp] + (some #(path-prefix? % vp) err-paths)) + var-paths))] + (if all-covered? + (failure (error-map->errors combined)) + (classify-result result (error-map->errors combined))))))) (vary-meta assoc ::error-codes (:codes errors))))) (defn execute From 33aa80a9f7bdef97ee5002223e5787a959cd08c4 Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Thu, 23 Apr 2026 15:38:29 +0800 Subject: [PATCH 2/7] perf(remote): Detect read errors from matcher :val to avoid re-ILookup --- .../src/sg/flybot/pullable/remote/http.cljc | 194 +++--------------- 1 file changed, 23 insertions(+), 171 deletions(-) diff --git a/remote/src/sg/flybot/pullable/remote/http.cljc b/remote/src/sg/flybot/pullable/remote/http.cljc index 4c2cd05..bc8021b 100644 --- a/remote/src/sg/flybot/pullable/remote/http.cljc +++ b/remote/src/sg/flybot/pullable/remote/http.cljc @@ -713,142 +713,6 @@ ;=> {[:user :name] {:type :forbidden}} ) -(defn- var-binding - "If `x` is a pattern variable (simple `?x` or extended `(?x :when ...)`), - returns the bound symbol that the matcher uses in `:vars` (`?x` → `'x`). - Returns nil otherwise." - [x] - (let [sym (cond - (and (symbol? x) - (str/starts-with? (name x) "?")) - x - - (and (sequential? x) (not (vector? x)) - (symbol? (first x)) - (str/starts-with? (name (first x)) "?")) - (first x))] - (when sym (symbol (subs (name sym) 1))))) - -(defn- extract-var-bindings - "Extract {bound-symbol path-vec} mapping from pattern." - [pattern] - (letfn [(walk [p prefix] - (cond - (map? p) - (reduce-kv (fn [acc k v] (merge acc (walk v (conj prefix k)))) - {} p) - - :else - (if-let [sym (var-binding p)] - {sym prefix} - {})))] - (walk pattern []))) - -^:rct/test -(comment - ;; var-binding — unified predicate+strip - (var-binding '?x) ;=> 'x - (var-binding '?result) ;=> 'result - (var-binding 'x) ;=> nil ; not a var (no ? prefix) - (var-binding :keyword) ;=> nil - (var-binding "?x") ;=> nil ; string, not symbol - (var-binding '(?x :when string?)) ;=> 'x ; extended form - (var-binding '(not-a-var :when x)) ;=> nil - - ;; extract-var-bindings - (extract-var-bindings '{:a ?x}) - ;=> {'x [:a]} - - (extract-var-bindings '{:analytics2 {:raw ?result}}) - ;=> {'result [:analytics2 :raw]} - - (extract-var-bindings '{:ok {:name ?n} :err {:name ?e}}) - ;=>> {'n [:ok :name] 'e [:err :name]} - - (extract-var-bindings '{:a (?x :when string?)}) - ;=> {'x [:a]} - - (extract-var-bindings '{:q {{:id 1} ?user}}) - ;=> {'user [:q {:id 1}]} - - (extract-var-bindings '{:a "literal"}) - ;=> {} - - (extract-var-bindings '{:a {:b :c}}) - ;=> {} - ) - -(defn- detect-var-errors - "After match success, check each bound variable's value for error maps via - detect-fn. Uses var-bindings ({sym path}) to attach the originating path - to each detected error." - [vars var-bindings detect-fn] - (when (and detect-fn (seq vars)) - (let [errors (reduce-kv - (fn [acc sym val] - (if-let [err (when (map? val) (detect-fn val))] - (if-let [path (get var-bindings sym)] - (cond-> acc - (not (contains? acc path)) (assoc path err)) - acc) - acc)) - {} - vars)] - (when (seq errors) errors)))) - -^:rct/test -(comment - (def err-detect #(get % :error)) - - ;; No vars bound → nil - (detect-var-errors {} {} err-detect) - ;=> nil - - ;; Var bound to plain value → no error - (detect-var-errors '{result [:records 1 2 3]} - '{result [:analytics2 :raw]} - err-detect) - ;=> nil - - ;; Var bound to error map → records error at that var's path - (detect-var-errors '{e {:error {:type :forbidden}}} - '{e [:err :name]} - err-detect) - ;=> {[:err :name] {:type :forbidden}} - - ;; Mixed: one var non-error, one var error → only the error path recorded - (detect-var-errors '{n "Alice" - e {:error {:type :forbidden}}} - '{n [:ok :name] - e [:err :name]} - err-detect) - ;=> {[:err :name] {:type :forbidden}} - - ;; Var bound to nil → not a map, skipped - (detect-var-errors '{n nil} - '{n [:role :resource :name]} - err-detect) - ;=> nil - - ;; Var bound to non-map (string, vector) → skipped - (detect-var-errors '{x "hello" y [1 2]} - '{x [:a] y [:b]} - err-detect) - ;=> nil - - ;; No detect-fn → nil - (detect-var-errors '{e {:error {}}} - '{e [:x]} - nil) - ;=> nil - - ;; Sym in vars but not in var-bindings → skipped (defensive) - (detect-var-errors '{orphan {:error {}}} - {} - err-detect) - ;=> nil - ) - (defn- execute-mutation "Execute a mutation against the API collection. Path can be flat [:posts] or nested [:member :posts]. @@ -890,23 +754,21 @@ (defn- execute-read "Execute a read pattern against api-fn data. - Symmetric with execute-mutation: - 1. Shallow pre-walk (plain maps only) to catch role/auth errors early + 1. Shallow pre-walk (plain maps only) catches role/auth errors early without invoking ILookup/Collection. - 2. Compile + run matcher (single ILookup invocation per accessed key). - 3. Post-match: check matched var bindings for `{:error ...}` leaves. - 4. Fallback: deep detect walk (invokes ILookup) on paths whose var is - nil or whose matcher failed, to surface errors inside a collection." + 2. Compile + run matcher (one ILookup invocation per accessed key). + 3. Post-match: walk the matcher's realized `:val` to surface errors + inside collections — no second ILookup pass. On failure, `:val` + is nil and `classify-result` handles path-coverage itself." [api-fn ctx pattern opts] (let [{:keys [data schema errors]} (api-fn ctx) - detect-fn (make-detect-fn (:detect errors)) - var-paths (extract-var-paths pattern) - var-bindings (extract-var-bindings pattern) - pre-errors (detect-read-errors data var-paths detect-fn) - error-paths (when (seq pre-errors) (set (keys pre-errors))) - trimmed (if error-paths - (trim-pattern pattern error-paths) - pattern)] + detect-fn (make-detect-fn (:detect errors)) + var-paths (extract-var-paths pattern) + pre-errors (detect-read-errors data var-paths detect-fn) + error-paths (when (seq pre-errors) (set (keys pre-errors))) + trimmed (if error-paths + (trim-pattern pattern error-paths) + pattern)] (-> (if-not trimmed (failure (error-map->errors pre-errors)) (let [compiled (pattern/compile-pattern @@ -915,27 +777,17 @@ (not (:resolve opts)) (assoc :resolve safe-resolve) (not (:eval-fn opts)) (assoc :eval-fn safe-eval) schema (assoc :schema schema))) - result (compiled (pattern/vmr data))] - (if (pattern/failure? result) - (let [deep-errors (detect-read-errors data var-paths detect-fn :deep? true) - combined (merge pre-errors deep-errors)] - (classify-result result (error-map->errors combined))) - (let [leaf-errors (detect-var-errors (:vars result) var-bindings detect-fn) - nil-paths (vec (keep (fn [[sym path]] - (when (nil? (get (:vars result) sym)) - path)) - var-bindings)) - val-errors (when (seq nil-paths) - (detect-read-errors (:val result) nil-paths detect-fn)) - combined (merge pre-errors leaf-errors val-errors) - err-paths (keys combined) - all-covered? (and (seq combined) - (every? (fn [vp] - (some #(path-prefix? % vp) err-paths)) - var-paths))] - (if all-covered? - (failure (error-map->errors combined)) - (classify-result result (error-map->errors combined))))))) + result (compiled (pattern/vmr data)) + combined (merge pre-errors + (detect-read-errors (:val result) var-paths detect-fn :deep? true)) + err-paths (keys combined) + all-covered? (and (seq combined) + (every? (fn [vp] + (some #(path-prefix? % vp) err-paths)) + var-paths))] + (if (and (not (pattern/failure? result)) all-covered?) + (failure (error-map->errors combined)) + (classify-result result (error-map->errors combined))))) (vary-meta assoc ::error-codes (:codes errors))))) (defn execute From 451e7246483a738ecca2545e3e490634c96e1dba Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Thu, 23 Apr 2026 15:47:54 +0800 Subject: [PATCH 3/7] perf(remote): Detect read errors from matcher :val in single pass --- .../src/sg/flybot/pullable/remote/http.cljc | 194 ++++-------------- 1 file changed, 44 insertions(+), 150 deletions(-) diff --git a/remote/src/sg/flybot/pullable/remote/http.cljc b/remote/src/sg/flybot/pullable/remote/http.cljc index bc8021b..6a3b698 100644 --- a/remote/src/sg/flybot/pullable/remote/http.cljc +++ b/remote/src/sg/flybot/pullable/remote/http.cljc @@ -495,31 +495,6 @@ (when (contains-variables? v) [path])))) pattern)))) -(defn- trim-pattern - "Remove pattern keys at paths where errors were detected. - Descends into sub-patterns when the current path is a prefix of any error path. - Returns trimmed pattern, or nil if all keys were removed." - ([pattern error-paths] - (trim-pattern pattern error-paths [])) - ([pattern error-paths current-path] - (when (and (map? pattern) - (not (contains? error-paths current-path))) - (let [trimmed (reduce-kv - (fn [acc k v] - (let [child-path (conj current-path k)] - (cond - (contains? error-paths child-path) - acc - (and (map? v) - (some #(path-prefix? child-path %) error-paths)) - (let [v' (trim-pattern v error-paths child-path)] - (if (seq v') (assoc acc k v') acc)) - :else - (assoc acc k v)))) - {} - pattern)] - (when (seq trimmed) trimmed))))) - ^:rct/test (comment ;; extract-var-paths — flat pattern @@ -546,36 +521,6 @@ (extract-var-paths nil) ;=> nil - ;; trim-pattern: removes keys at known error paths - (trim-pattern '{:a {:x ?x} :b {:y ?y}} - #{[:b]}) - ;=> '{:a {:x ?x}} - - ;; trim-pattern: nested error removal - (trim-pattern '{:section {:ok {:name ?n} :denied {:name ?d}}} - #{[:section :denied]}) - ;=> '{:section {:ok {:name ?n}}} - - ;; trim-pattern: all keys error -> nil - (trim-pattern '{:a {:x ?x} :b {:y ?y}} - #{[:a] [:b]}) - ;=> nil - - ;; trim-pattern: no error paths -> pattern unchanged - (trim-pattern '{:a ?x :b ?y} - #{}) - ;=> '{:a ?x :b ?y} - - ;; trim-pattern: sub-pattern entirely empty after trimming -> parent removed - (trim-pattern '{:section {:denied {:name ?d}}} - #{[:section :denied]}) - ;=> nil - - ;; trim-pattern: root-level error path [] -> entire pattern trimmed - (trim-pattern '{:a ?x :b ?y} - #{[]}) - ;=> nil - ;; path-prefix?: empty prefix matches any path (path-prefix? [] [:a]) ;=> true (path-prefix? [] [:a :b]) ;=> true @@ -600,22 +545,15 @@ error-map))) (defn- detect-path-error - "Walk a path through data, checking `detect-fn` on plain-map nodes. - Returns [value nil] on success, [nil err-map-with-:path] on error. - - By default stops at the first non-map node (ILookup/Collection/reify) and - returns it without invoking `get` — detection must be a pure predicate, it - must not drive side-effecting lookups. - - With `:deep? true` walks THROUGH non-map nodes via `get` (invoking - ILookup/Collection valAt). Used as a fallback only, to surface errors - inside a collection after match failure or nil-var binding." - [data path detect-fn & {:keys [deep?]}] + "Walk path checking for errors at each step via detect-fn. + Only checks standard maps (via `map?` guard) — pure ILookup implementations + pass through unchecked because `map?` returns false for reified ILookup, + and calling detect-fn on them could trigger side effects or lazy evaluation. + Returns [value nil] on success, [nil err-map] with :path on error." + [data path detect-fn] (loop [m data, [k & ks] path, traversed []] - (cond - (nil? k) [m nil] - (and (not deep?) (not (map? m))) [m nil] - :else + (if-not k + [m nil] (if-let [err (when (and detect-fn (map? m)) (detect-fn m))] [nil (assoc err :path traversed)] (recur (get m k) ks (conj traversed k)))))) @@ -624,54 +562,39 @@ (comment (def err-detect #(get % :error)) - ;; --- shallow (default) --- (detect-path-error {:a {:b 42}} [:a :b] err-detect) ;=> [42 nil] (detect-path-error {:a {:error {:type :forbidden}} :b 1} [:a :b] err-detect) ;=> [nil {:type :forbidden :path [:a]}] - ;; Stops at non-map, never invokes it - (let [stub (reify clojure.lang.ILookup - (valAt [_ _] (throw (ex-info "should not be called" {}))))] - (detect-path-error {:x stub} [:x :y] err-detect)) - ;=>> [some? nil] - - ;; --- :deep? true — walks through ILookup --- + ;; Walks through ILookup (mutation path finding) (let [stub (reify clojure.lang.ILookup (valAt [_ k] (case k :resource {:error {:type :forbidden}} nil)) (valAt [this k _] (.valAt this k)))] - (detect-path-error {:role stub} [:role :resource :name] err-detect :deep? true)) + (detect-path-error {:role stub} [:role :resource :name] err-detect)) ;=> [nil {:type :forbidden :path [:role :resource]}] - ;; Empty path / nil detect-fn (detect-path-error {:x 1} [] err-detect) ;=> [{:x 1} nil] (detect-path-error {:a {:b 42}} [:a :b] nil) ;=> [42 nil] ) (defn- detect-read-errors - "For each var-path, record any error found by `detect-path-error`. - With `:deep? true` also checks the leaf value reached through ILookup — - catches cases like an ILookup that returns `{:error ...}` directly. + "For each var-path, record any error found along the path or at the leaf. Returns {path error-data} map, or nil if no errors." - [data var-paths detect-fn & {:keys [deep?]}] + [data var-paths detect-fn] (when detect-fn (let [errors (reduce (fn [acc path] - (let [[val err] (detect-path-error data path detect-fn :deep? deep?)] - (cond - err + (let [[val err] (detect-path-error data path detect-fn)] + (if err (let [ep (:path err)] (cond-> acc (not (contains? acc ep)) (assoc ep (dissoc err :path)))) - - (and deep? (map? val)) - (if-let [leaf-err (detect-fn val)] + (if-let [leaf-err (when (map? val) (detect-fn val))] (cond-> acc (not (contains? acc path)) (assoc path leaf-err)) - acc) - - :else acc))) + acc)))) {} var-paths)] (when (seq errors) errors)))) @@ -680,37 +603,18 @@ (comment (def err-detect #(get % :error)) - ;; --- shallow (default) — hibou happy path: stub guards valAt --- - (let [stub (reify clojure.lang.ILookup - (valAt [_ _] (throw (ex-info "should not be called" {}))) - (valAt [_ _ _] (throw (ex-info "should not be called" {}))))] - (detect-read-errors {:analytics2 {:raw stub}} - [[:analytics2 :raw {:q 1}]] - err-detect)) - ;=> nil - - ;; Plain-map intermediate error (detect-read-errors {:dashboards {:user {:error {:type :forbidden}}}} [[:dashboards :user :dashboard]] err-detect) ;=> {[:dashboards :user] {:type :forbidden}} - ;; No detect-fn → nil (walk skipped) - (detect-read-errors {:a {:error {}}} [[:a :x]] nil) ;=> nil - - ;; --- :deep? true — walks through ILookup --- - (let [stub (reify clojure.lang.ILookup - (valAt [_ k] (case k :resource {:error {:type :forbidden}} nil)) - (valAt [this k _] (.valAt this k)))] - (detect-read-errors {:role stub} [[:role :resource :name]] err-detect :deep? true)) - ;=> {[:role :resource] {:type :forbidden}} + ;; Leaf error (var path reaches an error map) + (detect-read-errors {:user {:error {:type :forbidden}}} + [[:user]] + err-detect) + ;=> {[:user] {:type :forbidden}} - ;; :deep? true — leaf error (stub returns error map directly) - (let [stub (reify clojure.lang.ILookup - (valAt [_ k] (case k :name {:error {:type :forbidden}} nil)) - (valAt [this k _] (.valAt this k)))] - (detect-read-errors {:user stub} [[:user :name]] err-detect :deep? true)) - ;=> {[:user :name] {:type :forbidden}} + (detect-read-errors {:a {:error {}}} [[:a :x]] nil) ;=> nil ) (defn- execute-mutation @@ -754,40 +658,30 @@ (defn- execute-read "Execute a read pattern against api-fn data. - 1. Shallow pre-walk (plain maps only) catches role/auth errors early - without invoking ILookup/Collection. - 2. Compile + run matcher (one ILookup invocation per accessed key). - 3. Post-match: walk the matcher's realized `:val` to surface errors - inside collections — no second ILookup pass. On failure, `:val` - is nil and `classify-result` handles path-coverage itself." + Compile + run matcher (one ILookup invocation per accessed key), then walk + the matcher's realized `:val` to surface errors inside collections — + no second ILookup pass. On match failure `:val` is nil and + `classify-result` appends the match-failure to any detected errors." [api-fn ctx pattern opts] (let [{:keys [data schema errors]} (api-fn ctx) - detect-fn (make-detect-fn (:detect errors)) - var-paths (extract-var-paths pattern) - pre-errors (detect-read-errors data var-paths detect-fn) - error-paths (when (seq pre-errors) (set (keys pre-errors))) - trimmed (if error-paths - (trim-pattern pattern error-paths) - pattern)] - (-> (if-not trimmed - (failure (error-map->errors pre-errors)) - (let [compiled (pattern/compile-pattern - trimmed - (cond-> (select-keys opts [:resolve :eval-fn]) - (not (:resolve opts)) (assoc :resolve safe-resolve) - (not (:eval-fn opts)) (assoc :eval-fn safe-eval) - schema (assoc :schema schema))) - result (compiled (pattern/vmr data)) - combined (merge pre-errors - (detect-read-errors (:val result) var-paths detect-fn :deep? true)) - err-paths (keys combined) - all-covered? (and (seq combined) - (every? (fn [vp] - (some #(path-prefix? % vp) err-paths)) - var-paths))] - (if (and (not (pattern/failure? result)) all-covered?) - (failure (error-map->errors combined)) - (classify-result result (error-map->errors combined))))) + detect-fn (make-detect-fn (:detect errors)) + var-paths (extract-var-paths pattern) + compiled (pattern/compile-pattern + pattern + (cond-> (select-keys opts [:resolve :eval-fn]) + (not (:resolve opts)) (assoc :resolve safe-resolve) + (not (:eval-fn opts)) (assoc :eval-fn safe-eval) + schema (assoc :schema schema))) + result (compiled (pattern/vmr data)) + detected (detect-read-errors (:val result) var-paths detect-fn) + err-paths (keys detected) + all-covered? (and (seq detected) + (every? (fn [vp] + (some #(path-prefix? % vp) err-paths)) + var-paths))] + (-> (if (and (not (pattern/failure? result)) all-covered?) + (failure (error-map->errors detected)) + (classify-result result (error-map->errors detected))) (vary-meta assoc ::error-codes (:codes errors))))) (defn execute From 9ae3d5ac4f8b956387ce8e331c9f6fa242e7c6a6 Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Thu, 23 Apr 2026 16:25:04 +0800 Subject: [PATCH 4/7] fix(remote): Drop error-covered vars from partial-success read response --- .../src/sg/flybot/pullable/remote/http.cljc | 85 +++++++++---------- 1 file changed, 40 insertions(+), 45 deletions(-) diff --git a/remote/src/sg/flybot/pullable/remote/http.cljc b/remote/src/sg/flybot/pullable/remote/http.cljc index 6a3b698..513f0d1 100644 --- a/remote/src/sg/flybot/pullable/remote/http.cljc +++ b/remote/src/sg/flybot/pullable/remote/http.cljc @@ -6,7 +6,7 @@ [clojure.string :as str] [clojure.walk] [sg.flybot.pullable.impl :as pattern] - [sg.flybot.pullable.util :refer [contains-variables?]] + [sg.flybot.pullable.util :refer [contains-variables? variable?]] [sg.flybot.pullable.collection :as coll] #?(:clj [cognitect.transit :as transit]) #?(:clj [clojure.edn :as edn]) @@ -482,44 +482,37 @@ (or (zero? pc) (= prefix (subvec (vec path) 0 pc)))))) -(defn- extract-var-paths - "Extract paths from pattern root to variable-containing leaves. - Returns a seq of keyword vectors, e.g. [[:a :b] [:a :c] [:d]]." - ([pattern] (extract-var-paths pattern [])) - ([pattern prefix] - (when (map? pattern) - (mapcat (fn [[k v]] - (let [path (conj prefix k)] - (if (map? v) - (extract-var-paths v path) - (when (contains-variables? v) [path])))) - pattern)))) +(defn- pattern-var-bindings + "Walk pattern, return {sym path} for each bound variable. + Handles plain `?x` and extended `(?x :when ...)` forms." + [pattern] + (letfn [(bound-sym [x] + (cond + (variable? x) x + (and (seq? x) (variable? (first x))) (first x))) + (walk [acc p prefix] + (if (map? p) + (reduce-kv (fn [a k v] (walk a v (conj prefix k))) acc p) + (if-let [s (bound-sym p)] + (assoc acc (symbol (subs (name s) 1)) prefix) + acc)))] + (walk {} pattern []))) ^:rct/test (comment - ;; extract-var-paths — flat pattern - (set (extract-var-paths '{:a ?x :b ?y})) - ;=> #{[:a] [:b]} - - ;; extract-var-paths — nested pattern - (extract-var-paths '{:a {:b ?x}}) - ;=> [[:a :b]] + (pattern-var-bindings '{:a ?x :b ?y}) + ;=>> {'x [:a] 'y [:b]} - ;; extract-var-paths — mixed depths - (set (extract-var-paths '{:a {:b ?x :c ?y} :d ?z})) - ;=> #{[:a :b] [:a :c] [:d]} + (pattern-var-bindings '{:a {:b ?x}}) + ;=> {'x [:a :b]} - ;; extract-var-paths — extended variable form - (extract-var-paths '{:a (?x :when string?)}) - ;=> [[:a]] + (pattern-var-bindings '{:a (?x :when string?)}) + ;=> {'x [:a]} - ;; extract-var-paths — literal values ignored - (extract-var-paths '{:a "literal" :b ?x}) - ;=> [[:b]] + (pattern-var-bindings '{:a "literal" :b ?x}) + ;=> {'x [:b]} - ;; extract-var-paths — nil pattern - (extract-var-paths nil) - ;=> nil + (pattern-var-bindings nil) ;=> {} ;; path-prefix?: empty prefix matches any path (path-prefix? [] [:a]) ;=> true @@ -534,8 +527,8 @@ (defn- error-map->errors "Convert error-map {path error-data} into wire-format error vectors. - Error paths are always pattern-derived (from extract-var-paths), so no - filtering is needed — all errors are relevant by construction." + Error paths are always pattern-derived, so no filtering is needed — + all errors are relevant by construction." [error-map] (when (seq error-map) (mapv (fn [[path err]] @@ -657,15 +650,14 @@ detected (vary-meta assoc ::detected-errors detected)))) (defn- execute-read - "Execute a read pattern against api-fn data. - Compile + run matcher (one ILookup invocation per accessed key), then walk - the matcher's realized `:val` to surface errors inside collections — - no second ILookup pass. On match failure `:val` is nil and - `classify-result` appends the match-failure to any detected errors." + "Execute a read pattern: compile, match, then inspect the matcher's realized + `:val` for per-path errors. Returns partial success when some var-paths + resolve cleanly, or full failure when every var-path is error-covered." [api-fn ctx pattern opts] (let [{:keys [data schema errors]} (api-fn ctx) detect-fn (make-detect-fn (:detect errors)) - var-paths (extract-var-paths pattern) + var-bindings (when detect-fn (pattern-var-bindings pattern)) + var-paths (vals var-bindings) compiled (pattern/compile-pattern pattern (cond-> (select-keys opts [:resolve :eval-fn]) @@ -675,13 +667,16 @@ result (compiled (pattern/vmr data)) detected (detect-read-errors (:val result) var-paths detect-fn) err-paths (keys detected) + covered? (fn [p] (some #(path-prefix? % p) err-paths)) + kept-vars (when (and (:vars result) (seq err-paths)) + (into {} (remove (fn [[sym _]] (covered? (get var-bindings sym))) + (:vars result)))) all-covered? (and (seq detected) - (every? (fn [vp] - (some #(path-prefix? % vp) err-paths)) - var-paths))] + (every? covered? var-paths)) + errs (error-map->errors detected)] (-> (if (and (not (pattern/failure? result)) all-covered?) - (failure (error-map->errors detected)) - (classify-result result (error-map->errors detected))) + (failure errs) + (classify-result (cond-> result kept-vars (assoc :vars kept-vars)) errs)) (vary-meta assoc ::error-codes (:codes errors))))) (defn execute From 747fb6be78a6c1c91d6aab972cb90529fc141429 Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Fri, 24 Apr 2026 08:51:39 +0800 Subject: [PATCH 5/7] refactor(remote): Fold execute-read error classification into classify-vars --- .../src/sg/flybot/pullable/remote/http.cljc | 134 +++++++++++------- 1 file changed, 79 insertions(+), 55 deletions(-) diff --git a/remote/src/sg/flybot/pullable/remote/http.cljc b/remote/src/sg/flybot/pullable/remote/http.cljc index 513f0d1..5a4009b 100644 --- a/remote/src/sg/flybot/pullable/remote/http.cljc +++ b/remote/src/sg/flybot/pullable/remote/http.cljc @@ -572,42 +572,77 @@ (detect-path-error {:a {:b 42}} [:a :b] nil) ;=> [42 nil] ) -(defn- detect-read-errors - "For each var-path, record any error found along the path or at the leaf. - Returns {path error-data} map, or nil if no errors." - [data var-paths detect-fn] - (when detect-fn - (let [errors (reduce - (fn [acc path] - (let [[val err] (detect-path-error data path detect-fn)] - (if err - (let [ep (:path err)] - (cond-> acc - (not (contains? acc ep)) (assoc ep (dissoc err :path)))) - (if-let [leaf-err (when (map? val) (detect-fn val))] - (cond-> acc - (not (contains? acc path)) (assoc path leaf-err)) - acc)))) - {} - var-paths)] - (when (seq errors) errors)))) +(defn- classify-vars + "Walk each bound var's path in `val`; classify as kept or errored in one pass. + Returns {:kept-vars + :errs + :all-covered? }. + When `detect-fn` is nil or `var-bindings` empty, returns {:kept-vars vars}." + [val vars var-bindings detect-fn] + (if (or (nil? detect-fn) (empty? var-bindings)) + {:kept-vars vars} + (let [{:keys [kept err-map]} + (reduce-kv + (fn [acc sym path] + (let [[v e] (detect-path-error val path detect-fn) + err (or e (when (map? v) (detect-fn v)))] + (if err + (let [ep (or (:path err) path)] + (cond-> acc + (not (contains? (:err-map acc) ep)) + (assoc-in [:err-map ep] (dissoc err :path)))) + (assoc-in acc [:kept sym] (get vars sym))))) + {:kept {} :err-map {}} + var-bindings)] + {:kept-vars kept + :errs (error-map->errors err-map) + :all-covered? (and (seq err-map) (empty? kept))}))) ^:rct/test (comment (def err-detect #(get % :error)) - (detect-read-errors {:dashboards {:user {:error {:type :forbidden}}}} - [[:dashboards :user :dashboard]] - err-detect) - ;=> {[:dashboards :user] {:type :forbidden}} - - ;; Leaf error (var path reaches an error map) - (detect-read-errors {:user {:error {:type :forbidden}}} - [[:user]] - err-detect) - ;=> {[:user] {:type :forbidden}} - - (detect-read-errors {:a {:error {}}} [[:a :x]] nil) ;=> nil + ;; partial: one path errored, one kept + (classify-vars {:pub {:items [1 2 3]} + :priv {:error {:type :forbidden :message "NA"}}} + '{all [1 2 3] secret nil} + '{all [:pub :items] secret [:priv :items]} + err-detect) + ;=> {:kept-vars '{all [1 2 3]} + ; :errs [{:code :forbidden :reason "NA" :path [:priv]}] + ; :all-covered? false} + + ;; all covered + (:all-covered? + (classify-vars {:a {:error {:type :forbidden}} :b {:error {:type :forbidden}}} + '{x nil y nil} + '{x [:a :foo] y [:b :bar]} + err-detect)) + ;=>> true + + ;; leaf error: var binds directly to error map + (-> (classify-vars {:a {:error {:type :forbidden :message "NA"}}} + '{x {:error {:type :forbidden :message "NA"}}} + '{x [:a]} + err-detect) + (select-keys [:kept-vars :all-covered?])) + ;=> {:kept-vars {} :all-covered? true} + + ;; dedup: multiple vars under the same error path produce one error + (:errs + (classify-vars {:p {:error {:type :forbidden :message "denied"}}} + '{x nil y nil} + '{x [:p :a] y [:p :b]} + err-detect)) + ;=> [{:code :forbidden :reason "denied" :path [:p]}] + + ;; no detect-fn: vars pass through + (classify-vars {:a 1} '{x 1} '{x [:a]} nil) + ;=> {:kept-vars '{x 1}} + + ;; empty var-bindings: vars pass through + (classify-vars {} nil {} err-detect) + ;=> {:kept-vars nil} ) (defn- execute-mutation @@ -637,18 +672,6 @@ (failure (error :execution-error #?(:clj (.getMessage e) :cljs (.-message e))))))) -(defn- classify-result - "Classify a match result into a success or failure response. - On success with detected errors, attaches them as ::detected-errors metadata. - On failure, checks if the failure path is covered by a detected error." - [result detected] - (if (pattern/failure? result) - (let [pattern-err (match-failure->error result) - covered? (some #(path-prefix? (:path %) (:path pattern-err)) detected)] - (failure (if covered? detected (conj (or detected []) pattern-err)))) - (cond-> (success (:val result) (:vars result)) - detected (vary-meta assoc ::detected-errors detected)))) - (defn- execute-read "Execute a read pattern: compile, match, then inspect the matcher's realized `:val` for per-path errors. Returns partial success when some var-paths @@ -657,7 +680,6 @@ (let [{:keys [data schema errors]} (api-fn ctx) detect-fn (make-detect-fn (:detect errors)) var-bindings (when detect-fn (pattern-var-bindings pattern)) - var-paths (vals var-bindings) compiled (pattern/compile-pattern pattern (cond-> (select-keys opts [:resolve :eval-fn]) @@ -665,18 +687,20 @@ (not (:eval-fn opts)) (assoc :eval-fn safe-eval) schema (assoc :schema schema))) result (compiled (pattern/vmr data)) - detected (detect-read-errors (:val result) var-paths detect-fn) - err-paths (keys detected) - covered? (fn [p] (some #(path-prefix? % p) err-paths)) - kept-vars (when (and (:vars result) (seq err-paths)) - (into {} (remove (fn [[sym _]] (covered? (get var-bindings sym))) - (:vars result)))) - all-covered? (and (seq detected) - (every? covered? var-paths)) - errs (error-map->errors detected)] - (-> (if (and (not (pattern/failure? result)) all-covered?) + {:keys [kept-vars errs all-covered?]} + (classify-vars (:val result) (:vars result) var-bindings detect-fn)] + (-> (cond + (pattern/failure? result) + (let [perr (match-failure->error result)] + (failure + (if (some #(path-prefix? (:path %) (:path perr)) errs) + errs + (conj (or errs []) perr)))) + all-covered? (failure errs) - (classify-result (cond-> result kept-vars (assoc :vars kept-vars)) errs)) + :else + (cond-> (success (:val result) kept-vars) + (seq errs) (vary-meta assoc ::detected-errors errs))) (vary-meta assoc ::error-codes (:codes errors))))) (defn execute From b138f38e96703be50439cabb06cff60297095dcb Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Fri, 24 Apr 2026 09:21:32 +0800 Subject: [PATCH 6/7] chore(remote): Bump version to 0.1.4, update changelog and docs --- remote/CHANGELOG.md | 12 ++++++++++++ remote/CLAUDE.md | 9 +++++++-- remote/resources/version.edn | 2 +- 3 files changed, 20 insertions(+), 3 deletions(-) diff --git a/remote/CHANGELOG.md b/remote/CHANGELOG.md index f11d12f..2bc845b 100644 --- a/remote/CHANGELOG.md +++ b/remote/CHANGELOG.md @@ -5,6 +5,18 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.1.4] - 2026-04-24 + +### Changed + +- `execute-read` invokes each ILookup at most once: the compiled pattern matches against data, then a post-match walk on the matcher's `:val` surfaces per-path errors without re-pulling from collections +- Drop error-covered bindings from partial-success read responses (previously leaked as `nil`, or as the error map itself when a var's path landed exactly on the error) +- Fold read-error detection, var filtering, and all-covered classification into a single pass via new private `classify-vars` + +### Removed + +- `detect-read-errors` and `classify-result` (private fns) — replaced by `classify-vars` + ## [0.1.3] - 2026-04-22 ### Changed diff --git a/remote/CLAUDE.md b/remote/CLAUDE.md index 020b6be..ac32595 100644 --- a/remote/CLAUDE.md +++ b/remote/CLAUDE.md @@ -154,11 +154,16 @@ Collections return errors as data (not exceptions): **Mutations** are all-or-nothing: Remote checks the mutation result with `:detect`, maps `:type` to HTTP status via `:codes`. Path-level errors (e.g., role gate returning `{:error ...}` along the path) are detected before attempting the mutation. -**Reads** support partial success: Before pattern matching, `execute-read` extracts var paths from the pattern and walks each path through the data (including through ILookup) checking for errors via `:detect`. The pattern is trimmed to remove error paths, and matching proceeds on the original data. If some branches succeed and others fail: +**Reads** support partial success. `execute-read` invokes each ILookup at most once: + +1. **Match** runs the compiled pattern against data (one ILookup call per accessed key). +2. **Post-match walk** on the matcher's `:val` — every value in `:val` was already realized by the matcher, so the walk surfaces errors inside collections without a second ILookup pass. On match failure, `:val` is nil and `execute-read` appends the match-failure itself to any detected errors. + +If some branches succeed and others fail: - Successful bindings are returned normally - Detected errors are attached as `::detected-errors` metadata and included in the wire response as `:errors` -If all pattern paths are error paths, the read fails with the full error list. +If all pattern paths are covered by error paths, the read fails with the full error list. **Partial success applies to reads only.** Mutations remain all-or-nothing. diff --git a/remote/resources/version.edn b/remote/resources/version.edn index 56f0660..99b05bb 100644 --- a/remote/resources/version.edn +++ b/remote/resources/version.edn @@ -1 +1 @@ -{:version "0.1.3"} +{:version "0.1.4"} From 6dc866a6ef4ddb3d32c8b770ce0e38cdb3e793b6 Mon Sep 17 00:00:00 2001 From: chickendreanso Date: Fri, 24 Apr 2026 09:54:19 +0800 Subject: [PATCH 7/7] fix(remote): Preserve vars from vector/quantifier patterns in read responses --- .../src/sg/flybot/pullable/remote/http.cljc | 112 ++++++++++++++++-- 1 file changed, 99 insertions(+), 13 deletions(-) diff --git a/remote/src/sg/flybot/pullable/remote/http.cljc b/remote/src/sg/flybot/pullable/remote/http.cljc index 5a4009b..821a560 100644 --- a/remote/src/sg/flybot/pullable/remote/http.cljc +++ b/remote/src/sg/flybot/pullable/remote/http.cljc @@ -482,19 +482,42 @@ (or (zero? pc) (= prefix (subvec (vec path) 0 pc)))))) +(defn- var-binding-sym + "For a pattern variable symbol, return the matcher's binding symbol + (same rule `pattern/matching-var-rewrite` uses), or nil for wildcards + (`?_`, `?_?`, `?_*`, ...) and the bare `?` core-form marker. + Delegates quantifier parsing to `pattern/parse-matching-var`." + [s] + (if-let [{:keys [sym]} (pattern/parse-matching-var s)] + ;; Quantified: :sym is `?x` with ? prefix, or nil for ?_* etc. + (when sym (symbol (subs (name sym) 1))) + ;; Plain ?x or ?_ (parse-matching-var returns nil for unquantified) + (let [nm (name s)] + (when (and (> (count nm) 1) (not= "?_" nm)) + (symbol (subs nm 1)))))) + (defn- pattern-var-bindings "Walk pattern, return {sym path} for each bound variable. - Handles plain `?x` and extended `(?x :when ...)` forms." + Descends into maps, vectors, and extended `(?x :when ...)` forms. + Vector/sequence elements share the enclosing map path so that error + detection covers the whole sub-pattern; individual element positions + are not distinguished. Wildcards (`?_`-family) are skipped." [pattern] (letfn [(bound-sym [x] (cond (variable? x) x (and (seq? x) (variable? (first x))) (first x))) (walk [acc p prefix] - (if (map? p) + (cond + (map? p) (reduce-kv (fn [a k v] (walk a v (conj prefix k))) acc p) - (if-let [s (bound-sym p)] - (assoc acc (symbol (subs (name s) 1)) prefix) + + (vector? p) + (reduce (fn [a v] (walk a v prefix)) acc p) + + :else + (if-let [bound (some-> (bound-sym p) var-binding-sym)] + (assoc acc bound prefix) acc)))] (walk {} pattern []))) @@ -514,6 +537,19 @@ (pattern-var-bindings nil) ;=> {} + ;; quantifier suffixes are stripped to match matcher binding names + (pattern-var-bindings '{:a ?x?}) ;=> {'x [:a]} + (pattern-var-bindings '{:a ?x*}) ;=> {'x [:a]} + (pattern-var-bindings '{:a ?x+!}) ;=> {'x [:a]} + + ;; vector elements share the enclosing map path + (pattern-var-bindings '{:items [?first ?rest*]}) + ;=>> {'first [:items] 'rest [:items]} + + ;; nested vectors + (pattern-var-bindings '{:a [[?x ?y]]}) + ;=>> {'x [:a] 'y [:a]} + ;; path-prefix?: empty prefix matches any path (path-prefix? [] [:a]) ;=> true (path-prefix? [] [:a :b]) ;=> true @@ -574,29 +610,34 @@ (defn- classify-vars "Walk each bound var's path in `val`; classify as kept or errored in one pass. - Returns {:kept-vars + Returns {:kept-vars :errs :all-covered? }. + `var-bindings` drives the error walk only — `kept-vars` is seeded from + the matcher's full `vars` so variables in vector/sequence patterns (which + share a single enclosing path) still surface in the response. When `detect-fn` is nil or `var-bindings` empty, returns {:kept-vars vars}." [val vars var-bindings detect-fn] (if (or (nil? detect-fn) (empty? var-bindings)) {:kept-vars vars} - (let [{:keys [kept err-map]} + (let [{:keys [err-map errored]} (reduce-kv (fn [acc sym path] (let [[v e] (detect-path-error val path detect-fn) err (or e (when (map? v) (detect-fn v)))] (if err (let [ep (or (:path err) path)] - (cond-> acc - (not (contains? (:err-map acc) ep)) - (assoc-in [:err-map ep] (dissoc err :path)))) - (assoc-in acc [:kept sym] (get vars sym))))) - {:kept {} :err-map {}} - var-bindings)] + (-> acc + (update :errored conj sym) + (cond-> (not (contains? (:err-map acc) ep)) + (assoc-in [:err-map ep] (dissoc err :path))))) + acc))) + {:err-map {} :errored #{}} + var-bindings) + kept (reduce dissoc vars errored)] {:kept-vars kept :errs (error-map->errors err-map) - :all-covered? (and (seq err-map) (empty? kept))}))) + :all-covered? (boolean (and (seq err-map) (empty? kept)))}))) ^:rct/test (comment @@ -643,6 +684,24 @@ ;; empty var-bindings: vars pass through (classify-vars {} nil {} err-detect) ;=> {:kept-vars nil} + + ;; vector-pattern vars survive even though var-bindings collapses them + ;; onto a single enclosing path + (classify-vars {:items [10 20 30]} + '{first 10 rest (20 30)} + '{first [:items] rest [:items]} + err-detect) + ;=>> {:kept-vars {'first 10 'rest '(20 30)} + ; :all-covered? false} + + ;; vector-pattern error: both vars drop and error surfaces + (classify-vars {:items {:error {:type :forbidden :message "NA"}}} + '{first [:error {:type :forbidden :message "NA"}] rest ()} + '{first [:items] rest [:items]} + err-detect) + ;=> {:kept-vars {} + ; :errs [{:code :forbidden :reason "NA" :path [:items]}] + ; :all-covered? true} ) (defn- execute-mutation @@ -999,6 +1058,33 @@ (:errors (execute test-no-detect-fail-api-fn '{:broken {:deep ?v}})) ;=>> [{:code :match-failure}] + ;; --- read: vector patterns preserve their bindings in the response --- + + (def test-vec-api-fn + (fn [_ctx] + {:data {:items [10 20 30] :meta {:count 3}} + :errors {:detect :error :codes {:forbidden 403}}})) + + (execute test-vec-api-fn '{:items [?first ?rest*] :meta {:count ?c}}) + ;=>> {'first 10 'rest '(20 30) 'c 3} + + ;; vector-leaf error path is detected; remaining vars survive + (def test-vec-error-api-fn + (fn [_ctx] + {:data {:ok {:n 1} + :denied {:error {:type :forbidden :message "NA"}}} + :errors {:detect :error :codes {:forbidden 403}}})) + + (let [r (execute test-vec-error-api-fn '{:ok {:n ?n} :denied [?items*]})] + [(get r 'n) (contains? r 'items) (::detected-errors (meta r))]) + ;=>> [1 false [{:code :forbidden :reason "NA" :path [:denied]}]] + + ;; --- read: quantifier suffixes (?x?, ?x*, ?x+) bind to stripped name --- + + (execute (fn [_ctx] {:data {:items 42} :errors {:detect :error}}) + '{:items ?x?}) + ;=>> {'x 42} + ;; --- mutations --- ;; create succeeds through guarded collection