Introduce orchard.inspect/nav-to-item

vemv · vemv · commit 8d3cc2959aae · 2023-11-12T09:25:58.000+01:00
Closes #209
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,10 @@
 
 ## master (unreleased)
 
+## New features
+
+* [#209](https://github.com/clojure-emacs/orchard/issues/209): add `orchard.inspect/nav-to-item` function which enables [nav](https://clojure.github.io/clojure/branch-master/clojure.datafy-api.html#clojure.datafy/nav)ing to a specific sub-item within a given Inspector value.
+
 ## 0.20.0 (2023-11-11)
 
 ## New features
diff --git a/project.clj b/project.clj
@@ -84,7 +84,7 @@
                                          `add-cognitest)]}
 
              ;; Development tools
-             :dev {:plugins [[cider/cider-nrepl "0.43.1"]
+             :dev {:plugins [[cider/cider-nrepl "0.43.3"]
                              [refactor-nrepl "3.9.0"]]
                    :dependencies [[nrepl/nrepl "1.0.0"]
                                   [org.clojure/tools.namespace "1.4.4"]]
diff --git a/src/orchard/inspect.clj b/src/orchard/inspect.clj
@@ -120,11 +120,14 @@
         (assoc :path new-path)
         (inspect-render new))))
 
+(defn- nth-wrapper? [x]
+  (and (seq? x)
+       (= 'nth (first x))))
+
 (defn- sibling* [inspector offset pred]
   (let [path (:path inspector)
         last-item (peek path)]
-    (or (when (and (seq? last-item)
-                   (= 'nth (first last-item)))
+    (or (when (nth-wrapper? last-item)
           (let [new-index (+ offset ;; for our purposes, +2 means inc, +1 nop, and +0 dec
                              (second last-item))
                 top (up inspector)]
@@ -150,6 +153,34 @@
                           (< index
                              (-> inspector :index count)))))
 
+(defn nav-to-item
+  "Shows the value per `nav` for the item at `idx`,
+  relative to the `inspector`'s current value."
+  [inspector idx]
+  (cond
+    (not nav)
+    inspector
+
+    (some #{'<unknown>} (:path inspector))
+    inspector
+
+    :else
+    (let [{:keys [index value path current-page page-size]} inspector
+          new-path (push-item-to-path index idx path current-page page-size)
+          normalized-path (mapv (fn [x]
+                                  (cond-> x
+                                    (nth-wrapper? x) second))
+                                new-path)
+          k (peek normalized-path)
+          v (get value k)]
+      (if (some #{'<unknown>} new-path)
+        inspector
+        (-> (update-in inspector [:stack] conj value)
+            (update-in [:pages-stack] conj current-page)
+            (assoc :current-page 0)
+            (assoc :path new-path)
+            (inspect-render (nav value k v)))))))
+
 (defn next-page
   "Jump to the next page when inspecting a paginated sequence/map. Does nothing
   if already on the last page."
@@ -508,19 +539,25 @@
         (unindent))
     inspector))
 
-(defn- nav-datafy-tx [obj remove-nil-valued-entries?]
+(defn- nav-datafy-tx [remove-nil-valued-entries?]
   (keep (fn [[k v]]
-          (or (some->> (nav obj k v)
-                       (datafy)
-                       (vector k))
-              (when (and (nil? v)
-                         (not remove-nil-valued-entries?))
-                [k v])))))
+          (or
+           ;; NOTE: this `v` used to be a `(nav obj k v)` call.
+           ;; Per Clojure's default implementation of Nav, that's equivalent to `v`.
+           ;; Calling nav is worse since in practice it means that we're eagerly invoking `nav`,
+           ;; which for custom implementations can mean that side-effects (like http or JDBC navigation) would be triggered
+           ;; before the user has expressed any intent to use those side-effects.
+           (some->> v
+                    (datafy)
+                    (vector k))
+           (when (and (nil? v)
+                      (not remove-nil-valued-entries?))
+             [k v])))))
 
 (defn- nav-datafy [obj remove-nil-valued-entries?]
   (let [data (datafy obj)]
     (cond (map? data)
-          (into {} (nav-datafy-tx obj remove-nil-valued-entries?) data)
+          (into {} (nav-datafy-tx remove-nil-valued-entries?) data)
           (or (sequential? data) (set? data))
           (map datafy data))))
 
diff --git a/test/orchard/inspect_test.clj b/test/orchard/inspect_test.clj
@@ -443,6 +443,23 @@
                inspect/next-sibling
                inspect/next-sibling)))))
 
+(when datafy?
+  (deftest nav-to-item-test
+    (let [proof (atom [])]
+      (is (= 99
+             (-> {:foo [(with-meta {1 1}
+                          {'clojure.core.protocols/nav (fn [self _ _]
+                                                         (swap! proof conj self)
+                                                         99)})]}
+                 inspect
+                 (inspect/down 2)
+                 (inspect/down 1)
+                 (inspect/nav-to-item 1)
+                 :value))
+          "Inspects the value per its `nav` representation - not the value itself")
+      (is (= [{1 1}] @proof)
+          "Nav is performed exactly once"))))
+
 (deftest path-test
   (testing "inspector tracks the path in the data structure"
     (is (= "(find 50) key" (-> long-map inspect (inspect/down 39) render last)))
@@ -941,32 +958,6 @@
                         (:newline))
                       (datafy-section rendered))))))))
 
-(deftest inspect-navigable-metadata-extension-test
-  (testing "inspecting a map extended with the Navigable protocol"
-    (let [rendered (-> (extend-nav-vector {:name "John Doe"}) inspect render)]
-      (testing "renders the header"
-        (is (match? '("Class"
-                      ": "
-                      (:value "clojure.lang.PersistentArrayMap" 0)
-                      (:newline)
-                      (:newline))
-                    (header rendered))))
-      (testing "renders the meta information section"
-        (is (match? '("--- Meta Information:"
-                      (:newline)
-                      "  " (:value "clojure.core.protocols/nav" 1)
-                      " = " (:value "orchard.inspect_test$extend_nav_vector$fn" 2)
-                      (:newline)
-                      (:newline))
-                    (demunge (section "Meta Information" rendered)))))
-      (when datafy?
-        (testing "renders the datafy section"
-          (is (match? '("--- Datafy:"
-                        (:newline)
-                        "  " (:value ":name" 5) " = " (:value "[ :name \"John Doe\" ]" 6)
-                        (:newline))
-                      (datafy-section rendered))))))))
-
 (deftest inspect-throwable-test
   (testing "inspecting a throwable"
     (let [rendered (-> (doto ^Throwable (ex-info "BOOM" {})
