From acb01e37466a1d3fff81f10e00fe15a4ef20e2db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 26 Feb 2016 12:42:15 +0100
Subject: grafts: Add record type printer.

* guix/grafts.scm (write-graft): New procedure.  Register it as a
printer for <graft>.
---
 guix/grafts.scm | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'guix/grafts.scm')

diff --git a/guix/grafts.scm b/guix/grafts.scm
index 5074809c43..a1f7d8801a 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -21,6 +21,7 @@
   #:use-module (guix derivations)
   #:use-module ((guix utils) #:select (%current-system))
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (graft?
@@ -44,6 +45,22 @@
   (replacement-output graft-replacement-output    ;string | #f
                       (default "out")))
 
+(define (write-graft graft port)
+  "Write a concise representation of GRAFT to PORT."
+  (define (->string thing output)
+    (if (derivation? thing)
+        (derivation->output-path thing output)
+        thing))
+
+  (match graft
+    (($ <graft> origin origin-output replacement replacement-output)
+     (format port "#<graft ~a ==> ~a ~a>"
+             (->string origin origin-output)
+             (->string replacement replacement-output)
+             (number->string (object-address graft) 16)))))
+
+(set-record-type-printer! <graft> write-graft)
+
 (define* (graft-derivation store drv grafts
                            #:key
                            (name (derivation-name drv))
-- 
cgit v1.2.3