Skip to content

Commit 629ffab

Browse files
alexander-yakushevalexander-yakushev
authored
Unify injected print-method implementations with orchard.print (#935)
1 parent 8ed09c2 commit 629ffab

File tree

5 files changed

+82
-119
lines changed

5 files changed

+82
-119
lines changed

‎CHANGELOG.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,9 @@
22

33
## master (unreleased)
44

5+
* Bump `orchard` to [0.34.1](https://github.com/clojure-emacs/orchard/blob/master/CHANGELOG.md#0341-2025-04-23).
6+
* [#935](https://github.com/clojure-emacs/cider-nrepl/pull/935): Unify injected print-method implementations with orchard.print.
7+
58
## 0.55.2 (2025-04-18)
69

710
* Bump `orchard` to [0.34.0](https://github.com/clojure-emacs/orchard/blob/master/CHANGELOG.md#0340-2025-04-18).

‎project.clj‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@
2222
:url "http://www.eclipse.org/legal/epl-v10.html"}
2323
:scm {:name "git" :url "https://github.com/clojure-emacs/cider-nrepl"}
2424
:dependencies [[nrepl/nrepl "1.3.1" :exclusions [org.clojure/clojure]]
25-
[cider/orchard "0.34.0" :exclusions [org.clojure/clojure]]
25+
[cider/orchard "0.34.1" :exclusions [org.clojure/clojure]]
2626
^:inline-dep [fipp ~fipp-version] ; can be removed in unresolved-tree mode
2727
^:inline-dep [compliment "0.7.0"]
2828
^:inline-dep [org.rksm/suitable "0.6.2" :exclusions [org.clojure/clojure

‎src/cider/nrepl/print_method.clj‎

Lines changed: 36 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,9 @@
44
calls `print-method`, which includes return values, `pr`, `print`
55
and the likes."
66
(:require
7-
[clojure.main :as main])
7+
[orchard.print :as print])
88
(:import
9-
[clojure.lang AFunction Atom MultiFn Namespace]
10-
[java.io Writer]))
9+
(clojure.lang AFunction Atom IDeref MultiFn Namespace)))
1110

1211
(def ^:dynamic *pretty-objects*
1312
"If true, cider prettifies some object descriptions.
@@ -20,76 +19,37 @@
2019
(alter-var-root #'cider.nrepl.print-method/*pretty-objects* not)"
2120
true)
2221

23-
(defmacro def-print-method [dispatch-val arg & strings]
24-
`(defmethod print-method ~dispatch-val [~arg ~'^Writer w]
25-
(if *pretty-objects*
26-
(do ~@(map #(list '.write
27-
(with-meta 'w {:tag `Writer})
28-
%)
29-
strings))
30-
(#'clojure.core/print-object ~arg ~'w))))
31-
32-
(defn- translate-class-name ^String [c]
33-
(main/demunge (.getName (class c))))
34-
35-
;;; Atoms
36-
;; Ex: #atom[{:foo :bar} 0x54274a2b]
37-
(def-print-method Atom c
38-
"#atom["
39-
(pr-str @c)
40-
(format " 0x%x]" (System/identityHashCode c)))
41-
42-
;;; Function objects
43-
;; Ex: #function[cider.nrepl.print-method/multifn-name]
44-
(def-print-method AFunction c
45-
"#function["
46-
(translate-class-name c)
47-
"]")
48-
49-
;;; Multimethods
50-
;; Ex: #multifn[print-method 0x3f0cd5b4]
51-
(defn multifn-name [^MultiFn mfn]
52-
(let [field (.getDeclaredField MultiFn "name")
53-
private (not (.isAccessible field))]
54-
(when private
55-
(.setAccessible field true))
56-
(let [name (.get field mfn)]
57-
(when private
58-
(.setAccessible field false))
59-
name)))
60-
61-
(defn multifn-name-or-translated-name ^String [c]
62-
(try (multifn-name c)
63-
(catch SecurityException _
64-
(translate-class-name c))))
65-
66-
(def-print-method MultiFn c
67-
"#multifn["
68-
(multifn-name-or-translated-name c)
69-
;; MultiFn names are not unique so we keep the identity HashCode to
70-
;; make sure it's unique.
71-
(format " 0x%x]" (System/identityHashCode c)))
72-
73-
;;; Namespaces
74-
;; Ex: #namespace[clojure.core]
75-
(def-print-method Namespace c
76-
"#namespace["
77-
(format "%s" (ns-name c))
78-
"]")
79-
80-
;;; Agents, futures, delays, promises, etc
81-
(defn- deref-name ^String [c]
82-
(let [class-name (translate-class-name c)]
83-
(if-let [[_ ^String short-name] (re-find #"^clojure\.lang\.([^.]+)" class-name)]
84-
(.toLowerCase short-name)
85-
(case (second (re-find #"^clojure\.core/(.+)/reify" class-name))
86-
"future-call" "future"
87-
"promise" "promise"
88-
nil class-name))))
89-
90-
;; `deref-as-map` is a private function, so let's be careful.
91-
(when-let [f (resolve 'clojure.core/deref-as-map)]
92-
(def-print-method clojure.lang.IDeref c
93-
"#" (deref-name c) "["
94-
(pr-str (f c))
95-
(format " 0x%x]" (System/identityHashCode c))))
22+
(defn- replace-with-orchard-print
23+
"Replace `clojure.core/print-method` for the given class with
24+
`orchard.print/print` when `*pretty-objects*` is true, otherwise call the
25+
default Clojure implementation."
26+
[klass]
27+
(defmethod print-method klass [x writer]
28+
(if *pretty-objects*
29+
(print/print x writer)
30+
(#'clojure.core/print-object writer))))
31+
32+
;; NB: we don't replace all clojure.core/print-method implementations with
33+
;; orchard.print/print because they arguably have different purpose. Orchard
34+
;; printer is more human-oriented whereas print-method is a bit more
35+
;; machine-oriented. So, we only replace it for those types where the visual
36+
;; improvement is substantial yet we are confident it won't break something.
37+
38+
;;; Atoms: #atom[{:foo :bar}]
39+
(replace-with-orchard-print Atom)
40+
41+
;;; Function objects: #function[clojure.core/str]
42+
(replace-with-orchard-print AFunction)
43+
44+
;;; Multimethods: #multifn[print-method 0x3f0cd5b4]
45+
(replace-with-orchard-print MultiFn)
46+
47+
;;; Namespaces: #namespace[clojure.core]
48+
(replace-with-orchard-print Namespace)
49+
50+
;;; Various derefables
51+
;; #agent[1], #agent[<failed> #error[...]]
52+
;; #delay[<pending>], #delay[1], #delay[<failed> #error[...]]
53+
;; #future[<pending>], #future[1], #future[<failed> #error[...]]
54+
;; #promise[<pending>], #promise[1]
55+
(replace-with-orchard-print IDeref)

‎test/clj/cider/nrepl/middleware/inspect_test.clj‎

Lines changed: 26 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@
4141
" " [:value ":column" 4] " = " [:value #"\d+" 5] [:newline]
4242
" " [:value ":file" 6] " = " [:value #"\".*cider/nrepl/middleware/inspect_test.clj\"" 7] [:newline]
4343
" " [:value ":name" 8] " = " [:value "any-var" 9] [:newline]
44-
" " [:value ":ns" 10] " = " [:value "cider.nrepl.middleware.inspect-test" 11] [:newline]
44+
" " [:value ":ns" 10] " = " [:value "#namespace[cider.nrepl.middleware.inspect-test]" 11] [:newline]
4545
[:newline]
4646
"--- Datafy:" [:newline]
4747
" 0. " [:value "true" 12] [:newline]])
@@ -696,41 +696,44 @@
696696
(session/message {:op "inspect-clear"})
697697
(session/message {:op "eval"
698698
:inspect "true"
699-
:code "(repeat 5 {:a (repeat 5 {:b 2}) :c (repeat 5 {:d 2})})"})
699+
:max-coll-size 6
700+
:code "(repeat 5 {:a (repeat 6 {:b 2}) :c (repeat 6 {:d 2})})"})
700701
(testing "toggle pretty printing and turn it on"
701702
(is+ ["--- Contents:" [:newline]
702-
" 0. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
703-
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 1]
703+
" 0. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
704+
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 1]
704705
[:newline]
705-
" 1. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
706-
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 2]
706+
" 1. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
707+
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 2]
707708
[:newline]
708-
" 2. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
709-
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 3]
709+
" 2. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
710+
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 3]
710711
[:newline]
711-
" 3. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
712-
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 4]
712+
" 3. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
713+
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 4]
713714
[:newline]
714-
" 4. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
715-
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 5]
716-
[:newline]]
715+
" 4. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
716+
"\n :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 5]
717+
[:newline] [:newline]
718+
"--- View mode:" [:newline]
719+
" :pretty"]
717720
(value-skip-header (session/message {:op "inspect-toggle-pretty-print"}))))
718721
(testing "toggle pretty printing and turn it off"
719722
(is+ ["--- Contents:" [:newline]
720-
" 0. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
721-
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 1]
723+
" 0. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
724+
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 1]
722725
[:newline]
723-
" 1. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
724-
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 2]
726+
" 1. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
727+
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 2]
725728
[:newline]
726-
" 2. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
727-
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 3]
729+
" 2. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
730+
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 3]
728731
[:newline]
729-
" 3. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
730-
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 4]
732+
" 3. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
733+
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 4]
731734
[:newline]
732-
" 4. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
733-
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 5]
735+
" 4. " [:value (str "{:a ({:b 2} {:b 2} {:b 2} {:b 2} {:b 2} {:b 2}),"
736+
" :c ({:d 2} {:d 2} {:d 2} {:d 2} {:d 2} {:d 2})}") 5]
734737
[:newline]]
735738
(value-skip-header (session/message {:op "inspect-toggle-pretty-print"}))))))
736739

