dance around issue #22

The idea is to track depth and break complex markup into chunks
and continue rendering in body if over budget.

src/lib/devtools/defaults.cljs

@@ -98,6 +98,7 @@
    :list-close-symbol                             ""
    :empty-basis-symbol                            (span (css) :basis-icon (span :type-basis-item-style "∅"))
    :expandable-symbol                             ""
+   :header-expander-symbol                        (span (css) "~")
 
    ; -- backgrounds ---------------------------------------------------------------------------------------------------------
 
@@ -181,6 +182,7 @@
    :expandable-inner-tag                          [:span :expandable-inner-style]
    :instance-custom-printing-tag                  [:span :instance-custom-printing-style]
    :default-envelope-tag                          [:span :default-envelope-style]
+   :header-expander-tag                           [:span :header-expander-style]
 
    ; -- DOM tags mapping ----------------------------------------------------------------------------------------------------
 
@@ -198,6 +200,7 @@
                                                        "border-radius: 2px;")
 
    :header-style                                  (css "white-space: nowrap;")                                                ; this prevents jumping of content when expanding sections due to content wrapping
+   :header-expander-style                         (css "white-space: nowrap;")                                                ; this prevents jumping of content when expanding sections due to content wrapping
    :expandable-style                              (css "white-space: nowrap;"
                                                        "padding-left: 3px;")
    :expandable-inner-style                        (css "margin-left: -3px;")

src/lib/devtools/formatters/budgeting.cljs

@@ -0,0 +1,87 @@
+(ns devtools.formatters.budgeting
+  (:require-macros [devtools.util :refer [oget oset ocall oapply safe-call]])
+  (:require [devtools.formatters.templating :refer [render-markup]]
+            [devtools.formatters.state :refer [get-depth-budget set-depth-budget]]
+            [devtools.formatters.markup :refer [<header-expander>]]))
+
+; This functionality provides a workaround to issue #22 (https://github.com/binaryage/cljs-devtools/issues/22).
+; The idea is to track hierarchy depth for json-ml(s) we are generating.
+; If we are about to cross the depth limit hardcoded in WebKit we instead
+; render simple expandable placeholders which resume full rendering in their bodies (when expanded by user).
+
+; this is hardcoded in InjectedScriptSource.js in WebKit, look for maxCustomPreviewRecursionDepth
+(def initial-hierarchy-depth-budget (dec 20))
+
+; we need to reserve some levels for our :header-expander-tag
+(def header-expander-cost 3)
+
+; -- tracking over-budget values  -------------------------------------------------------------------------------------------
+; note: phantomjs does not have WeakSet, so we have to emulate it when testing
+
+(def over-budget-values (if (exists? js/WeakSet)
+                          (js/WeakSet.)
+                          (volatile! #{})))
+
+(defn add-over-budget-value! [value]
+  (if (volatile? over-budget-values)
+    (vreset! over-budget-values (conj @over-budget-values value))
+    (ocall over-budget-values "add" value)))
+
+(defn delete-over-budget-value! [value]
+  (if (volatile? over-budget-values)
+    (vreset! over-budget-values (disj @over-budget-values value))
+    (ocall over-budget-values "delete" value)))
+
+(defn has-over-budget-value? [value]
+  (if (volatile? over-budget-values)
+    (contains? @over-budget-values value)
+    (ocall over-budget-values "has" value)))
+
+; -- helpers ----------------------------------------------------------------------------------------------------------------
+
+(defn object-reference? [v]
+  (= (first v) "object"))
+
+(defn determine-depth [v]
+  (if (array? v)
+    (if (object-reference? v)
+      (+ 1 header-expander-cost)
+      (inc (apply max (map determine-depth v))))
+    0))
+
+(defn transfer-remaining-depth-budget! [object-reference depth-budget]
+  {:pre [(pos? depth-budget)]}
+  (let [data (second object-reference)
+        _ (assert (object? data))
+        config (oget data "config")]
+    (oset data ["config"] (set-depth-budget config depth-budget))))
+
+(defn distribute-budget! [json-ml depth-budget]
+  {:pre [(pos? depth-budget)]}
+  (if (array? json-ml)
+    (let [new-depth-budget (dec depth-budget)]
+      (if (object-reference? json-ml)
+        (transfer-remaining-depth-budget! json-ml (- new-depth-budget header-expander-cost))
+        (doseq [item json-ml]
+          (distribute-budget! item new-depth-budget)))))
+  json-ml)
+
+; -- api --------------------------------------------------------------------------------------------------------------------
+
+(defn was-over-budget?! [value]
+  (when (has-over-budget-value? value)
+    (delete-over-budget-value! value)
+    true))
+
+(defn alter-json-ml-to-fit-in-remaining-budget! [value json-ml]
+  (let [remaining-depth-budget (or (get-depth-budget) initial-hierarchy-depth-budget)
+        depth (determine-depth json-ml)]
+    #_(.log js/console "D" depth remaining-depth-budget (- remaining-depth-budget depth)
+            (>= (- remaining-depth-budget depth) header-expander-cost) (binding [*print-level* 3]
+                                                                         (pr-str json-ml)))
+    (if (pos? (- remaining-depth-budget depth))
+      (distribute-budget! json-ml remaining-depth-budget)
+      (let [expander-ml (render-markup (<header-expander> value))]
+        (add-over-budget-value! value)
+        ;(.log js/console "Z" (determine-depth expander-ml) expander-ml)
+        expander-ml))))

src/lib/devtools/formatters/core.cljs

@@ -3,10 +3,12 @@
   (:require [devtools.prefs :refer [pref]]
             [devtools.format :refer [IDevtoolsFormat]]
             [devtools.protocols :refer [IFormat]]
-            [devtools.formatters.templating :refer [surrogate? render-markup get-surrogate-body get-surrogate-target]]
+            [devtools.formatters.templating :refer [surrogate? render-markup get-surrogate-body]]
             [devtools.formatters.helpers :refer [cljs-value?]]
-            [devtools.formatters.state :refer [prevent-recursion? *current-state* get-current-state get-default-state]]
-            [devtools.formatters.markup :refer [<header> <surrogate-header> <surrogate-body>]]))
+            [devtools.formatters.state :refer [prevent-recursion? *current-state* get-default-state update-current-state!
+                                               reset-depth-limits]]
+            [devtools.formatters.markup :refer [<header> <surrogate-header> <surrogate-body>]]
+            [devtools.formatters.budgeting :refer [was-over-budget?! alter-json-ml-to-fit-in-remaining-budget!]]))
 
 ; -- RAW API ----------------------------------------------------------------------------------------------------------------
 
