me
/
guix
Archived
1
0
Fork 0
Code

grafts: Add record type printer. 

* guix/grafts.scm (write-graft): New procedure.  Register it as a
printer for <graft>.
master
Ludovic Courtès 2016-02-26 12:42:15 +01:00
parent 70ac09a552
commit acb01e3746
1 changed files with 17 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
guix/grafts.scm
View File

@ -21,6 +21,7 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix utils) #:select (%current-system))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (graft? #:export (graft?
@ -44,6 +45,22 @@
(replacement-output graft-replacement-output ;string | #f (replacement-output graft-replacement-output ;string | #f
(default "out"))) (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 (define* (graft-derivation store drv grafts
#:key #:key
(name (derivation-name drv)) (name (derivation-name drv))