diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-06-30 16:00:37 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-07-11 00:49:16 +0200 |
commit | ff992fcfaf8455910b4bb5e02861fe9ae3dfd974 (patch) | |
tree | 798469901f98196307940907845d814589c2553f /guix/import | |
parent | aa6921634b4ea9988af0e37bfbb56780c431ef64 (diff) |
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.
Diffstat (limited to 'guix/import')
-rw-r--r-- | guix/import/print.scm | 57 |
1 files changed, 39 insertions, 18 deletions
diff --git a/guix/import/print.scm b/guix/import/print.scm index dcc38abc70..77492e222c 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. ;;; @@ -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,21 +113,33 @@ when evaluated." ,@(if (null? patches) '() `((patches (search-patches ,@(map basename patches)))))))) - (define (package-lists->code lsts) - (list 'quasiquote - (map (match-lambda - ((? symbol? s) - (list (symbol->string s) (list 'unquote s))) - ((label 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)))) - 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 + ((label 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)))) + 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)))) |