summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-11-11 00:10:44 +0100
committerLudovic Courtès <ludo@gnu.org>2021-11-11 00:14:31 +0100
commit3756ce32674139376bcf11dac96bc562582088f7 (patch)
tree63bbe4e1536425e9be90f113b90de9e60ca63e8c /guix/import
parentb2ed40c29f578d46d42cb1c5e99bd797cea3aba0 (diff)
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.
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/print.scm50
1 files changed, 30 insertions, 20 deletions
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 @@
#: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 @@ when evaluated."
(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 @@ when evaluated."
'-build-system)))
,@(match arguments
(() '())
- (args `((arguments ,(list 'quasiquote args)))))
+ (_ `((arguments
+ ,(list 'quasiquote (object->code arguments #t))))))
,@(match outputs
(("out") '())
(outs `((outputs (list ,@outs)))))