[print] Make orchard.print more consistent with CIDER printing

Author: alexander-yakushev

src/orchard/print.clj

@@ -10,9 +10,10 @@
   (:refer-clojure :exclude [print print-str])
   (:import
    (clojure.core Eduction)
-   (clojure.lang AFunction Compiler IDeref IPending IPersistentMap
-                 IPersistentSet IPersistentVector IRecord Keyword Symbol
-                 TaggedLiteral Var)
+   (clojure.lang AFunction Compiler IDeref IPending IPersistentMap MultiFn
+                 IPersistentSet IPersistentVector IRecord Keyword Namespace
+                 Symbol TaggedLiteral Var)
+   (java.io Writer)
    (java.util List Map Map$Entry)
    (mx.cider.orchard TruncatingStringWriter
                      TruncatingStringWriter$TotalLimitExceeded))
@@ -50,7 +51,7 @@
 (defn- print-coll-item
   "Print an item in the context of a collection. When printing a map, don't print
   `[]` characters around map entries."
-  [^TruncatingStringWriter w, x, map?]
+  [^Writer w, x, map?]
   (if (and map? (instance? Map$Entry x))
     (do (print (.getKey ^Map$Entry x) w)
         (.write w " ")
@@ -60,7 +61,7 @@
 (defn- print-coll
   ([w x sep prefix suffix]
    (print-coll w x sep prefix suffix false))
-  ([^TruncatingStringWriter w, ^Iterable x, ^String sep, ^String prefix,
+  ([^Writer w, ^Iterable x, ^String sep, ^String prefix,
     ^String suffix, map?]
    (let [level *print-level*]
      (when-not (nil? level)
@@ -89,10 +90,10 @@
        (finally (when-not (nil? level)
                   (set! *print-level* level)))))))
 
-(defmethod print nil [_ ^TruncatingStringWriter w]
+(defmethod print nil [_ ^Writer w]
   (.write w "nil"))
 
-(defmethod print :string [^String x, ^TruncatingStringWriter w]
+(defmethod print :string [^String x, ^Writer w]
   (let [len (.length x)
         max-len *max-atom-length*
         truncate? (and max-len (< max-len len))
@@ -106,7 +107,7 @@
       (.write w "..."))
     (.append w \")))
 
-(defmethod print :scalar [^Object x, ^TruncatingStringWriter w]
+(defmethod print :scalar [^Object x, ^Writer w]
   (.write w (.toString x)))
 
 (defmethod print :persistent-map [x w]
@@ -132,29 +133,33 @@
 (defmethod print :map [^Map x, w]
   (print-map x w))
 
-(defmethod print :record [x, ^TruncatingStringWriter w]
+(defmethod print :record [x, ^Writer w]
   (.write w "#")
   (.write w (.getSimpleName (class x)))
   (print-map x w))
 
-(defmethod print :array [x, ^TruncatingStringWriter w]
+(defmethod print :array [x, ^Writer w]
   (let [ct (.getName (or (.getComponentType (class x)) Object))
         as-seq (seq x)]
     (.write w ct)
     (if as-seq
       (print-coll w as-seq ", " "[] {" "}")
       (.write w "[] {}"))))
 
-(defmethod print IDeref [^IDeref x, ^TruncatingStringWriter w]
+(defmethod print IDeref [^IDeref x, ^Writer w]
   (let [pending (and (instance? IPending x)
                      (not (.isRealized ^IPending x)))
         [ex val]
         (when-not pending
           (try [false (deref x)]
                (catch Throwable e
-                 [true e])))]
+                 [true e])))
+        full-name (.getName (class x))
+        name (cond (str/starts-with? full-name "clojure.core$future_call") "future"
+                   (str/starts-with? full-name "clojure.core$promise") "promise"
+                   :else (str/lower-case (.getSimpleName (class x))))]
     (.write w "#")
-    (.write w (.getSimpleName (class x)))
+    (.write w name)
     (print [(cond (or ex
                       (and (instance? clojure.lang.Agent x)
                            (agent-error x)))
@@ -168,16 +173,36 @@
 (defmethod print Class [x w]
   (print-method x w))
 
-(defmethod print AFunction [x, ^TruncatingStringWriter w]
+(defmethod print AFunction [x, ^Writer w]
   (.write w "#function[")
   (.write w (Compiler/demunge (.getName (class x))))
   (.write w "]"))
 
+(def ^:private multifn-name-field
+  (delay (doto (.getDeclaredField MultiFn "name")
+           (.setAccessible true))))
+
+(defn- multifn-name [^MultiFn mfn]
+  (try (.get ^java.lang.reflect.Field @multifn-name-field mfn)
+       (catch SecurityException _ "_")))
+
+(defmethod print MultiFn [x, ^Writer w]
+  (.write w "#multifn[")
+  (.write w (multifn-name x))
+  ;; MultiFn names are not unique so we keep the identity to ensure it's unique.
+  (.write w (format " 0x%x]" (System/identityHashCode x))))
+
 (defmethod print TaggedLiteral [x w]
   (print-method x w))
 
-(defmethod print Throwable [^Throwable x, ^TruncatingStringWriter w]
-  (.write w "#Error[")
+(defmethod print Namespace [x, ^Writer w]
+  (.write w "#namespace[")
+  (.write w (str (ns-name x)))
+  ;; MultiFn names are not unique so we keep the identity to ensure it's unique.
+  (.write w "]"))
+
+(defmethod print Throwable [^Throwable x, ^Writer w]
+  (.write w "#error[")
   (.write w (str (.getName (class x)) " "))
   (loop [cause x, msg nil]
     (if cause
@@ -191,7 +216,7 @@
     (print (str first-frame) w))
   (.write w "]"))
 
-(defmethod print :default [^Object x, ^TruncatingStringWriter w]
+(defmethod print :default [^Object x, ^Writer w]
   (.write w (.toString x)))
 
 (defn print-str

test/orchard/inspect_test.clj

@@ -168,7 +168,7 @@
               [:newline]
               "  " [:value ":name" pos?] " = " [:value "any-var" pos?]
               [:newline]
-              "  " [:value ":ns" pos?] " = " [:value "orchard.inspect-test" pos?]
+              "  " [:value ":ns" pos?] " = " [:value "#namespace[orchard.inspect-test]" pos?]
               [:newline]
               [:newline]]
              (section "Meta Information" rendered)))
@@ -1147,7 +1147,7 @@
         (is+ ["--- Refer from:"
               [:newline]
               "  "
-              [:value "clojure.core" pos?]
+              [:value "#namespace[clojure.core]" pos?]
               " = "
               [:value #=(str "[#'clojure.core/primitives-classnames #'clojure.core/+' #'clojure.core/decimal? "
                              "#'clojure.core/restart-agent #'clojure.core/sort-by ...]") pos?]

test/orchard/print_test.clj

@@ -83,14 +83,19 @@
     "java.lang.Long[] {0, 1, 2, 3, 4}" (into-array Long (range 5))
     "java.lang.Long[] {}" (into-array Long [])
     "#<MyTestType test1>" (MyTestType. "test1")
-    "#Atom[1]" (atom 1)
-    "#Delay[<pending>]" (delay 1)
-    "#Delay[1]" (doto (delay 1) deref)
-    "#Delay[<failed>]" (let [d (delay (/ 1 0))] (try @d (catch Exception _)) d)
-    #"#Error\[clojure.lang.ExceptionInfo \"Boom\" \"orchard.print_test.+\"\]" (ex-info "Boom" {})
-    #"#Error\[clojure.lang.ExceptionInfo \"Boom\" \{:a 1\} \"orchard.print_test.+\"\]" (ex-info "Boom" {:a 1})
-    #"#Error\[java.lang.RuntimeException \"Runtime!\" \"orchard.print_test.+\"\]" (RuntimeException. "Runtime!")
-    #"#Error\[java.lang.RuntimeException \"Outer: Inner\" \"orchard.print_test.+\"\]" (RuntimeException. "Outer"
+    "#atom[1]" (atom 1)
+    "#delay[<pending>]" (delay 1)
+    "#delay[1]" (doto (delay 1) deref)
+    "#delay[<failed>]" (let [d (delay (/ 1 0))] (try @d (catch Exception _)) d)
+    "#promise[<pending>]" (promise)
+    "#promise[1]" (doto (promise) (deliver 1))
+    "#future[<pending>]" (future (Thread/sleep 10000))
+    "#future[1]" (doto (future 1) deref)
+    "#agent[1]" (agent 1)
+    #"#error\[clojure.lang.ExceptionInfo \"Boom\" \"orchard.print_test.+\"\]" (ex-info "Boom" {})
+    #"#error\[clojure.lang.ExceptionInfo \"Boom\" \{:a 1\} \"orchard.print_test.+\"\]" (ex-info "Boom" {:a 1})
+    #"#error\[java.lang.RuntimeException \"Runtime!\" \"orchard.print_test.+\"\]" (RuntimeException. "Runtime!")
+    #"#error\[java.lang.RuntimeException \"Outer: Inner\" \"orchard.print_test.+\"\]" (RuntimeException. "Outer"
                                                                                                          (RuntimeException. "Inner"))
     "#function[clojure.core/str]" str))
 
@@ -134,10 +139,10 @@
 
   (are [result lvl] (= result (binding [*print-level* lvl]
                                 (sut/print-str (atom {:a (range 10)}))))
-    "#Atom[...]" 0
-    "#Atom[{...}]" 1
-    "#Atom[{:a (...)}]" 2
-    "#Atom[{:a (0 1 2 3 4 5 6 7 8 9)}]" 3))
+    "#atom[...]" 0
+    "#atom[{...}]" 1
+    "#atom[{:a (...)}]" 2
+    "#atom[{:a (0 1 2 3 4 5 6 7 8 9)}]" 3))
 
 (deftest print-non-iterable
   (is (= "#{1 2 3}" (sut/print-str (reify clojure.lang.IPersistentSet