futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import: print: Replace packages and origins in 'arguments'.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2021-11-11 00:10:44 +01:00
parent b2ed40c29f
commit 3756ce3267
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 53 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
guix/import/print.scm
View File

@ -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)))))

23
tests/print.scm
View File

@ -120,6 +120,25 @@
(description "This is a dummy package.")
(license license:gpl3+)))
(define-with-source pkg-with-arguments pkg-with-arguments-source
(package
(name "test")
(version "1.2.3")
(source (origin
(method url-fetch)
(uri (string-append "file:///tmp/test-"
version ".tar.gz"))
(sha256
(base32
"070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
(build-system (@ (guix build-system gnu) gnu-build-system))
(arguments
`(#:disallowed-references (,(@ (gnu packages base) coreutils))))
(home-page "http://gnu.org")
(synopsis "Dummy")
(description "This is a dummy package.")
(license license:gpl3+)))
(test-equal "simple package"
`(define-public test ,pkg-source)
(package->code pkg))
@ -136,4 +155,8 @@
`(define-public test ,pkg-with-origin-patch-source)
(package->code pkg-with-origin-patch))
(test-equal "package with arguments"
`(define-public test ,pkg-with-arguments-source)
(package->code pkg-with-arguments))
(test-end "print")