From 6980511b7391e65a307689f90e4ef5c1979e4541 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 28 Jul 2016 18:50:43 +0200 Subject: [PATCH] packages: Add 'hidden-package'. * guix/packages.scm (hidden-package, hidden-package?): New procedures. * gnu/packages.scm (fold-packages): Filter out 'hidden-package?'. * tests/packages.scm ("hidden-package"): New test. --- gnu/packages.scm | 3 ++- guix/packages.scm | 15 +++++++++++++++ tests/packages.scm | 4 ++++ 3 files changed, 21 insertions(+), 1 deletion(-) diff --git a/gnu/packages.scm b/gnu/packages.scm index 9496a270eb..68a9eef2ad 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -200,7 +200,8 @@ same package twice." (fold2 (lambda (module result seen) (fold2 (lambda (var result seen) (if (and (package? var) - (not (vhash-assq var seen))) + (not (vhash-assq var seen)) + (not (hidden-package? var))) (values (proc var result) (vhash-consq var #t seen)) (values result seen))) diff --git a/guix/packages.scm b/guix/packages.scm index bfb4c557ab..3646b9ba13 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -81,6 +81,8 @@ package-maintainers package-properties package-location + hidden-package + hidden-package? package-field-location package-direct-sources @@ -290,6 +292,19 @@ name of its URI." package) 16))))) +(define (hidden-package p) + "Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus, +user interfaces, ignores." + (package + (inherit p) + (properties `((hidden? . #t) + ,@(package-properties p))))) + +(define (hidden-package? p) + "Return true if P is \"hidden\"--i.e., must not be visible to user +interfaces." + (assoc-ref (package-properties p) 'hidden?)) + (define (package-field-location package field) "Return the source code location of the definition of FIELD for PACKAGE, or #f if it could not be determined." diff --git a/tests/packages.scm b/tests/packages.scm index fc75e38730..7c9ad05c21 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -79,6 +79,10 @@ (write (dummy-package "foo" (location #f))))))) +(test-assert "hidden-package" + (and (hidden-package? (hidden-package (dummy-package "foo"))) + (not (hidden-package? (dummy-package "foo"))))) + (test-assert "package-field-location" (let () (define (goto port line column)