[print] Add special printing rules for records and allow meta :type overrides

Author: alexander-yakushev

CHANGELOG.md

@@ -2,9 +2,11 @@
 
 ## master (unreleased)
 
+* [#314](https://github.com/clojure-emacs/orchard/pull/314): Print: add special printing rules for records and allow meta :type overrides.
+
 ## 0.34.0 (2025-04-18)
 
-* [#335](https://github.com/clojure-emacs/orchard/pull/335) Add `orchard.pp` and pretty view mode.
+* [#335](https://github.com/clojure-emacs/orchard/pull/335): Add `orchard.pp` and pretty view mode.
 
 ## 0.33.0 (2025-04-08)
 

src/orchard/print.clj

@@ -11,8 +11,8 @@
   (:import
    (clojure.core Eduction)
    (clojure.lang AFunction Compiler IDeref IPending IPersistentMap
-                 IPersistentSet IPersistentVector Keyword Symbol TaggedLiteral
-                 Var)
+                 IPersistentSet IPersistentVector IRecord Keyword Symbol
+                 TaggedLiteral Var)
    (java.util List Map Map$Entry)
    (mx.cider.orchard TruncatingStringWriter
                      TruncatingStringWriter$TotalLimitExceeded))
@@ -23,10 +23,13 @@
   (fn [x _]
     (cond
       (nil? x)                        nil
+      ;; Allow meta :type override regular types.
+      (:type (meta x))                (type x)
       (instance? String x)            :string
       (instance? Number x)            :scalar
       (instance? Keyword x)           :scalar
       (instance? Symbol x)            :scalar
+      (instance? IRecord x)           :record
       (instance? Map x)               :map
       (instance? IPersistentVector x) :vector
       (instance? List x)              :list
@@ -118,14 +121,22 @@
 (defmethod print :set [x w]
   (print-coll w x " " "#{" "}"))
 
-(defmethod print :map [^Map x, w]
+(defn- print-map [^Map x, w]
   (if (.isEmpty x)
     (print-method x w)
     (let [;; If the map is a Clojure map, don't take the entrySet but iterate
           ;; directly as the order might be important.
           coll (if (instance? IPersistentMap x) x (.entrySet ^Map x))]
       (print-coll w coll ", " "{" "}" true))))
 
+(defmethod print :map [^Map x, w]
+  (print-map x w))
+
+(defmethod print :record [x, ^TruncatingStringWriter w]
+  (.write w "#")
+  (.write w (.getSimpleName (class x)))
+  (print-map x w))
+
 (defmethod print :array [x, ^TruncatingStringWriter w]
   (let [ct (.getName (or (.getComponentType (class x)) Object))
         as-seq (seq x)]

test/orchard/inspect_test.clj

@@ -960,13 +960,13 @@
               "  " [:value ":flags" pos?] " = " [:value "#{:public}" pos?]
               [:newline]
               "  " [:value ":members" pos?] " = "
-              [:value #=(str "{clone [{:name clone, :return-type java.lang.Object, :declaring-class java.lang.Object, "
+              [:value #=(str "{clone [#Method{:name clone, :return-type java.lang.Object, :declaring-class java.lang.Object, "
                              ":parameter-types [], :exception-types [java.lang.CloneNotSupportedException], ...}], equals "
-                             "[{:name equals, :return-type boolean, :declaring-class java.lang.Object, :parameter-types "
-                             "[java.lang.Object], :exception-types [], ...}], finalize [{:name finalize, :return-type void, "
+                             "[#Method{:name equals, :return-type boolean, :declaring-class java.lang.Object, :parameter-types "
+                             "[java.lang.Object], :exception-types [], ...}], finalize [#Method{:name finalize, :return-type void, "
                              ":declaring-class java.lang.Object, :parameter-types [], :exception-types [java.lang.Throwable], "
-                             "...}], getClass [{:name getClass, :return-type java.lang.Class, :declaring-class java.lang.Object, "
-                             ":parameter-types [], :exception-types [], ...}], hashCode [{:name hashCode, :return-type int, "
+                             "...}], getClass [#Method{:name getClass, :return-type java.lang.Class, :declaring-class java.lang.Object, "
+                             ":parameter-types [], :exception-types [], ...}], hashCode [#Method{:name hashCode, :return-type int, "
                              ":declaring-class java.lang.Object, :parameter-types [], :exception-types [], ...}], ...}")
                pos?]
               [:newline]

test/orchard/print_test.clj

@@ -77,7 +77,7 @@
     "(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))
-    "{:a 1, :b 2, :c 3, :d 4}" (->TestRecord 1 2 3 4)
+    "#TestRecord{:a 1, :b 2, :c 3, :d 4}" (->TestRecord 1 2 3 4)
     "long[] {1, 2, 3, 4}" (long-array [1 2 3 4])
     "long[] {}" (long-array [])
     "java.lang.Long[] {0, 1, 2, 3, 4}" (into-array Long (range 5))
@@ -144,6 +144,12 @@
                                      (equiv [t o] (.equals t o))
                                      (seq [_] (seq [1 2 3])))))))
 
+(defmethod orchard.print/print ::custom-rec [_ w] (sut/print 'hello w))
+
+(deftest print-custom-print-method
+  (is (= "hello"
+         (sut/print-str (with-meta (->TestRecord 1 2 3 4) {:type ::custom-rec})))))
+
 (deftest pprint-no-limits
   (are [result form] (match? result (sut/pprint-str form))
     "1" 1