From f77bcbc374bb94272c57508dc04fb8599b56a9d8 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Fri, 24 Apr 2015 07:57:51 -0500 Subject: guix: packages: Add package-direct-sources and package-transitive-sources. * guix/tests.scm (dummy-origin): New syntax. * guix/packages.scm (package-direct-sources) (package-transitive-sources): New procedures. * tests/packages.scm ("package-direct-sources, no source") ("package-direct-sources, #f source") ("package-direct-sources, not input source", "package-direct-sources") ("package-transitive-sources"): Test them. --- guix/packages.scm | 24 ++++++++++++++++++++++++ guix/tests.scm | 10 +++++++++- 2 files changed, 33 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index b7a1979a7d..d7fced8384 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -83,6 +83,8 @@ package-location package-field-location + package-direct-sources + package-transitive-sources package-direct-inputs package-transitive-inputs package-transitive-target-inputs @@ -540,6 +542,28 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." ((input rest ...) (loop rest (cons input result)))))) +(define (package-direct-sources package) + "Return all source origins associated with PACKAGE; including origins in +PACKAGE's inputs." + `(,@(or (and=> (package-source package) list) '()) + ,@(filter-map (match-lambda + ((_ (? origin? orig) _ ...) + orig) + (_ #f)) + (package-direct-inputs package)))) + +(define (package-transitive-sources package) + "Return PACKAGE's direct sources, and their direct sources, recursively." + (delete-duplicates + (concatenate (filter-map (match-lambda + ((_ (? origin? orig) _ ...) + (list orig)) + ((_ (? package? p) _ ...) + (package-direct-sources p)) + (_ #f)) + (bag-transitive-inputs + (package->bag package)))))) + (define (package-direct-inputs package) "Return all the direct inputs of PACKAGE---i.e, its direct inputs along with their propagated inputs." diff --git a/guix/tests.scm b/guix/tests.scm index 080ee9cc74..87e6cc2830 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -37,7 +37,8 @@ %substitute-directory with-derivation-narinfo with-derivation-substitute - dummy-package)) + dummy-package + dummy-origin)) ;;; Commentary: ;;; @@ -219,6 +220,13 @@ initialized with default values, and with EXTRA-FIELDS set as specified." (synopsis #f) (description #f) (home-page #f) (license #f))) +(define-syntax-rule (dummy-origin extra-fields ...) + "Return a \"dummy\" origin, with all its compulsory fields initialized with +default values, and with EXTRA-FIELDS set as specified." + (origin extra-fields ... + (method #f) (uri "http://www.example.com") + (sha256 (base32 (make-string 52 #\x))))) + ;; Local Variables: ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1) ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2) -- cgit v1.2.3