@@ -15,30 +17,33 @@
        (or (cljs-value? value) (surrogate? value))))
 
 (defn header* [value]
-  (cond
-    (surrogate? value) (render-markup (<surrogate-header> value))
-    (safe-call satisfies? false IDevtoolsFormat value) (devtools.format/-header value)
-    (safe-call satisfies? false IFormat value) (devtools.protocols/-header value)
-    :else (render-markup (<header> value))))
+  (let [json-ml (cond
+                  (surrogate? value) (render-markup (<surrogate-header> value))
+                  (safe-call satisfies? false IDevtoolsFormat value) (devtools.format/-header value)
+                  (safe-call satisfies? false IFormat value) (devtools.protocols/-header value)
+                  :else (render-markup (<header> value)))]
+    (alter-json-ml-to-fit-in-remaining-budget! value json-ml)))                                                               ; see issue #22
 
 (defn has-body* [value]
   ; note: body is emulated using surrogate references
-  (boolean
-    (cond
-      (surrogate? value) (some? (get-surrogate-body value))
-      (safe-call satisfies? false IDevtoolsFormat value) (devtools.format/-has-body value)
-      (safe-call satisfies? false IFormat value) (devtools.protocols/-has-body value)
-      :else false)))
+  (if (was-over-budget?! value)                                                                                               ; see issue #22
+    false                                                                                                                     ; see alter-json-ml-to-fit-in-remaining-budget!, in case we didn't fit into budget, a header-expander placeholder with body was added in place
+    (boolean
+      (cond
+        (surrogate? value) (some? (get-surrogate-body value))
+        (safe-call satisfies? false IDevtoolsFormat value) (devtools.format/-has-body value)
+        (safe-call satisfies? false IFormat value) (devtools.protocols/-has-body value)
+        :else false))))
 
 (defn body* [value]
+  (update-current-state! reset-depth-limits)
   (cond
     (surrogate? value) (render-markup (<surrogate-body> value))
     (safe-call satisfies? false IDevtoolsFormat value) (devtools.format/-body value)
     (safe-call satisfies? false IFormat value) (devtools.protocols/-body value)))
 
