fix #740: simple-dispatch on records (#742)

src/sci/impl/multimethods.cljc

@@ -1,7 +1,8 @@
 (ns sci.impl.multimethods
   {:no-doc true}
   (:refer-clojure :exclude [defmulti defmethod])
-  (:require [sci.impl.hierarchies :refer [global-hierarchy]]))
+  (:require [sci.impl.hierarchies :refer [global-hierarchy]]
+            [clojure.string :as str]))
 
 #?(:clj (set! *warn-on-reflection* true))
 
@@ -103,13 +104,22 @@
   "Creates and installs a new method of multimethod associated with dispatch-value. "
   [_x _y multifn dispatch-val & fn-tail]
   #?(:clj
-     ;; TODO, we could do a better job resolving print-method if it
-     ;; was :excluded or full qualified
-     (if (= 'print-method multifn)
-       `(let [v# ~dispatch-val
-              m# (meta v#)]
-          (if (:sci.impl/record m#)
-            (alter-var-root (:sci.impl/record-var m#) vary-meta assoc :sci.impl/print-method (fn ~@fn-tail))
-            (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail))))
-       `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))
+     (let [multifn-str (str multifn)]
+       (if (or (str/ends-with? multifn-str "print-method")
+               (str/ends-with? multifn-str "simple-dispatch"))
+         `(let [v# ~dispatch-val
+                m# (meta v#)
+                mf# (resolve '~multifn)]
+            (if (:sci.impl/record m#)
+              (cond
+                (= (resolve 'clojure.pprint/simple-dispatch) mf#)
+                (do
+                  (alter-var-root (:sci.impl/record-var m#)
+                                  vary-meta assoc :sci.impl/pprint-simple-dispatch (fn ~@fn-tail)))
+                (= (resolve 'clojure.core/print-method) mf#)
+                (alter-var-root (:sci.impl/record-var m#)
+                                vary-meta assoc :sci.impl/print-method (fn ~@fn-tail))
+                :else (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail)))
+              (clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail))))
+         `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail))))
      :cljs `(clojure.core/multi-fn-add-method-impl ~multifn ~dispatch-val (fn ~@fn-tail))))

src/sci/pprint.cljc

@@ -0,0 +1,22 @@
+(ns sci.pprint
+  "Extensible pprinting for built-in SCI types."
+  (:require [clojure.pprint :as pprint]
+            [sci.impl.records]))
+
+(defprotocol SciPrettyPrint
+  (-sci-pprint-simple-dispatch [obj]))
+
+(extend-protocol SciPrettyPrint
+  sci.impl.records.SciRecord
+  (-sci-pprint-simple-dispatch [obj]
+    (let [m (meta obj)
+          var (:sci.impl/record-var m)]
+      (if-let [rv var]
+        (let [m (meta @rv)]
+          (if-let [pm (:sci.impl/pprint-simple-dispatch m)]
+            (pm obj)
+            (pprint/simple-dispatch obj)))
+        (pprint/simple-dispatch obj)))))
+
+(defmethod pprint/simple-dispatch sci.impl.records.SciRecord [obj]
+  (-sci-pprint-simple-dispatch obj))

test/sci/pprint_test.clj

@@ -0,0 +1,29 @@
+(ns sci.pprint-test
+  (:require
+   [clojure.pprint :as pp]
+   [clojure.string :as str]
+   [clojure.test :as test :refer [deftest is]]
+   [sci.core :as sci]
+   [sci.pprint]))
+
+(defn pprint [o]
+  (binding [*out* @sci/out]
+    (pp/pprint o)))
+
+(deftest pprint-simple-dispatch-test
+  (is (= "<6>"
+         (str/trim
+          (sci/with-out-str
+            (sci/eval-string "
+(require '[clojure.pprint :as pprint])
+
+(defrecord Foo [x])
+
+(defmethod pprint/simple-dispatch Foo [o]
+  (print (format \"<%s>\" (:x o))))
+
+(pprint/pprint (->Foo 6))
+"
+                             {:namespaces
+                              {'clojure.pprint {'pprint pprint
+                                                'simple-dispatch pp/simple-dispatch}}}))))))