From 3756ce32674139376bcf11dac96bc562582088f7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 11 Nov 2021 00:10:44 +0100
Subject: import: print: Replace packages and origins in 'arguments'.

* guix/import/print.scm (package->code)[variable-reference]
[object->code]: New procedures.
[package-lists->code]: Rewrite in terms of 'object->code'.
Pass the 'arguments' field through 'object->code'.
* tests/print.scm (pkg-with-arguments, pkg-with-arguments-source): New
variables.
("package with arguments"): New test.
---
 guix/import/print.scm | 50 ++++++++++++++++++++++++++++++--------------------
 1 file changed, 30 insertions(+), 20 deletions(-)

(limited to 'guix')

diff --git a/guix/import/print.scm b/guix/import/print.scm
index e04a6647b4..767b0528d5 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,9 +32,6 @@ (define-module (guix import print)
   #:use-module (ice-9 match)
   #:export (package->code))
 
-;; FIXME: the quasiquoted arguments field may contain embedded package
-;; objects, e.g. in #:disallowed-references; they will just be printed with
-;; their usual #<package ...> representation, not as variable names.
 (define (package->code package)
   "Return an S-expression representing the source code that produces PACKAGE
 when evaluated."
@@ -124,23 +122,34 @@ (define (source->code source version)
                                              (source->code origin #f)))
                                           patches)))))))))
 
+  (define (variable-reference module name)
+    ;; FIXME: using '@ certainly isn't pretty, but it avoids having to import
+    ;; the individual package modules.
+    (list '@ module name))
+
+  (define (object->code obj quoted?)
+    (match obj
+      ((? package? package)
+       (let* ((module (package-module-name package))
+              (name   (variable-name package module)))
+         (if quoted?
+             (list 'unquote (variable-reference module name))
+             (variable-reference module name))))
+      ((? origin? origin)
+       (let ((code (source->code origin #f)))
+         (if quoted?
+             (list 'unquote code)
+             code)))
+      ((lst ...)
+       (let ((lst (map (cut object->code <> #t) lst)))
+         (if quoted?
+             lst
+             (list 'quasiquote lst))))
+      (obj
+       obj)))
+
   (define (package-lists->code lsts)
-    (list 'quasiquote
-          (map (match-lambda
-                 ((? symbol? s)
-                  (list (symbol->string s) (list 'unquote s)))
-                 ((label (? package? pkg) . out)
-                  (let ((mod (package-module-name pkg)))
-                    (cons* label
-                           ;; FIXME: using '@ certainly isn't pretty, but it
-                           ;; avoids having to import the individual package
-                           ;; modules.
-                           (list 'unquote
-                                 (list '@ mod (variable-name pkg mod)))
-                           out)))
-                 ((label (? origin? origin))
-                  (list label (list 'unquote (source->code origin #f)))))
-               lsts)))
+    (list 'quasiquote (object->code lsts #t)))
 
   (let ((name                (package-name package))
         (version             (package-version package))
@@ -176,7 +185,8 @@ (define (package-lists->code lsts)
                                           '-build-system)))
          ,@(match arguments
              (() '())
-             (args `((arguments ,(list 'quasiquote args)))))
+             (_  `((arguments
+                    ,(list 'quasiquote (object->code arguments #t))))))
          ,@(match outputs
              (("out") '())
              (outs `((outputs (list ,@outs)))))
-- 
cgit v1.2.3