Abbreviate printing of AFunction and MultiFn objects

Instead of printing as
  #object[clojure.core$_PLUS_ 0x4e648e99 "clojure.core$_PLUS_@4e648e99"]
they are now printed as
  #function[clojure.core/+]

Instead of printing as
  #object[clojure.lang.MultiFn 0x4e648e99 "clojure.lang.MultiFn@0x4e648e99"]
they are now printed as
  #multifn[print-method 0x3f0cd5b4]

Disable this with
    (alter-var-root #'cider.nrepl.print-method/*pretty-objects* not)

Author: Malabarba

src/cider/nrepl.clj

@@ -1,5 +1,6 @@
 (ns cider.nrepl
   (:require [clojure.tools.nrepl.server :as nrepl-server]
+            [cider.nrepl.print-method]
             [cider.nrepl.middleware.apropos]
             [cider.nrepl.middleware.classpath]
             [cider.nrepl.middleware.complete]

src/cider/nrepl/middleware/out.clj

@@ -9,6 +9,7 @@
   guarantee that the channel that sent the clone message will properly
   handle output replies."
   (:require [cider.nrepl.middleware.util.cljs :as cljs]
+            [clojure.string :as s]
             [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
             [clojure.tools.nrepl.middleware.interruptible-eval :as ie]
             [clojure.tools.nrepl.middleware.session :as session])

src/cider/nrepl/print_method.clj

@@ -0,0 +1,62 @@
+(ns cider.nrepl.print-method
+  (:require [clojure.string :as s])
+  (:import [clojure.lang AFunction MultiFn]
+           java.io.Writer))
+
+;; 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.
+
+(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 'w %) strings))
+       (#'clojure.core/print-object ~arg ~'w))))
+
+;;; Function objects
+;; Ex: #function[cider.nrepl.print-method/multifn-name]
+(def-print-method AFunction c
+  "#function["
+  (-> (.getName (class c))
+      (s/replace-first "$" "/")
+      (s/replace "_QMARK_" "?")
+      (s/replace "_PLUS_" "+")
+      (s/replace "_BANG_" "!")
+      (s/replace "_EQ_" "=")
+      (s/replace "_SLASH_" "/")
+      (s/replace "_STAR_" "*")
+      (s/replace "_" "-"))
+  "]")
+
+;;; 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)))
+
+(def-print-method MultiFn c
+  "#multifn["
+  (try (multifn-name c)
+       (catch SecurityException _
+         (class c)))
+  ;; MultiFn names are not unique so we keep the identity HashCode to
+  ;; make sure it's unique.
+  (format " 0x%x]" (System/identityHashCode c)))

test/clj/cider/nrepl/print_method_test.clj

@@ -0,0 +1,24 @@
+(ns cider.nrepl.print-method-test
+  (:require [cider.nrepl.print-method :refer :all]
+            [clojure.test :refer :all])
+  (:import java.util.regex.Pattern))
+
+(defn dummy-fn [o])
+
+(deftest print-functions
+  (are [f s] (= (pr-str f) s)
+    print-functions "#function[cider.nrepl.print-method-test/print-functions]"
+    dummy-fn "#function[cider.nrepl.print-method-test/dummy-fn]"
+    multifn-name "#function[cider.nrepl.print-method/multifn-name]"
+    + "#function[clojure.core/+]"
+    * "#function[clojure.core/*]"
+    / "#function[clojure.core//]"
+    map? "#function[clojure.core/map?--4138]"))
+
+(deftest print-multimethods
+  (require 'cider.nrepl.middleware.track-state)
+  (doseq [it '(print-method cider.nrepl.middleware.track-state/ns-as-map)]
+    (let [var (resolve it)]
+      (is (re-find (Pattern/compile (format "#multifn\\[%s 0x[a-z0-9]+\\]"
+                                            (:name (meta var))))
+                   (pr-str @var))))))