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
+; []))))