From a0f1dcfcb801b21efcf2e636af25f9955d5c822b Mon Sep 17 00:00:00 2001 From: r0man Date: Fri, 18 Apr 2025 09:13:17 +0200 Subject: [PATCH 1/2] Pretty view mode (#335) * Add pretty printer * Add pretty printer tests * Add :pretty view mode --- CHANGELOG.md | 2 + src/orchard/inspect.clj | 127 ++++++-- src/orchard/pp.clj | 572 ++++++++++++++++++++++++++++++++++ src/orchard/print.clj | 15 +- test/orchard/inspect_test.clj | 160 ++++++++++ test/orchard/pp_test.clj | 244 +++++++++++++++ test/orchard/print_test.clj | 57 ++++ 7 files changed, 1143 insertions(+), 34 deletions(-) create mode 100644 src/orchard/pp.clj create mode 100644 test/orchard/pp_test.clj diff --git a/CHANGELOG.md b/CHANGELOG.md index 77dcf0d7..03f35a01 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ ## master (unreleased) +* [#335](https://github.com/clojure-emacs/orchard/pull/335) Add `orchard.pp` and pretty view mode. + ## 0.33.0 (2025-04-08) * [#333](https://github.com/clojure-emacs/orchard/pull/333): Add `orchard.profile`. diff --git a/src/orchard/inspect.clj b/src/orchard/inspect.clj index 388012b8..1a58fd24 100644 --- a/src/orchard/inspect.clj +++ b/src/orchard/inspect.clj @@ -44,13 +44,22 @@ :max-coll-size 5 :max-nested-depth nil :display-analytics-hint nil - :analytics-size-cutoff 100000}) + :analytics-size-cutoff 100000 + :pretty-print false}) (defn- reset-render-state [inspector] (-> inspector (assoc :counter 0, :index [], :indentation 0, :rendered []) (dissoc :chunk :start-idx :last-page))) +(defn- print-string + "Print or pretty print the string `value`, depending on the view mode + of the inspector." + [{:keys [indentation pretty-print]} value] + (if pretty-print + (print/pprint-str value {:indentation (or indentation 0)}) + (print/print-str value))) + (defn- array? [obj] (some-> (class obj) .isArray)) @@ -211,7 +220,7 @@ (defn- validate-config [{:keys [page-size max-atom-length max-value-length max-coll-size max-nested-depth display-analytics-hint - analytics-size-cutoff] + analytics-size-cutoff pretty-print] :as config}] (when (some? page-size) (pre-ex (pos-int? page-size))) (when (some? max-atom-length) (pre-ex (pos-int? max-atom-length))) @@ -220,6 +229,7 @@ (when (some? max-nested-depth) (pre-ex (pos-int? max-nested-depth))) (when (some? display-analytics-hint) (pre-ex (= display-analytics-hint "true"))) (when (some? analytics-size-cutoff) (pre-ex (pos-int? analytics-size-cutoff))) + (when (some? pretty-print) (pre-ex (contains? #{true false} pretty-print))) (select-keys config (keys default-inspector-config))) (defn refresh @@ -294,11 +304,15 @@ (render-onto values) (render '(:newline)))) -(defn- indent [inspector] - (update inspector :indentation + 2)) +(defn- indent + "Increment the `:indentation` of `inspector` by `n` or 2." + [inspector & [n]] + (update inspector :indentation + (or n 2))) -(defn- unindent [inspector] - (update inspector :indentation - 2)) +(defn- unindent + "Decrement the `:indentation` of `inspector` by `n` or 2." + [inspector & [n]] + (indent inspector (- (or n 2)))) (defn- padding [{:keys [indentation]}] (when (and (number? indentation) (pos? indentation)) @@ -325,7 +339,7 @@ ([inspector value] (render-value inspector value nil)) ([inspector value {:keys [value-role value-key display-value]}] (let [{:keys [counter]} inspector - display-value (or display-value (print/print-str value)) + display-value (or display-value (print-string inspector value)) expr (list :value display-value counter)] (-> inspector (update :index conj {:value value @@ -340,11 +354,15 @@ (render-value value value-opts) (render-ln))) -(defn render-labeled-value [inspector label value & [value-opts]] - (-> inspector - (render-indent (str label ": ")) - (render-value value value-opts) - (render-ln))) +(defn render-labeled-value [{:keys [pretty-print] :as inspector} label value & [value-opts]] + (let [formatted-label (str label ": ") + indentation (if pretty-print (count formatted-label) 0)] + (-> inspector + (render-indent formatted-label) + (indent indentation) + (render-value value value-opts) + (unindent indentation) + (render-ln)))) (defn- render-class-name [inspector obj] (render-labeled-value inspector "Class" (class obj))) @@ -356,18 +374,52 @@ (render-ln)) inspector)) +(defn- long-map-key? + "Returns true of `s` is a long string, more than 20 character or + containing newlines." + [^String s] + (or (.contains s "\n") (> (count s) 20))) + +(defn- render-map-separator + "Render the map separator according to `rendered-key`. If + `rendered-key` is long or contains newlines the key and value will + be rendered on separate lines." + [{:keys [pretty-print] :as inspector} long-key?] + (if (and pretty-print long-key?) + (-> (render-ln inspector) + (render-indent "=") + (render-ln)) + (render inspector " = "))) + +(defn- render-map-value + "Render a map value. If `mark-values?` is true, attach the keys to the + values in the index." + [{:keys [pretty-print] :as inspector} key val mark-values? rendered-key long-key?] + (if pretty-print + (let [indentation (if long-key? 0 (+ 3 (count rendered-key)))] + (-> (indent inspector indentation) + (render (if (zero? indentation) " " "")) + (render-value val + (when mark-values? + {:value-role :map-value, :value-key key})) + (unindent indentation) + ((if (long-map-key? rendered-key) render-ln identity)))) + (render-value inspector val + (when mark-values? + {:value-role :map-value, :value-key key})))) + (defn- render-map-values "Render associative key-value pairs. If `mark-values?` is true, attach the keys to the values in the index." [inspector mappable mark-values?] (reduce (fn [ins [key val]] - (-> ins - (render-indent) - (render-value key) - (render " = ") - (render-value val (when mark-values? - {:value-role :map-value, :value-key key})) - (render-ln))) + (let [rendered-key (print-string ins key) + long-key? (long-map-key? rendered-key)] + (-> (render-indent ins) + (render-value key {:display-value rendered-key}) + (render-map-separator long-key?) + (render-map-value key val mark-values? rendered-key long-key?) + (render-ln)))) inspector mappable)) @@ -426,20 +478,24 @@ "Render an indexed chunk of values. Renders all values in `chunk`, so `chunk` must be finite. If `mark-values?` is true, attach the indices to the values in the index." - [inspector chunk idx-starts-from mark-values?] + [{:keys [pretty-print] :as inspector} chunk idx-starts-from mark-values?] (let [n (count chunk) last-idx (+ idx-starts-from n -1) last-idx-len (count (str last-idx)) idx-fmt (str "%" last-idx-len "s")] (loop [ins inspector, chunk (seq chunk), idx idx-starts-from] (if chunk - (recur (-> ins - (render-indent (format idx-fmt idx) ". ") - (render-value (first chunk) - (when mark-values? - {:value-role :seq-item, :value-key idx})) - (render-ln)) - (next chunk) (inc idx)) + (let [header (str (format idx-fmt idx) ". ") + indentation (if pretty-print (count header) 0)] + (recur (-> ins + (render-indent header) + (indent indentation) + (render-value (first chunk) + (when mark-values? + {:value-role :seq-item, :value-key idx})) + (unindent indentation) + (render-ln)) + (next chunk) (inc idx))) ins)))) (declare known-types) @@ -656,7 +712,7 @@ (defmethod inspect :string [inspector ^java.lang.String obj] (-> (render-class-name inspector obj) - (render "Value: " (print/print-str obj)) + (render "Value: " (print-string inspector obj)) (render-ln) (render-section-header "Print") (indent) @@ -714,9 +770,7 @@ (shorten-member-string (str obj) (.getDeclaringClass ^Method obj)) (instance? Field obj) - (shorten-member-string (str obj) (.getDeclaringClass ^Field obj)) - - :else (print/print-str obj))] + (shorten-member-string (str obj) (.getDeclaringClass ^Field obj)))] (letfn [(render-fields [inspector section-name field-values] (if (seq field-values) (-> inspector @@ -924,12 +978,19 @@ (unindent))))) (defn inspect-render - ([{:keys [max-atom-length max-value-length max-coll-size max-nested-depth value] + ([{:keys [max-atom-length max-value-length max-coll-size max-nested-depth value pretty-print] :as inspector}] (binding [print/*max-atom-length* max-atom-length print/*max-total-length* max-value-length *print-length* max-coll-size - *print-level* max-nested-depth] + *print-level* (cond-> max-nested-depth + ;; In pretty mode a higher *print-level* + ;; leads to better results, otherwise we + ;; render a ton of # characters when + ;; there is still enough screen estate + ;; in most cases. + (and pretty-print (number? max-nested-depth)) + (* 2))] (-> inspector (reset-render-state) (decide-if-paginated) diff --git a/src/orchard/pp.clj b/src/orchard/pp.clj new file mode 100644 index 00000000..8d9db4f3 --- /dev/null +++ b/src/orchard/pp.clj @@ -0,0 +1,572 @@ +(ns orchard.pp + "A pretty-printer for Clojure data structures. + + Based on the algorithm described in \"Pretty-Printing, Converting List + to Linear Structure\" by Ira Goldstein (Artificial Intelligence, Memo + No. 279 in Massachusetts Institute of Technology A.I. Laboratory, + February 1973)." + {:author "Eero Helenius" + :license "MIT" + :git/url "https://github.com/eerohele/pp.git"}) + +(defn ^:private strip-ns + "Given a (presumably qualified) ident, return an unqualified version + of the ident." + [x] + (cond + (keyword? x) (keyword nil (name x)) + (symbol? x) (symbol nil (name x)))) + +(defn ^:private extract-map-ns + "Given a map, iff the keys in the map are qualified idents that share + a namespace, return a tuple where the first item is the namespace + name (a string) and the second item is a copy of the original map + but with unqualified idents." + [m] + (when (seq m) + (loop [m m ns nil nm {}] + (if-some [[k v] (first m)] + (when (qualified-ident? k) + (let [k-ns (namespace k)] + (when (or (nil? ns) (= ns k-ns)) + (recur (rest m) k-ns (assoc nm (strip-ns k) v))))) + [ns nm])))) + +(defmacro ^:private array? + [x] + `(some-> ~x class .isArray)) + +(defn ^:private open-delim + "Return the opening delimiter (a string) of coll." + ^String [coll] + (cond + (map? coll) "{" + (vector? coll) "[" + (set? coll) "#{" + (array? coll) "[" + :else "(")) + +(defn ^:private close-delim + "Return the closing delimiter (a string) of coll." + ^String [coll] + (cond + (map? coll) "}" + (vector? coll) "]" + (set? coll) "}" + (array? coll) "]" + :else ")")) + +(defprotocol ^:private CountKeepingWriter + (^:private write [this s] + "Write a string into the underlying java.io.Writer while keeping + count of the length of the strings written into the writer.") + + (^:private remaining [this] + "Return the number of characters available on the current line.") + + (^:private nl [this] + "Write a newline into the underlying java.io.Writer. + + Resets the number of characters allotted to the current line to + zero.")) + +(defn ^:private write-into + "Given a writer (java.io.Writer or cljs.core.IWriter) and a string, + write the string into the writer." + [writer s] + (.write ^java.io.Writer writer ^String s)) + +(defn ^:private strlen + "Given a string, return the length of the string. + + Since java.lang.String isn't counted?, (.length s) is faster than (count s)." + ^long [s] + (.length ^String s)) + +(defn ^:private count-keeping-writer + "Given a java.io.Writer and an options map, wrap the java.io.Writer + such that it becomes a CountKeepingWriter: a writer that keeps count + of the length of the strings written into each line. + + Options: + + :max-width (long) + Maximum line width." + [writer opts] + (let [max-width (:max-width opts) + c (volatile! 0)] + (reify CountKeepingWriter + (write [_ s] + (write-into writer ^String s) + (vswap! c (fn [^long n] (unchecked-add-int n (strlen ^String s)))) + nil) + (remaining [_] + (unchecked-subtract-int max-width @c)) + (nl [_] + (write-into writer "\n") + (vreset! c 0) + nil)))) + +(def ^:private reader-macros + {'quote "'" + 'var "#'" + 'clojure.core/deref "@", + 'clojure.core/unquote "~"}) + +(defn ^:private record-name + [record] + (-> record class .getName)) + +(defn ^:private open-delim+form + "Given a coll, return a tuple where the first item is the coll's + opening delimiter and the second item is the coll. + + If *print-namespace-maps* is true, the coll is a map, and the map is + amenable to the map namespace syntax, the open delimiter includes + the map namespace prefix and the map keys are unqualified. + + If the coll is a record, the open delimiter includes the record name + prefix." + [coll] + (if (record? coll) + [(str "#" (record-name coll) "{") coll] + ;; If all keys in the map share a namespace and *print- + ;; namespace-maps* is true, print the map using map namespace + ;; syntax (e.g. #:a{:b 1} instead of {:a/b 1}). If the map is + ;; a record, print the map using the record syntax (e.g. + ;; #user.R{:x 1}). + (let [[ns ns-map] + (when (and *print-namespace-maps* (map? coll)) + (extract-map-ns coll)) + + coll (if ns ns-map coll) + + o (if ns (str "#:" ns "{") (open-delim coll))] + [o coll]))) + +(defn ^:private meets-print-level? + "Given a level (a long), return true if the level is the same as + *print-level*." + [level] + (and (int? *print-level*) (= level *print-level*))) + +(defprotocol ^:private Printable + (^:private -print [this writer opts] + "Given an object, a java.io.Writer, and an options map, write a + string representation of the object into the writer in linear style + (without regard to line length). + + Options: + + :level (long, default: 0) + The current nesting level.")) + +(defn ^:private -print-map-entry + "Print a map entry within a map." + [this writer opts] + (if (meets-print-level? (:level opts)) + (write-into writer "#") + (let [opts (update opts :level inc)] + (-print (key this) writer opts) + (write-into writer " ") + (-print (val this) writer opts)))) + +(defn ^:private -print-map + "Like -print, but only for maps." + [coll writer opts] + (if (meets-print-level? (:level opts 0)) + (write-into writer "#") + + (let [[^String o form] (open-delim+form coll)] + (write-into writer o) + + (when (seq form) + (loop [form form index 0] + (if (= index *print-length*) + (write-into writer "...") + (let [f (first form) + n (next form)] + (-print-map-entry f writer (update opts :level inc)) + (when-not (empty? n) + (write-into writer ^String (:map-entry-separator opts)) + (write-into writer " ") + (recur n (inc index))))))) + + (write-into writer (close-delim form))))) + +(defn ^:private -print-coll + "Like -print, but only for lists, vectors, and sets." + [coll writer opts] + (if (meets-print-level? (:level opts 0)) + (write-into writer "#") + + (let [[^String o form] (open-delim+form coll)] + (write-into writer o) + + (when (seq form) + (loop [form form index 0] + (if (= index *print-length*) + (write-into writer "...") + (let [f (first form) + n (next form)] + (-print f writer (update opts :level inc)) + (when-not (empty? n) + (write-into writer " ") + (recur n (inc index))))))) + + (write-into writer (close-delim form))))) + +(defn ^:private -print-seq + [this writer opts] + (if-some [reader-macro (reader-macros (first this))] + (do + (write-into writer ^String reader-macro) + (write-into writer (pr-str (second this)))) + (-print-coll this writer opts))) + +(extend-protocol Printable + nil + (-print [_ writer _] + (write-into writer "nil")) + + clojure.lang.AMapEntry + (-print [this writer opts] + (-print-coll this writer opts)) + + clojure.lang.ISeq + (-print [this writer opts] + (-print-seq this writer opts)) + + clojure.lang.IPersistentMap + (-print [this writer opts] + (-print-map this writer opts)) + + clojure.lang.IPersistentVector + (-print [this writer opts] + (-print-coll this writer opts)) + + clojure.lang.IPersistentSet + (-print [this writer opts] + (-print-coll this writer opts)) + + Object + (-print [this writer opts] + (if (array? this) + (-print-seq this writer opts) + (print-method this writer)))) + +(defn ^:private with-str-writer + "Given a function, create a java.io.StringWriter (Clojure) or a + goog.string.StringBuffer (ClojureScript), pass it to the function, and + return the string value in the writer/buffer." + [f] + (with-open [writer (java.io.StringWriter.)] + (f writer) + (str writer))) + +(defn ^:private print-linear + "Print a form in linear style (without regard to line length). + + Given one arg (a form), print the form into a string using the + default options. + + Given two args (a form and an options map), print the form into a + string using the given options. + + Given three args (a java.io.Writer, a form, and an options map), print + the form into the writer using the given options. + + Options: + + :level (long) + The current nesting level." + ([form] + (print-linear form nil)) + (^String [form opts] + (with-str-writer (fn [writer] (print-linear writer form opts)))) + ([writer form opts] + (-print form writer opts))) + +(defn ^:private print-mode + "Given a CountKeepingWriter, a form, and an options map, return a keyword + indicating a printing mode (:linear or :miser)." + [writer form opts] + (let [reserve-chars (:reserve-chars opts) + s (print-linear form opts)] + ;; If, after (possibly) reserving space for any closing delimiters of + ;; ancestor S-expressions, there's enough space to print the entire + ;; form in linear style on this line, do so. + ;; + ;; Otherwise, print the form in miser style. + (if (<= (strlen s) (unchecked-subtract-int (remaining writer) reserve-chars)) + :linear + :miser))) + +(defn ^:private write-sep + "Given a CountKeepingWriter and a printing mode, print a separator (a + space or a newline) into the writer." + [writer mode] + (case mode + :miser (nl writer) + (write writer " "))) + +(defprotocol ^:private PrettyPrintable + (^:private -pprint [this writer opts] + "Given a form, a CountKeepingWriter, and an options map, + pretty-print the form into the writer. + + Options: + + :level (long) + The current nesting level. For example, in [[:a 1]], the outer + vector is nested at level 0, and the inner vector is nested at + level 1. + + :indentation (String) + A string (of spaces) to use for indentation. + + :reserve-chars (long) + The number of characters reserved for closing delimiters of + S-expressions above the current nesting level.")) + +(defn ^:private pprint-meta + [form writer opts mode] + (when (and *print-meta* *print-readably*) + (when-some [m (meta form)] + (when (seq m) + (write writer "^") + ;; As per https://github.com/clojure/clojure/blob/6975553804b0f8da9e196e6fb97838ea4e153564/src/clj/clojure/core_print.clj#L78-L80 + (let [m (if (and (= (count m) 1) (:tag m)) (:tag m) m)] + (-pprint m writer opts)) + (write-sep writer mode))))) + +(defn ^:private pprint-opts + [open-delim opts] + (let [;; The indentation level is the indentation level of the + ;; parent S-expression plus a number of spaces equal to the + ;; length of the open delimiter (e.g. one for "(", two for + ;; "#{"). + padding (apply str (repeat (strlen open-delim) " ")) + indentation (str (:indentation opts) padding)] + (-> opts (assoc :indentation indentation) (update :level inc)))) + +(defn ^:private -pprint-coll + "Like -pprint, but only for lists, vectors and sets." + [this writer opts] + (if (meets-print-level? (:level opts)) + (write writer "#") + (let [[^String o form] (open-delim+form this) + mode (print-mode writer this opts) + opts (pprint-opts o opts)] + + ;; Print possible meta + (pprint-meta form writer opts mode) + + ;; Print open delimiter + (write writer o) + + ;; Print S-expression content + (if (= *print-length* 0) + (write writer "...") + (when (seq form) + (loop [form form index 0] + (if (= index *print-length*) + (do + (when (= mode :miser) (write writer (:indentation opts))) + (write writer "...")) + + (do + ;; In miser mode, prepend indentation to every form + ;; except the first one. We don't want to prepend + ;; indentation for the first form, because it + ;; immediately follows the open delimiter. + (when (and (= mode :miser) (pos? index)) + (write writer (:indentation opts))) + + (let [f (first form) + n (next form)] + (if (empty? n) + ;; This is the last child, so reserve an additional + ;; slot for the closing delimiter of the parent + ;; S-expression. + (-pprint f writer (update opts :reserve-chars inc)) + (do + (-pprint f writer (assoc opts :reserve-chars 0)) + (write-sep writer mode) + (recur n (inc index)))))))))) + + ;; Print close delimiter + (write writer (close-delim form))))) + +(defn ^:private -pprint-map-entry + "Pretty-print a map entry within a map." + [this writer opts] + (if (meets-print-level? (:level opts)) + (write writer "#") + (let [k (key this) + opts (update opts :level inc)] + (-pprint k writer opts) + + (let [v (val this) + ;; If, after writing the map entry key, there's enough space to + ;; write the val on the same line, do so. Otherwise, write + ;; indentation followed by val on the following line. + mode (print-mode writer v (update opts :reserve-chars inc))] + (write-sep writer mode) + (when (= :miser mode) (write writer (:indentation opts))) + (-pprint v writer opts))))) + +(defn ^:private -pprint-map + "Like -pprint, but only for maps." + [this writer opts] + (if (meets-print-level? (:level opts)) + (write writer "#") + (let [[^String o form] (open-delim+form this) + mode (print-mode writer this opts) + opts (pprint-opts o opts)] + (pprint-meta form writer opts mode) + (write writer o) + (if (= *print-length* 0) + (write writer "...") + (when (seq form) + (loop [form form index 0] + (if (= index *print-length*) + (do + (when (= mode :miser) (write writer (:indentation opts))) + (write writer "...")) + + (do + (when (and (= mode :miser) (pos? index)) + (write writer (:indentation opts))) + + (let [f (first form) + n (next form)] + (if (empty? n) + (-pprint-map-entry f writer (update opts :reserve-chars inc)) + (let [^String map-entry-separator (:map-entry-separator opts)] + ;; Reserve a slot for the map entry separator. + (-pprint-map-entry f writer (assoc opts :reserve-chars (strlen map-entry-separator))) + (write writer map-entry-separator) + (write-sep writer mode) + (recur n (inc index)))))))))) + + (write writer (close-delim form))))) + +(defn ^:private -pprint-seq + [this writer opts] + (if-some [reader-macro (reader-macros (first this))] + (if (meets-print-level? (:level opts)) + (write writer "#") + (do + (write writer reader-macro) + (-pprint (second this) writer + (update opts :indentation + (fn [indentation] (str indentation " ")))))) + (-pprint-coll this writer opts))) + +(defn ^:private -pprint-queue + [this writer opts] + (write writer "<-") + (-pprint-coll + (or (seq this) '()) writer + (update opts :indentation #(str " " %))) + (write writer "-<")) + +(extend-protocol PrettyPrintable + nil + (-pprint [_ writer _] + (write writer "nil")) + + clojure.lang.AMapEntry + (-pprint [this writer opts] + (-pprint-coll this writer opts)) + + clojure.lang.ISeq + (-pprint [this writer opts] + (-pprint-seq this writer opts)) + + clojure.lang.IPersistentMap + (-pprint [this writer opts] + (-pprint-map this writer opts)) + + clojure.lang.IPersistentVector + (-pprint [this writer opts] + (-pprint-coll this writer opts)) + + clojure.lang.IPersistentSet + (-pprint [this writer opts] + (-pprint-coll this writer opts)) + + clojure.lang.PersistentQueue + (-pprint [this writer opts] + (-pprint-queue this writer opts)) + + Object + (-pprint [this writer opts] + (if (array? this) + (-pprint-seq this writer opts) + (write writer (print-linear this opts))))) + +(defn pprint + "Pretty-print an object. + + Given one arg (an object), pretty-print the object into *out* using + the default options. + + Given two args (an object and an options map), pretty-print the object + into *out* using the given options. + + Given three args (a java.io.Writer, a object, and an options map), + pretty-print the object into the writer using the given options. + + If *print-dup* is true, pprint does not attempt to pretty-print; + instead, it falls back to default print-dup behavior. ClojureScript + does not support *print-dup*. + + Options: + + :max-width (long or ##Inf, default: 72) + Avoid printing anything beyond the column indicated by this + value. + + :map-entry-separator (string, default: \",\") + The string to print between map entries. To not print commas + between map entries, use an empty string." + ([x] + (pprint *out* x nil)) + ([x opts] + (pprint *out* x opts)) + ([writer x {:keys [indentation max-width map-entry-separator] + :or {indentation "", max-width 72, map-entry-separator ","} + :as opts}] + (assert (or (nat-int? max-width) (= max-width ##Inf)) + ":max-width must be a natural int or ##Inf") + + (letfn + [(pp [writer] + ;; Allowing ##Inf was a mistake, because it's a double. + ;; + ;; If the user passes ##Inf, convert it to Integer/MAX_VALUE, which is + ;; functionally the same in this case. + (let [max-width (case max-width + ##Inf Integer/MAX_VALUE + max-width) + writer (count-keeping-writer writer {:max-width max-width})] + (-pprint x writer + (assoc opts + :map-entry-separator map-entry-separator + :level 0 + :indentation indentation + :reserve-chars 0)) + (nl writer)))] + (do + (assert (instance? java.io.Writer writer) + "first arg to pprint must be a java.io.Writer") + + (if *print-dup* + (do + (print-dup x writer) + (.write ^java.io.Writer writer "\n")) + (pp writer)) + + (when *flush-on-newline* (.flush ^java.io.Writer writer)))))) diff --git a/src/orchard/print.clj b/src/orchard/print.clj index 2dd56f81..11fb0394 100644 --- a/src/orchard/print.clj +++ b/src/orchard/print.clj @@ -15,7 +15,9 @@ Var) (java.util List Map Map$Entry) (mx.cider.orchard TruncatingStringWriter - TruncatingStringWriter$TotalLimitExceeded))) + TruncatingStringWriter$TotalLimitExceeded)) + (:require [clojure.string :as str] + [orchard.pp :as pp])) (defmulti print (fn [x _] @@ -190,3 +192,14 @@ (try (print x writer) (catch TruncatingStringWriter$TotalLimitExceeded _)) (.toString writer))) + +(defn pprint-str + "Pretty print the object `x` with `orchard.pp/pprint` and return it as + a string. The `:indentation` option is the number of spaces used for + indentation." + [x & [{:keys [indentation]}]] + (let [writer (TruncatingStringWriter. *max-atom-length* *max-total-length*) + indentation-str (apply str (repeat (or indentation 0) " "))] + (try (pp/pprint writer x {:indentation indentation-str}) + (catch TruncatingStringWriter$TotalLimitExceeded _)) + (str/trimr (.toString writer)))) diff --git a/test/orchard/inspect_test.clj b/test/orchard/inspect_test.clj index ea061550..d1a81d9a 100644 --- a/test/orchard/inspect_test.clj +++ b/test/orchard/inspect_test.clj @@ -77,6 +77,12 @@ (take-while #(not (and (string? %) (re-matches #".*---.*" %))) rendered)) +(defn- labeled-value [label rendered] + (let [formatted-label (str label ": ")] + (->> rendered + (drop-while #(not (= formatted-label %))) + (take 2)))) + (defn- page-size-info [rendered] (let [s (last (butlast rendered))] (when (and (string? s) (re-find #"Page size:" s)) @@ -97,6 +103,9 @@ (defn set-page-size [inspector new-size] (inspect/refresh inspector {:page-size new-size})) +(defn set-pretty-print [inspector pretty-print] + (inspect/refresh inspector {:pretty-print pretty-print})) + (deftest nil-test (testing "nil renders correctly" (is+ nil-result @@ -1559,6 +1568,157 @@ [:newline]] (section "Contents" rendered))))) +(deftest pretty-print-map-test + (testing "in :pretty view-mode are pretty printed" + (let [rendered (-> {:a 0 + :bb "000" + :ccc [] + :d [{:a 0 :bb "000" :ccc [[]]} + {:a -1 :bb "111" :ccc [1]} + {:a 2 :bb "222" :ccc [1 2]}]} + (inspect/start) + (set-pretty-print true) + render)] + (is+ ["--- Contents:" [:newline] " " + [:value ":a" 1] " = " [:value "0" 2] + [:newline] " " + [:value ":bb" 3] " = " [:value "\"000\"" 4] + [:newline] " " + [:value ":ccc" 5] " = " [:value "[]" 6] + [:newline] " " + [:value ":d" 7] " = " + [:value (str "[{:a 0, :bb \"000\", :ccc [[]]}\n" + " {:a -1, :bb \"111\", :ccc [1]}\n" + " {:a 2, :bb \"222\", :ccc [1 2]}]") 8] + [:newline]] + (section "Contents" rendered)) + (is (nil? (section "View mode" rendered)))))) + +(deftest pretty-print-map-in-object-view-test + (testing "in :pretty view-mode are pretty printed" + (let [rendered (-> {:a 0 + :bb "000" + :ccc [] + :d [{:a 0 :bb "000" :ccc [[]]} + {:a -1 :bb "111" :ccc [1]} + {:a 2 :bb "222" :ccc [1 2]}]} + (inspect/start) + (inspect/set-view-mode :object) + (set-pretty-print true) + render)] + (is+ ["Value: " + [:value (str "{:a 0,\n" + " :bb \"000\",\n" + " :ccc [],\n" + " :d\n" + " [{:a 0, :bb \"000\", :ccc [[]]}\n" + " {:a -1, :bb \"111\", :ccc [1]}\n" + " {:a 2, :bb \"222\", :ccc [1 2]}]}") 1]] + (labeled-value "Value" rendered)) + (is+ ["--- View mode:" [:newline] " :object"] + (section "View mode" rendered))))) + +(deftest pretty-print-seq-of-maps-test + (testing "in :pretty view-mode maps seqs of maps are pretty printed" + (let [rendered (-> (for [i (range 2)] + {:a (- i) + :bb (str i i i) + :ccc (range i 0 -1) + :d (for [i (range 5)] + {:a (- i) + :bb (str i i i) + :ccc (range i 0 -1)})}) + (inspect/start) + (set-pretty-print true) + render)] + (is+ ["--- Contents:" [:newline] + " 0. " + [:value (str "{:a 0,\n :bb \"000\",\n :ccc (),\n " + ":d\n ({:a 0, :bb \"000\", :ccc ()}\n " + "{:a -1, :bb \"111\", :ccc (1)}\n {:a -2, :bb " + "\"222\", :ccc (2 1)}\n {:a -3, :bb \"333\", " + ":ccc (3 2 1)}\n {:a -4, :bb \"444\", :ccc " + "(4 3 2 1)})}") 1] + [:newline] + " 1. " + [:value (str "{:a -1,\n :bb \"111\",\n :ccc (1),\n " + ":d\n ({:a 0, :bb \"000\", :ccc ()}\n " + "{:a -1, :bb \"111\", :ccc (1)}\n {:a -2, :bb " + "\"222\", :ccc (2 1)}\n {:a -3, :bb \"333\", " + ":ccc (3 2 1)}\n {:a -4, :bb \"444\", " + ":ccc (4 3 2 1)})}") 2] + [:newline]] + (section "Contents" rendered)) + (is (nil? (section "View mode" rendered)))))) + +(deftest pretty-print-map-as-key-test + (testing "in :pretty view-mode maps that contain maps as a keys are pretty printed" + (let [rendered (-> {{:a 0 + :bb "000" + :ccc [] + :d [{:a 0 :bb "000" :ccc []} + {:a -1 :bb "111" :ccc [1]} + {:a -2 :bb "222" :ccc [2 1]} + {:a -3 :bb "333" :ccc [3 2 1]} + {:a -4 :bb "444" :ccc [4 3 2 1]}]} + {:a -1 + :bb "111" + :ccc [1] + :d [{:a 0 :bb "000" :ccc []} + {:a -1 :bb "111" :ccc [1]} + {:a -2 :bb "222" :ccc [2 1]} + {:a -3 :bb "333" :ccc [3 2 1]} + {:a -4 :bb "444" :ccc [4 3 2 1]}]}} + (inspect/start) + (set-pretty-print true) + render)] + (is+ ["--- Contents:" [:newline] " " + [:value (str "{:a 0,\n :bb \"000\",\n :ccc [],\n :d\n " + "[{:a 0, :bb \"000\", :ccc []}\n {:a -1, " + ":bb \"111\", :ccc [1]}\n {:a -2, :bb \"222\", " + ":ccc [2 1]}\n {:a -3, :bb \"333\", :ccc [3 2 1]}" + "\n {:a -4, :bb \"444\", :ccc [4 3 2 1]}]}") 1] + [:newline] " =" [:newline] " " + [:value (str "{:a -1,\n :bb \"111\",\n :ccc [1],\n " + ":d\n [{:a 0, :bb \"000\", :ccc []}\n " + "{:a -1, :bb \"111\", :ccc [1]}\n {:a -2, " + ":bb \"222\", :ccc [2 1]}\n {:a -3, :bb " + "\"333\", :ccc [3 2 1]}\n {:a -4, :bb " + "\"444\", :ccc [4 3 2 1]}]}") 2] + [:newline] [:newline]] + (section "Contents" rendered)) + (is (nil? (section "View mode" rendered)))))) + +(deftest pretty-print-seq-of-map-as-key-test + (testing "in :pretty view-mode maps that contain seq of maps as a keys are pretty printed" + (let [rendered (-> {[{:a 0 + :bb "000" + :ccc [] + :d [{:a 0 :bb "000" :ccc [[]]} + {:a -1 :bb "111" :ccc [1]} + {:a 2 :bb "222" :ccc [1 2]}]}] + {:a 0 + :bb "000" + :ccc [] + :d [{:a 0 :bb "000" :ccc [[]]} + {:a -1 :bb "111" :ccc [1]} + {:a 2 :bb "222" :ccc [1 2]}]}} + (inspect/start) + (set-pretty-print true) + render)] + (is+ ["--- Contents:" [:newline] " " + [:value (str "[{:a 0,\n :bb \"000\",\n :ccc [],\n :d\n " + "[{:a 0, :bb \"000\", :ccc [[]]}\n {:a -1, :bb \"111\", " + ":ccc [1]}\n {:a 2, :bb \"222\", :ccc [1 2]}]}]") 1] + [:newline] " =" [:newline] " " + [:value (str "{:a 0,\n :bb \"000\",\n :ccc [],\n :d\n " + "[{:a 0, :bb \"000\", :ccc [[]]}\n {:a -1, " + ":bb \"111\", :ccc [1]}\n {:a 2, :bb \"222\", " + ":ccc [1 2]}]}") 2] + [:newline] [:newline]] + (section "Contents" rendered)) + (is (nil? (section "View mode" rendered)))))) + (deftest tap-test (testing "tap-current-value" (let [proof (atom []) diff --git a/test/orchard/pp_test.clj b/test/orchard/pp_test.clj new file mode 100644 index 00000000..e232114c --- /dev/null +++ b/test/orchard/pp_test.clj @@ -0,0 +1,244 @@ +(ns orchard.pp-test + (:require [clojure.string :as str] + [clojure.test :refer [deftest is]] + [orchard.pp :as sut])) + +(defn ^:private q + [] + clojure.lang.PersistentQueue/EMPTY) + +(defn replace-crlf [s] + (str/replace s #"\r\n" "\n")) + +(defn pp + [x & {:keys [print-length print-level print-meta print-readably print-namespace-maps] + :or {print-length nil + print-level nil + print-meta false + print-readably true + print-namespace-maps false} + :as opts}] + (binding [*print-length* print-length + *print-level* print-level + *print-meta* print-meta + *print-readably* print-readably + *print-namespace-maps* print-namespace-maps] + (replace-crlf (with-out-str (sut/pprint x opts))))) + +(deftest pprint-test + (is (= "{}\n" (pp {}))) + (is (= "[nil nil]\n" (pp [nil nil]))) + (is (= "{:a 1}\n" (pp {:a 1}))) + (is (= "(1 nil)\n" (pp '(1 nil)))) + (is (= "{:a 1, :b 2, :c 3, :d 4}\n" (pp {:a 1 :b 2 :c 3 :d 4} :max-width 24))) + + (is (= "{:args\n [{:op :var,\n :assignable? true}]}\n" + (pp {:args [{:op :var :assignable? true}]} :max-width 24))) + + (is (= "{:a 1,\n :b 2,\n :c 3,\n :d 4,\n :e 5}\n" + (pp {:a 1 :b 2 :c 3 :d 4 :e 5} :max-width 24))) + + (is (= "{:a\n 1,\n :b\n 2,\n :c\n 3,\n :d\n 4}\n" + (pp {:a 1 :b 2 :c 3 :d 4} :max-width 0))) + + (is (= "{:a 1,\n :b 2,\n :c 3,\n :d 4,\n :e {:f 6}}\n" + (pp {:a 1 :b 2 :c 3 :d 4 :e {:f 6}} :max-width 24))) + + (is (= "{:a 1,\n :b 2,\n :c 3,\n :d 4,\n :e\n {:a 1,\n :b 2,\n :c 3,\n :d 4,\n :e\n {:f 6,\n :g 7,\n :h 8,\n :i 9,\n :j 10}}}\n" + (pp {:a 1 + :b 2 + :c 3 + :d 4 + :e {:a 1 :b 2 :c 3 :d 4 :e {:f 6 :g 7 :h 8 :i 9 :j 10}}} + :max-width 24))) + + ;; Queues + (is (= "<-()-<\n" (pp (q)))) + (is (= "<-(1)-<\n" (pp (conj (q) 1)))) + (is (= "<-(1\n 2\n 3)-<\n" (pp (conj (q) 1 2 3) :max-width 1))) + (is (= "<-(1 ...)-<\n" (pp (conj (q) 1 2 3) :print-length 1))) + (is (= "<-(1 2 3)-<\n" (pp (conj (q) 1 2 3) :print-level 1))) + (is (= "<-(1 ...)-<\n" (pp (conj (q) 1 2 3) :print-length 1 :print-level 1))) + (is (= "<-(1\n 2\n 3)-<\n" (pp (conj (q) 1 2 3) :max-width 6))) + + ;; Max width + (is (= "{:a\n 1,\n :b\n 2,\n :c\n 3,\n :d\n 4}\n" + (pp {:a 1 :b 2 :c 3 :d 4} :max-width 0))) + + ;; Meta + (is (= "^{:b 2} {:a 1}\n" + (pp (with-meta {:a 1} {:b 2}) :print-meta true))) + (is (= "^{:b\n 2}\n{:a\n 1}\n" + (pp (with-meta {:a 1} {:b 2}) :print-meta true :max-width 2))) + + ;; Print level + (is (= "#\n" (pp {} :print-level 0))) + (is (= "#\n" (pp {:a 1} :print-level 0))) + (is (= "{#}\n" (pp {:a {:b 2}} :print-level 1))) + (is (= "{:a #}\n" (pp {:a {:b 2}} :print-level 2))) + (is (= "{:a {#}}\n" (pp {:a {:b 2}} :print-level 3))) + (is (= "{#}\n" (pp {{:a 1} :b} :print-level 1))) + (is (= "{# :b}\n" (pp {{:a 1} :b} :print-level 2))) + (is (= "{{#} :b}\n" (pp {{:a 1} :b} :print-level 3))) + (is (= "#\n" (pp '(:a (:b (:c (:d)))) :print-level 0))) + (is (= "(:a #)\n" (pp '(:a (:b (:c (:d)))) :print-level 1))) + (is (= "(:a (:b #))\n" (pp '(:a (:b (:c (:d)))) :print-level 2))) + (is (= "(:a (:b (:c #)))\n" (pp '(:a (:b (:c (:d)))) :print-level 3))) + (is (= "(:a (:b (:c (:d))))\n" (pp '(:a (:b (:c (:d)))) :print-level 4))) + (is (= "(:a (:b (:c (:d))))\n" (pp '(:a (:b (:c (:d)))) :print-level 5))) + + ;; Print length + (is (= "(...)\n" (pp '() :print-length 0))) + (is (= "[...]\n" (pp [] :print-length 0))) + (is (= "#{...}\n" (pp #{} :print-length 0))) + (is (= "{...}\n" (pp {} :print-length 0))) + (is (= "(...)\n" (pp (cons 1 '()) :print-length 0))) ; Cons + (is (= "(...)\n" (pp (range) :print-length 0))) + (is (= "(0 ...)\n" (pp (range) :print-length 1))) + (is (= "(...)\n" (pp '(1 2 3) :print-length 0))) + (is (= "(1 ...)\n" (pp '(1 2 3) :print-length 1))) + (is (= "(1 2 ...)\n" (pp '(1 2 3) :print-length 2))) + (is (= "(1 2 3)\n" (pp '(1 2 3) :print-length 3))) + (is (= "(1 2 3)\n" (pp '(1 2 3) :print-length 4))) + + ;; Print level and print length + (is (= "#\n" (pp {} :print-level 0 :print-length 0))) + (is (= "{...}\n" (pp {} :print-level 1 :print-length 0))) + (is (= "#\n" (pp {} :print-level 0 :print-length 1))) + (is (= "{}\n" (pp {} :print-level 1 :print-length 1))) + + (is (= "#\n" (pp {:a 1 :b 2} :print-level 0 :print-length 0))) + (is (= "{...}\n" (pp {:a 1 :b 2} :print-level 1 :print-length 0))) + (is (= "#\n" (pp {:a 1 :b 2} :print-level 0 :print-length 1))) + (is (= "{#, ...}\n" (pp {:a 1 :b 2} :print-level 1 :print-length 1))) + + ;; Width + (is (= "{[]\n [ab000000000000000000000000000000000000000000000000000000000000000N]}\n" + (pp {[] + ['ab000000000000000000000000000000000000000000000000000000000000000N]} + :max-width 72))) + + ;; Reader macros + (is (= "#'clojure.core/map\n" (pp #'map))) + (is (= "(#'map)\n" (pp '(#'map)))) + (is (= "#{#'mapcat #'map}\n" (pp '#{#'map #'mapcat}))) + + (is (= "{:arglists '([xform* coll]), :added \"1.7\"}\n" + (pp '{:arglists (quote ([xform* coll])) :added "1.7"}))) + + (is (= "@(foo)\n" (pp '@(foo)))) + (is (= "'foo\n" (pp ''foo))) + (is (= "~foo\n" (pp '~foo))) + + (is (= "('#{boolean\n char\n floats})\n" + (pp '('#{boolean char floats}) :max-width 23))) + + (is (= "#\n" + (pp '('#{boolean char floats}) :max-width 23 :print-level 0))) + + (is (= "(...)\n" + (pp '('#{boolean char floats}) :max-width 23 :print-length 0))) + + (is (= "('#{boolean\n char\n floats})\n" + (pp '('#{boolean char floats}) :max-width 23 :print-length 3))) + + ;; Namespace maps + (is (= "#:a{:b 1}\n" (pp {:a/b 1} :print-namespace-maps true))) + (is (= "#:a{:b 1, :c 2}\n" (pp {:a/b 1 :a/c 2} :print-namespace-maps true))) + (is (= "{:a/b 1, :c/d 2}\n" (pp {:a/b 1 :c/d 2} :print-namespace-maps true))) + (is (= "#:a{:b #:a{:b 1}}\n" (pp {:a/b {:a/b 1}} :print-namespace-maps true))) + (is (= "#:a{b 1}\n" (pp {'a/b 1} :print-namespace-maps true))) + (is (= "#:a{b 1, c 3}\n" (pp {'a/b 1 'a/c 3} :print-namespace-maps true))) + (is (= "{a/b 1, c/d 2}\n" (pp {'a/b 1 'c/d 2} :print-namespace-maps true))) + (is (= "#:a{b #:a{b 1}}\n" (pp {'a/b {'a/b 1}} :print-namespace-maps true))) + (is (= "{:a/b 1}\n" (pp {:a/b 1} :print-namespace-maps false))) + (is (= "{:a/b 1, :a/c 2}\n" (pp {:a/b 1 :a/c 2} :print-namespace-maps false))) + (is (= "{:a/b 1, :c/d 2}\n" (pp {:a/b 1 :c/d 2} :print-namespace-maps false))) + (is (= "{:a/b {:a/b 1}}\n" (pp {:a/b {:a/b 1}} :print-namespace-maps false))) + (is (= "{a/b 1}\n" (pp {'a/b 1} :print-namespace-maps false))) + (is (= "{a/b 1, a/c 3}\n" (pp {'a/b 1 'a/c 3} :print-namespace-maps false))) + (is (= "{a/b 1, c/d 2}\n" (pp {'a/b 1 'c/d 2} :print-namespace-maps false))) + (is (= "{a/b {a/b 1}}\n" (pp {'a/b {'a/b 1}} :print-namespace-maps false))) + (is (= "#:a{:b 1,\n :c 2}\n" (pp #:a{:b 1 :c 2} :max-width 14 :print-namespace-maps true))) + + ;; Custom tagged literals + ;; (is (= "#time/date \"2023-10-02\"\n" (pp #time/date "2023-10-02"))) + + ;; Sorted maps + (is (= "{}\n" (pp (sorted-map)))) + (is (= "{:a 1, :b 2}\n" (pp (sorted-map :a 1 :b 2)))) + (is (= "{:a 1, ...}\n" (pp (sorted-map :a 1 :b 2) :print-length 1))) + (is (= "{:a 1,\n :b 2}\n" (pp (sorted-map :a 1 :b 2) :max-width 7))) + + ;; Sorted sets + (is (= "#{}\n" (pp (sorted-set)))) + (is (= "#{1 2 3}\n" (pp (sorted-set 1 2 3)))) + (is (= "#{1 ...}\n" (pp (sorted-set 1 2 3) :print-length 1))) + (is (= "#{1\n 2\n 3}\n" (pp (sorted-set 1 2 3) :max-width 3))) + + ;; Symbolic + (is (= "##Inf\n" (pp ##Inf))) + (is (= "##-Inf\n" (pp ##-Inf))) + (is (= "##NaN\n" (pp ##NaN))) + + ;; Map entries + (is (= "[:a 1]\n" (pp (find {:a 1} :a)))) + (is (= "[[:a 1]]\n" (pp [(find {:a 1} :a)]))) + (is (= "([:a 1])\n" (pp (list (find {:a 1} :a))))) + (is (= "#{[:a 1]}\n" (pp #{(find {:a 1} :a)}))) + (is (= "#\n" (pp (find {:a 1} :a) :print-level 0))) + (is (= "[:a 1]\n" (pp (find {:a 1} :a) :print-level 1))) + (is (= "[...]\n" (pp (find {:a 1} :a) :print-length 0))) + (is (= "[:a ...]\n" (pp (find {:a 1} :a) :print-length 1))) + (is (= "[...]\n" (pp (find {:a 1} :a) :print-level 1 :print-length 0))) + (is (= "#\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-level 0))) + (is (= "#\n" (pp (find {:a 1} :a) :print-level 0 :print-length 1))) + (is (= "#\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-level 0 :print-length 0))) + (is (= "[# #]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-level 1))) + (is (= "[# ...]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-level 1 :print-length 1))) + (is (= "[...]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-length 0 :print-level 1))) + (is (= "[...]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-length 0))) + (is (= "[[:a ...] ...]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-length 1))) + (is (= "[[:a 1] [:b 1]]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-level 2))) + (is (= "[[:a 1] [:b 1]]\n" (pp (find {[:a 1] [:b 1]} [:a 1]) :print-level 3))) + (is (= "[0\n 1]\n" (pp (find {0 1} 0) :max-width 2)))) + +(deftest pprint-array-test + (is (= "[true false]\n" (pp (boolean-array [true false])))) + (is (= "[97 98]\n" (pp (byte-array [(int \a) (int \b)])))) + (is (= "[\\a \\b]\n" (pp (char-array [\a \b])))) + (is (= "[1.0 2.0]\n" (pp (double-array [1.0 2.0])))) + (is (= "[3.0 4.0]\n" (pp (float-array [3.0 4.0])))) + (is (= "[1 2 3]\n" (pp (int-array [1 2 3])))) + (is (= "[4 5 6]\n" (pp (into-array [4 5 6])))) + (is (= "[7 8 9]\n" (pp (long-array [7 8 9])))) + (is (= "[{:a 1} {:b 2}]\n" (pp (object-array [{:a 1} {:b 2}])))) + (is (= "[10 11 22]\n" (pp (short-array [10 11 22])))) + (is (= "[[1 2 3] [4 5 6]]\n" (pp (to-array-2d [[1 2 3] [4 5 6]]))))) + +(deftest pprint-meta-test + ;; clojure.pprint prints this incorrectly with meta + (is (= "{:a 1}\n" + (pp (with-meta {:a 1} {:b 2}) :print-meta true :print-readably false))) + + (is (= "{:a 1}\n" + (pp (with-meta {:a 1} {}) :print-meta true)))) + +(deftest pprint-reader-macro-edge-cases-test + ;; do not print the reader macro character if the collection following the + ;; character exceeds print level + (is (= "#\n" (pp '('#{boolean char floats}) :print-level 0))) + (is (= "(#)\n" (pp '('#{boolean char floats}) :print-level 1))) + (is (= "(#)\n" (pp '('#{boolean char floats}) :print-level 1 :print-length 1))) + + ;; reader macro characters do not count towards *print-length* + (is (= "(...)\n" (pp '('#{boolean char floats}) :print-length 0))) + (is (= "('#{boolean ...})\n" (pp '('#{boolean char floats}) :print-length 1)))) + +(deftest map-entry-separator-test + (is (= "{:a 1, :b 2}\n" (pp {:a 1 :b 2}))) + (is (= "{:a 1, :b 2}\n" (pp {:a 1 :b 2} :map-entry-separator ","))) + (is (= "{:a 1,,, :b 2}\n" (pp {:a 1 :b 2} :map-entry-separator ",,,"))) + (is (= "{:a 1,,,\n :b 2}\n" (pp {:a 1 :b 2} :max-width 8 :map-entry-separator ",,,"))) + (is (= "{:a 1 :b 2}\n" (pp {:a 1 :b 2} :map-entry-separator ""))) + (is (= "{:a 1\n :b 2}\n" (pp {:a 1 :b 2} :max-width 7 :map-entry-separator "")))) diff --git a/test/orchard/print_test.clj b/test/orchard/print_test.clj index 56121787..9a36a433 100644 --- a/test/orchard/print_test.clj +++ b/test/orchard/print_test.clj @@ -143,3 +143,60 @@ (is (= "#{1 2 3}" (sut/print-str (reify clojure.lang.IPersistentSet (equiv [t o] (.equals t o)) (seq [_] (seq [1 2 3]))))))) + +(deftest pprint-no-limits + (are [result form] (match? result (sut/pprint-str form)) + "1" 1 + "\"2\"" "2" + "\"special \\\" \\\\ symbols\"" "special \" \\ symbols" + ":foo" :foo + ":abc/def" :abc/def + "sym" 'sym + "(:a :b :c)" '(:a :b :c) + "[1 2 3]" [1 2 3] + "{:a 1, :b 2}" {:a 1 :b 2} + "[:a 1]" (first {:a 1 :b 2}) + "([:a 1] [:b 2])" (seq {:a 1 :b 2}) + "[[:a 1] [:b 2]]" (vec {:a 1 :b 2}) + "{}" {} + "{}" (java.util.HashMap.) + "#{:a}" #{:a} + "(1 2 3)" (lazy-seq '(1 2 3)) + "[1 1 1 1 1]" (java.util.ArrayList. ^java.util.Collection (repeat 5 1)) + "{:a 1, :b 2}" (let [^java.util.Map x {:a 1 :b 2}] + (java.util.HashMap. x)) + "#orchard.print_test.TestRecord{:a 1, :b 2, :c 3, :d 4}" (->TestRecord 1 2 3 4) + "[1 2 3 4]" (long-array [1 2 3 4]) + "[]" (long-array []) + "[0 1 2 3 4]" (into-array Long (range 5)) + "[]" (into-array Long []) + ;; The following tests print differently in the REPL vs in Leiningen due to some overrides in cider-nrepl + ;; #"#object\[orchard.print_test.MyTestType 0x.+ \"orchard.print_test.MyTestType@.+\"\]" (MyTestType. "test1") + ;; #"#atom\[1 0x.+\]" (atom 1) + ;; #"#delay\[\{:status :pending, :val nil\} 0x.+\]" (delay 1) + ;; #"#delay\[\{:status :ready, :val 1\} 0x.+\]" (doto (delay 1) deref) + ;; #"(?ms)#delay\[\{:status :failed, :val #error .*\}\]" (let [d (delay (/ 1 0))] (try @d (catch Exception _)) d) + ;; #"(?ms)#error \{.*\}" (ex-info "Boom" {}) + ;; "#function[clojure.core/str]" str + )) + +(deftest pprint-limits + (testing "global writer limits will stop the printing when reached" + (are [result form] (= result (binding [sut/*max-atom-length* 10 + sut/*max-total-length* 30 + *print-length* 5 + *print-level* 10] + (sut/pprint-str form))) + "\"aaaaaaaaa..." (apply str (repeat 300 "a")) + "[\"aaaaaaaaa...\n \"aaaaaaaaa...]..." [(apply str (repeat 300 "a")) (apply str (repeat 300 "a"))] + "(1 1 1 1 1 ...)" (repeat 1) + "[(1 1 1 1 1 ...)]" [(repeat 1)] + "{:a {(0 1 2 3 4 ...) 1, 2 3, 4..." {:a {(range 10) 1, 2 3, 4 5, 6 7, 8 9, 10 11}} + "[1 1 1 1 1..." (java.util.ArrayList. ^java.util.Collection (repeat 100 1)) + "[0 1 2 3 4 ...]" (into-array Long (range 10)) + "{:m\n {:m\n {:m\n {:m {:m 1234..." (nasty 5) + "{:b {:a {:..." graph-with-loop)) + + (testing "writer won't go much over total-length" + (is (= 2003 (count (binding [sut/*max-total-length* 2000] + (sut/print-str infinite-map))))))) From 2333f4b2bc1953be5b3d294b6cbe7d20b1403464 Mon Sep 17 00:00:00 2001 From: Oleksandr Yakushev Date: Fri, 18 Apr 2025 10:16:42 +0300 Subject: [PATCH 2/2] 0.34.0 --- CHANGELOG.md | 2 ++ README.md | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 03f35a01..c62c2050 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ ## master (unreleased) +## 0.34.0 (2025-04-18) + * [#335](https://github.com/clojure-emacs/orchard/pull/335) Add `orchard.pp` and pretty view mode. ## 0.33.0 (2025-04-08) diff --git a/README.md b/README.md index 4f37e58e..25b54374 100644 --- a/README.md +++ b/README.md @@ -85,7 +85,7 @@ Documentation for the master branch as well as tagged releases are available Just add `orchard` as a dependency and start hacking. ```clojure -[cider/orchard "0.33.0"] +[cider/orchard "0.34.0"] ``` Consult the [API documentation](https://cljdoc.org/d/cider/orchard/CURRENT) to get a better idea about the