me
/
guix
Archived
1
0
Fork 0
Code

import: print: Emit new-style package inputs when possible. 

* guix/import/print.scm (redundant-input-labels?): New procedure.
(package->code)[package-lists->code]: Rename to...
[inputs->code]: ... this.  When 'redundant-input-labels?' returns true,
emit label-less inputs.  Adjust callers to new name.
* tests/print.scm (pkg-with-inputs): Adjust accordingly.
master
Ludovic Courtès 2021-06-30 16:00:37 +02:00
parent aa6921634b
commit ff992fcfaf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
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.
;;;
@ -30,6 +31,14 @@
#:use-module (ice-9 match)
#:export (package->code))
(define (redundant-input-labels? inputs)
"Return #t if input labels in the INPUTS list are redundant."
(every (match-lambda
((label (? package? package) . _)
(string=? label (package-name package)))
(_ #f))
inputs))
;; 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.
@ -104,11 +113,23 @@ when evaluated."
,@(if (null? patches) '()
`((patches (search-patches ,@(map basename patches))))))))
(define (package-lists->code lsts)
(define (inputs->code inputs)
(if (redundant-input-labels? inputs)
`(list ,@(map (match-lambda ;no need for input labels ("new style")
((_ package)
(let ((module (package-module-name package)))
`(@ ,module ,(variable-name package module))))
((_ package output)
(let ((module (package-module-name package)))
(list 'quasiquote
(list
(list 'unquote
`(@ ,module
,(variable-name package module)))
output)))))
inputs))
(list 'quasiquote ;preserve input labels (deprecated)
(map (match-lambda
((? symbol? s)
(list (symbol->string s) (list 'unquote s)))
((label pkg . out)
(let ((mod (package-module-name pkg)))
(cons* label
@ -118,7 +139,7 @@ when evaluated."
(list 'unquote
(list '@ mod (variable-name pkg mod)))
out))))
lsts)))
inputs))))
(let ((name (package-name package))
(version (package-version package))
@ -160,13 +181,13 @@ when evaluated."
(outs `((outputs (list ,@outs)))))
,@(match native-inputs
(() '())
(pkgs `((native-inputs ,(package-lists->code pkgs)))))
(pkgs `((native-inputs ,(inputs->code pkgs)))))
,@(match inputs
(() '())
(pkgs `((inputs ,(package-lists->code pkgs)))))
(pkgs `((inputs ,(inputs->code pkgs)))))
,@(match propagated-inputs
(() '())
(pkgs `((propagated-inputs ,(package-lists->code pkgs)))))
(pkgs `((propagated-inputs ,(inputs->code pkgs)))))
,@(if (lset= string=? supported-systems %supported-systems)
'()
`((supported-systems (list ,@supported-systems))))

4
tests/print.scm
View File

@ -60,8 +60,8 @@
(base32
"070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
(build-system (@ (guix build-system gnu) gnu-build-system))
(inputs `(("coreutils" ,(@ (gnu packages base) coreutils))
("glibc" ,(@ (gnu packages base) glibc) "debug")))
(inputs (list (@ (gnu packages base) coreutils)
`(,(@ (gnu packages base) glibc) "debug")))
(home-page "http://gnu.org")
(synopsis "Dummy")
(description "This is a dummy package.")