‎test/clj/cider/nrepl/print_method_test.clj‎

Lines changed: 16 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,42 +1,39 @@
11
(ns cider.nrepl.print-method-test
22
(:require
33
[cider.nrepl.print-method :refer :all]
4-
[clojure.test :refer :all])
5-
(:import
6-
java.util.regex.Pattern))
4+
[clojure.test :refer :all]))
75

86
(defn dummy-fn [o])
97

108
(deftest print-atoms-test
11-
(is (re-find #"#atom\[\"\" 0x[a-z0-9]+\]" (pr-str (atom ""))))
12-
(is (re-find #"#atom\[nil 0x[a-z0-9]+\]" (pr-str (atom nil))))
13-
(is (re-find #"#atom\[\{:foo :bar\} 0x[a-z0-9]+\]" (pr-str (atom {:foo :bar}))))
14-
(is (re-find #"#atom\[#function\[clojure.core/\+\] 0x[a-z0-9]+\]" (pr-str (atom +)))))
9+
(is (= "#atom[\"\"]" (pr-str (atom ""))))
10+
(is (= "#atom[nil]" (pr-str (atom nil))))
11+
(is (= "#atom[{:foo :bar}]" (pr-str (atom {:foo :bar}))))
12+
(is (= "#atom[#function[clojure.core/+]]" (pr-str (atom +)))))
1513

1614
(deftest print-idrefs-test
1715
(let [f (future (Thread/sleep 200) 1)
1816
p (promise)
1917
d (delay 1)
2018
a (agent 1)]
21-
(are [o r] (re-find r (pr-str o))
22-
a #"#agent\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]"
23-
d #"#delay\[\{:status :pending, :val nil\} 0x[a-z0-9]+\]"
24-
f #"#future\[\{:status :pending, :val nil\} 0x[a-z0-9]+\]"
25-
p #"#promise\[\{:status :pending, :val nil\} 0x[a-z0-9]+\]")
19+
(are [o r] (= r (pr-str o))
20+
a "#agent[1]"
21+
d "#delay[<pending>]"
22+
f "#future[<pending>]"
23+
p "#promise[<pending>]")
2624
(Thread/sleep 300)
2725
@d
2826
(deliver p 1)
2927
@f
30-
(are [o r] (re-find r (pr-str o))
31-
f #"#future\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]"
32-
d #"#delay\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]"
33-
p #"#promise\[\{:status :ready, :val 1\} 0x[a-z0-9]+\]")))
28+
(are [o r] (= r (pr-str o))
29+
f "#future[1]"
30+
d "#delay[1]"
31+
p "#promise[1]")))
3432

3533
(deftest print-functions-test
3634
(are [f s] (= (pr-str f) s)
3735
print-functions-test "#function[cider.nrepl.print-method-test/print-functions-test]"
3836
dummy-fn "#function[cider.nrepl.print-method-test/dummy-fn]"
39-
multifn-name "#function[cider.nrepl.print-method/multifn-name]"
4037
+ "#function[clojure.core/+]"
4138
* "#function[clojure.core/*]"
4239
/ "#function[clojure.core//]"
@@ -45,8 +42,8 @@
4542
(deftest print-multimethods-test
4643
(require 'cider.nrepl.middleware.track-state)
4744
(let [var (resolve 'print-method)]
48-
(is (re-find (Pattern/compile (format "#multifn\\[%s 0x[a-z0-9]+\\]"
49-
(:name (meta var))))
45+
(is (re-find (re-pattern (format "#multifn\\[%s 0x[a-z0-9]+\\]"
46+
(:name (meta var))))
5047
(pr-str @var)))))
5148

5249
(deftest print-namespaces-test

0 commit comments

Comments
 (0)