nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix: packages: Add transitive-input-references. 

* guix/packages.scm (transitive-input-references): New procedure.
* gnu/packages/version-control.scm (package-transitive-propagated-labels*)
  (package-propagated-input-refs): Delete.
  (git)[arguments]: Adjust to transitive-input-references.
This commit is contained in:
Eric Bavier 2015-07-21 20:45:54 -05:00
parent 8b45993235
commit a6d0b306c2
3 changed files with 38 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gnu/packages/version-control.scm
View File

@ -98,24 +98,6 @@ changes to project files over time. It supports both a distributed workflow
as well as the classic centralized workflow.")
(license gpl2+)))
(define (package-transitive-propagated-labels* package)
"Return a list of the input labels of PACKAGE and its transitive inputs."
(let ((name (package-name package)))
`(,name
,@(map (match-lambda
((label (? package? _) . _)
label))
(package-transitive-propagated-inputs package)))))
(define (package-propagated-input-refs inputs packages)
"Return a list of (assoc-ref INPUTS <package-name>) for each package in
PACKAGES and their propagated inputs."
(map (lambda (l)
`(assoc-ref ,inputs ,l))
(delete-duplicates ;XXX: efficiency
(append-map package-transitive-propagated-labels*
packages))))
(define-public git
;; Keep in sync with 'git-manpages'!
(package
@ -238,11 +220,13 @@ PACKAGES and their propagated inputs."
`("PERL5LIB" ":" prefix
,(map (lambda (o) (string-append o "/lib/perl5/site_perl"))
(list
,@(package-propagated-input-refs
,@(transitive-input-references
'inputs
(list perl-authen-sasl
perl-net-smtp-ssl
perl-io-socket-ssl))))))
(map (lambda (l)
(assoc l (inputs)))
'("perl-authen-sasl"
"perl-net-smtp-ssl"
"perl-io-socket-ssl")))))))
;; Tell 'git-submodule' where Perl is.
(wrap-program git-sm

15
guix/packages.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -93,6 +94,8 @@
package-output
package-grafts
transitive-input-references
%supported-systems
%hydra-supported-systems
supported-package?
@ -579,6 +582,18 @@ for the host system (\"native inputs\"), and not target inputs."
recursively."
(transitive-inputs (package-propagated-inputs package)))
(define (transitive-input-references alist inputs)
"Return a list of (assoc-ref ALIST <label>) for each (<label> <package> . _)
in INPUTS and their transitive propagated inputs."
(define label
(match-lambda
((label . _)
label)))
(map (lambda (input)
`(assoc-ref ,alist ,(label input)))
(transitive-inputs inputs)))
(define-syntax define-memoized/v
(lambda (form)
"Define a memoized single-valued unary procedure with docstring.

17
tests/packages.scm
View File

@ -207,6 +207,23 @@
(member i s)
(member u s)))))
(test-assert "transitive-input-references"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"))
(c (dummy-package "c"
(inputs `(("a" ,a)))
(propagated-inputs `(("boo" ,b)))))
(d (dummy-package "d"
(inputs `(("c*" ,c)))))
(keys (map (match-lambda
(('assoc-ref 'l key)
key))
(pk 'refs (transitive-input-references
'l (package-inputs d))))))
(and (= (length keys) 2)
(member "c*" keys)
(member "boo" keys))))
(test-equal "package-transitive-supported-systems, implicit inputs"
%supported-systems