-
 ; ---------------------------------------------------------------------------------------------------------------------------
-; RAW API config-aware, see state management documentation state.cljs
+; config-aware RAW API, see state management documentation state.cljs
 
 (defn config-wrapper [raw-fn]
   (fn [value config]

src/lib/devtools/formatters/markup.cljs

@@ -6,6 +6,7 @@
                                                  abbreviate-long-string get-constructor pref
                                                  get-more-marker wrap-arity fetch-fields-values]]
             [devtools.formatters.printing :refer [managed-print-via-writer managed-print-via-protocol]]
+            [devtools.formatters.state :refer [set-prevent-recursion set-managed-print-level reset-depth-limits]]
             [devtools.formatters.templating :refer [get-surrogate-body
                                                     get-surrogate-target
                                                     get-surrogate-start-index
@@ -54,9 +55,12 @@
   (concat [:circular-reference-tag :circular-ref-icon] children))
 
 (defn <native-reference> [object]
-  (let [reference (<reference> object {:prevent-recursion true})]
+  (let [reference (<reference> object #(set-prevent-recursion % true))]
     [:native-reference-tag :native-reference-background reference]))
 
+(defn <header-expander> [object]
+  [:header-expander-tag (<reference> (<raw-surrogate> object :header-expander-symbol :target) reset-depth-limits)])
+
 ; -- simple markup ----------------------------------------------------------------------------------------------------------
 
 (defn <cljs-land> [& children]
@@ -336,7 +340,7 @@
   [:header-field-tag
    [:header-field-name-tag (str name)]
    :header-field-value-spacer
-   [:header-field-value-tag (<reference> value)]
+   [:header-field-value-tag (<reference> (<surrogate> value) #(set-managed-print-level % 1))]
    :header-field-separator])
 
 (defn <fields-details-row> [field]
@@ -347,7 +351,7 @@
       [:body-field-name-tag (str name)]]
      [:body-field-td2-tag
       :body-field-value-spacer
-      [:body-field-value-tag (<reference> value)]]]))
+      [:body-field-value-tag (<reference-surrogate> value)]]]))
 
 (defn <fields> [fields & [max-fields]]
   (if (zero? (count fields))

src/lib/devtools/formatters/printing.cljs

@@ -4,7 +4,8 @@
             [devtools.format :refer [IDevtoolsFormat]]
             [devtools.protocols :refer [ITemplate IGroup ISurrogate IFormat]]
             [devtools.formatters.state :refer [push-object-to-current-history! *current-state* get-current-state
-                                               is-circular?]]
+                                               is-circular? get-managed-print-level set-managed-print-level
+                                               update-current-state!]]
             [devtools.formatters.helpers :refer [cljs-value? expandable? abbreviated? directly-printable?]]))
 
 ; -- helpers ----------------------------------------------------------------------------------------------------------------
@@ -124,8 +125,13 @@
         opts {:alt-impl     alt-printer-impl
               :markup-db    markup-db
               :print-length (pref :max-header-elements)
-              :more-marker  (pref :more-marker)}]
-    (printer writer opts)
+              :more-marker  (pref :more-marker)}
+        job-fn #(printer writer opts)]
+    (if-let [managed-print-level (get-managed-print-level)]
+      (binding [*print-level* managed-print-level]
+        (update-current-state! #(set-managed-print-level % nil))                                                              ; reset managed-print-level so it does not propagate further down in expaded data
+        (job-fn))
+      (job-fn))
     (concat [(pref tag)] (.get-group writer))))
 
 ; -- public printing API ----------------------------------------------------------------------------------------------------

src/lib/devtools/formatters/state.cljs

@@ -46,3 +46,28 @@
 (defn ^bool prevent-recursion? []
   (boolean (:prevent-recursion (get-current-state))))
 
+(defn set-prevent-recursion [state val]
+  (if (some? val)
+    (assoc state :prevent-recursion val)
+    (dissoc state :prevent-recursion)))
+
+(defn get-managed-print-level []
+  (:managed-print-level (get-current-state)))
+
+(defn set-managed-print-level [state val]
+  (if (some? val)
+    (assoc state :managed-print-level val)
+    (dissoc state :managed-print-level)))
+
+(defn get-depth-budget []
+  (:depth-budget (get-current-state)))
+
+(defn set-depth-budget [state val]
+  (if (some? val)
+    (assoc state :depth-budget val)
+    (dissoc state :depth-budget)))
+
+(defn reset-depth-limits [state]
+  (-> state
+      (set-depth-budget nil)
+      (set-managed-print-level nil)))

