Moved web root into root of project; this makes deployment easier.
Also deleted 'docs', which is now redundant.
This commit is contained in:
parent
a5204c66b9
commit
743d8a1740
1592 changed files with 53626 additions and 139250 deletions
145
js/compiled/out/devtools/formatters/printing.cljs
Normal file
145
js/compiled/out/devtools/formatters/printing.cljs
Normal file
|
|
@ -0,0 +1,145 @@
|
|||
(ns devtools.formatters.printing
|
||||
(:require-macros [devtools.oops :refer [safe-call]])
|
||||
(:require [devtools.prefs :refer [pref]]
|
||||
[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? get-managed-print-level set-managed-print-level
|
||||
update-current-state!]]
|
||||
[devtools.formatters.helpers :refer [cljs-value? expandable? abbreviated? directly-printable? should-render?]]))
|
||||
|
||||
; -- helpers ----------------------------------------------------------------------------------------------------------------
|
||||
|
||||
(defn markup? [value]
|
||||
(::markup (meta value)))
|
||||
|
||||
(defn mark-as-markup [value]
|
||||
(with-meta value {::markup true}))
|
||||
|
||||
(defn build-markup [markup-db fn-key & args]
|
||||
(let [f (get markup-db fn-key)]
|
||||
(assert f (str "missing markup method in markup-db: " fn-key))
|
||||
(mark-as-markup (apply f args))))
|
||||
|
||||
(defn wrap-value-as-reference-if-needed [markup-db value]
|
||||
(if (or (directly-printable? value) (markup? value))
|
||||
value
|
||||
(build-markup markup-db :reference-surrogate value)))
|
||||
|
||||
; -- TemplateWriter ---------------------------------------------------------------------------------------------------------
|
||||
|
||||
(deftype TemplateWriter [^:mutable group markup-db]
|
||||
Object
|
||||
(merge [_ a] (set! group (concat group a)))
|
||||
(get-group [_] group)
|
||||
IWriter
|
||||
(-write [_ o] (set! group (concat group [(wrap-value-as-reference-if-needed markup-db o)]))) ; issue #21
|
||||
(-flush [_] nil))
|
||||
|
||||
(defn make-template-writer [markup-db]
|
||||
(TemplateWriter. [] markup-db))
|
||||
|
||||
; -- post-processing --------------------------------------------------------------------------------------------------------
|
||||
|
||||
(defn already-reference? [group]
|
||||
(if-let [tag (first (first group))]
|
||||
(= tag "reference")))
|
||||
|
||||
(defn wrap-group-in-reference-if-needed [group obj markup-db]
|
||||
(if (and (not (already-reference? group))
|
||||
(or (expandable? obj) (abbreviated? group)))
|
||||
(let [expandable-markup (apply build-markup markup-db :expandable group)
|
||||
surrogate-markup (build-markup markup-db :raw-surrogate obj expandable-markup :target)
|
||||
reference-markup (build-markup markup-db :reference surrogate-markup)]
|
||||
[reference-markup])
|
||||
group))
|
||||
|
||||
(defn wrap-group-in-circular-warning-if-needed [group markup-db circular?]
|
||||
(if circular?
|
||||
[(apply build-markup markup-db :circular-reference group)]
|
||||
group))
|
||||
|
||||
(defn wrap-group-in-meta-if-needed [group value markup-db]
|
||||
(if (should-render? :render-metas value #(some? (meta %)))
|
||||
[(apply (partial (:meta-wrapper markup-db) (meta value)) group)]
|
||||
group))
|
||||
|
||||
; default printer implementation can do this:
|
||||
; :else (write-all writer "#<" (str obj) ">")
|
||||
; we want to wrap stringified obj in a reference for further inspection
|
||||
;
|
||||
; this behaviour changed in https://github.com/clojure/clojurescript/commit/34c3b8985ed8197d90f441c46d168c4024a20eb8
|
||||
; newly functions and :else branch print "#object [" ... "]"
|
||||
;
|
||||
; in some situations obj can still be a clojurescript value (e.g. deftypes)
|
||||
; we have to implement a special flag to prevent infinite recursion
|
||||
; see https://github.com/binaryage/cljs-devtools/issues/2
|
||||
; https://github.com/binaryage/cljs-devtools/issues/8
|
||||
(defn detect-edge-case-and-patch-it [group obj markup-db]
|
||||
(cond
|
||||
(or
|
||||
(and (= (count group) 5) (= (nth group 0) "#object[") (= (nth group 4) "\"]")) ; function case
|
||||
(and (= (count group) 5) (= (nth group 0) "#object[") (= (nth group 4) "]")) ; :else -constructor case
|
||||
(and (= (count group) 3) (= (nth group 0) "#object[") (= (nth group 2) "]"))) ; :else -cljs$lang$ctorStr case
|
||||
[(build-markup markup-db :native-reference obj)]
|
||||
|
||||
(and (= (count group) 3) (= (nth group 0) "#<") (= (str obj) (nth group 1)) (= (nth group 2) ">")) ; old code prior r1.7.28
|
||||
[(nth group 0) (build-markup :native-reference obj) (nth group 2)]
|
||||
|
||||
:else group))
|
||||
|
||||
(defn post-process-printed-output [output-group obj markup-db circular?]
|
||||
(-> output-group
|
||||
(detect-edge-case-and-patch-it obj markup-db) ; an ugly hack
|
||||
(wrap-group-in-reference-if-needed obj markup-db)
|
||||
(wrap-group-in-circular-warning-if-needed markup-db circular?)
|
||||
(wrap-group-in-meta-if-needed obj markup-db)))
|
||||
|
||||
; -- alternative printer ----------------------------------------------------------------------------------------------------
|
||||
|
||||
(defn alt-printer-job [obj writer opts]
|
||||
(let [{:keys [markup-db]} opts]
|
||||
(if (or (safe-call satisfies? false IDevtoolsFormat obj)
|
||||
(safe-call satisfies? false IFormat obj)) ; we have to wrap value in reference if detected IFormat
|
||||
(-write writer (build-markup markup-db :reference obj))
|
||||
(if-let [atomic-markup (build-markup markup-db :atomic obj)]
|
||||
(-write writer atomic-markup)
|
||||
(let [default-impl (:fallback-impl opts)
|
||||
; we want to limit print-level, at max-print-level level use maximal abbreviation e.g. [...] or {...}
|
||||
inner-opts (if (= *print-level* 1) (assoc opts :print-length 0) opts)]
|
||||
(default-impl obj writer inner-opts))))))
|
||||
|
||||
(defn alt-printer-impl [obj writer opts]
|
||||
(binding [*current-state* (get-current-state)]
|
||||
(let [{:keys [markup-db]} opts
|
||||
circular? (is-circular? obj)
|
||||
inner-writer (make-template-writer (:markup-db opts))]
|
||||
(push-object-to-current-history! obj)
|
||||
(alt-printer-job obj inner-writer opts)
|
||||
(.merge writer (post-process-printed-output (.get-group inner-writer) obj markup-db circular?)))))
|
||||
|
||||
; -- common code for managed printing ---------------------------------------------------------------------------------------
|
||||
|
||||
(defn managed-print [tag markup-db printer]
|
||||
(let [writer (make-template-writer markup-db)
|
||||
opts {:alt-impl alt-printer-impl
|
||||
:markup-db markup-db
|
||||
:print-length (pref :max-header-elements)
|
||||
: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 ----------------------------------------------------------------------------------------------------
|
||||
|
||||
(defn managed-print-via-writer [value tag markup-db]
|
||||
(managed-print tag markup-db (fn [writer opts]
|
||||
(pr-seq-writer [value] writer opts)))) ; note we use pr-seq-writer becasue pr-writer is private for some reason
|
||||
|
||||
(defn managed-print-via-protocol [value tag markup-db]
|
||||
(managed-print tag markup-db (fn [writer opts]
|
||||
(-pr-writer value writer opts))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue