/
print_method.clj
95 lines (83 loc) · 2.91 KB
/
print_method.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
(ns cider.nrepl.print-method
"Extending `print-method` defined in clojure.core, to provide
prettier versions of some objects. This applies to anything that
calls `print-method`, which includes return values, `pr`, `print`
and the likes."
(:require
[clojure.main :as main])
(:import
[clojure.lang AFunction Atom MultiFn Namespace]
[java.io Writer]))
(def ^:dynamic *pretty-objects*
"If true, cider prettifies some object descriptions.
For instance, instead of printing functions as
#object[clojure.core$_PLUS_ 0x4e648e99 \"clojure.core$_PLUS_@4e648e99\"]
they are printed as
#function[clojure.core/+]
To disable this feature, do
(alter-var-root #'cider.nrepl.print-method/*pretty-objects* not)"
true)
(defmacro def-print-method [dispatch-val arg & strings]
`(defmethod print-method ~dispatch-val [~arg ~'^Writer w]
(if *pretty-objects*
(do ~@(map #(list '.write
(with-meta 'w {:tag `Writer})
%)
strings))
(#'clojure.core/print-object ~arg ~'w))))
(defn- translate-class-name ^String [c]
(main/demunge (.getName (class c))))
;;; Atoms
;; Ex: #atom[{:foo :bar} 0x54274a2b]
(def-print-method Atom c
"#atom["
(pr-str @c)
(format " 0x%x]" (System/identityHashCode c)))
;;; Function objects
;; Ex: #function[cider.nrepl.print-method/multifn-name]
(def-print-method AFunction c
"#function["
(translate-class-name c)
"]")
;;; Multimethods
;; Ex: #multifn[print-method 0x3f0cd5b4]
(defn multifn-name [^MultiFn mfn]
(let [field (.getDeclaredField MultiFn "name")
private (not (.isAccessible field))]
(when private
(.setAccessible field true))
(let [name (.get field mfn)]
(when private
(.setAccessible field false))
name)))
(defn multifn-name-or-translated-name ^String [c]
(try (multifn-name c)
(catch SecurityException _
(translate-class-name c))))
(def-print-method MultiFn c
"#multifn["
(multifn-name-or-translated-name c)
;; MultiFn names are not unique so we keep the identity HashCode to
;; make sure it's unique.
(format " 0x%x]" (System/identityHashCode c)))
;;; Namespaces
;; Ex: #namespace[clojure.core]
(def-print-method Namespace c
"#namespace["
(format "%s" (ns-name c))
"]")
;;; Agents, futures, delays, promises, etc
(defn- deref-name ^String [c]
(let [class-name (translate-class-name c)]
(if-let [[_ ^String short-name] (re-find #"^clojure\.lang\.([^.]+)" class-name)]
(.toLowerCase short-name)
(case (second (re-find #"^clojure\.core/(.+)/reify" class-name))
"future-call" "future"
"promise" "promise"
nil class-name))))
;; `deref-as-map` is a private function, so let's be careful.
(when-let [f (resolve 'clojure.core/deref-as-map)]
(def-print-method clojure.lang.IDeref c
"#" (deref-name c) "["
(pr-str (f c))
(format " 0x%x]" (System/identityHashCode c))))