src/lib/devtools/formatters/templating.cljs

@@ -95,11 +95,14 @@
   {:pre [(surrogate? surrogate)]}
   (oget surrogate "startIndex"))
 
-(defn make-reference [object & [state-override]]
+(defn make-reference [object & [state-override-fn]]
+  {:pre [(or (nil? state-override-fn) (fn? state-override-fn))]}
   (if (nil? object)
     ; this code is duplicated in markup.cljs <nil>
     (make-template :span :nil-style :nil-label)
-    (let [sub-state (merge (get-current-state) state-override)]
+    (let [sub-state (if (some? state-override-fn)
+                      (state-override-fn (get-current-state))
+                      (get-current-state))]
       (make-group "object" #js {"object" object
                                 "config" sub-state}))))
 
@@ -200,6 +203,7 @@
 (defn render-markup* [initial-value value]
   (cond
     (fn? value) (recur initial-value (value))
+    (keyword? value) (recur initial-value (pref value))
     (sequential? value) (recur initial-value (render-json-ml value))
     (template? value) value
     (surrogate? value) value

test/src/tests/devtools/tests/adhoc.cljs

@@ -2,6 +2,7 @@
   (:refer-clojure :exclude [range = > < + str])
   (:require-macros [devtools.utils.macros :refer [range = > < + str want? with-prefs]])                                       ; prefs aware versions
   (:require [cljs.test :refer-macros [deftest testing is are]]
+            [devtools.protocols :refer [IFormat]]
             [devtools.pseudo.tag :as tag]
             [devtools.utils.test :refer [reset-prefs-to-defaults! js-equals is-header is-body has-body? unroll
                                          remove-empty-styles pref-str]]
@@ -11,46 +12,20 @@
             [devtools.prefs :refer [merge-prefs! set-pref! set-prefs! update-pref! get-prefs pref]]
             [devtools.utils.batteries :as b :refer [REF NATIVE-REF]]))
 
-(deftest test-strings
-  (testing "short strings"
-    (is-header "some short string"
-      [::tag/cljs-land
-       [::tag/header
-        [::tag/string (str :dq "some short string" :dq)]]])
-    (is-header "line1\nline2\n\nline4"
-      [::tag/cljs-land
-       [::tag/header
-        [::tag/string (str :dq "line1" :new-line-string-replacer "line2" :new-line-string-replacer :new-line-string-replacer "line4" :dq)]]]))
-  (testing "long strings"
-    (is-header "123456789012345678901234567890123456789012345678901234567890"
-      [::tag/cljs-land
-       [::tag/header
-        REF]]
-      (fn [ref]
-        (is (surrogate? ref))
-        (is-header ref
-          [::tag/expandable
-           [::tag/expandable-inner
-            [::tag/string (str :dq "12345678901234567890" :string-abbreviation-marker "12345678901234567890" :dq)]]])))
-    (is-header "1234\n6789012345678901234567890123456789012345678901234\n67890"
-      [::tag/cljs-land
-       [::tag/header
-        REF]]
-      (fn [ref]
-        (is (surrogate? ref))
-        (is-header ref
-          [::tag/expandable
-           [::tag/expandable-inner
-            [::tag/string
-             (str
-               :dq
-               "1234" :new-line-string-replacer "678901234567890"
-               :string-abbreviation-marker
-               "12345678901234" :new-line-string-replacer "67890"
-               :dq)]]])
-        (is-body ref
-          [::tag/expanded-string
-           (str
-             "1234" :new-line-string-replacer
-             "\n6789012345678901234567890123456789012345678901234" :new-line-string-replacer
-             "\n67890")])))))
+;(defn gen-nested-template [n]
+;  (if (pos? n)
+;    #js ["span" #js {} (gen-nested-template (dec n))]
+;    #js ["span" #js {} "X"]))
+;
+;(deftype X1 [n]
+;  IFormat
+;  (-header [value]
+;    (gen-nested-template n))
+;  (-has-body [value] false)
+;  (-body [value]))
+;
+;(deftest test-issue22
+;  (testing "long"
+;    (let [l14 (X1. 12)]
+;      (is-header l14
+;        []))))