From 3e223a22a70138b8c57e742ad8ec737131249820 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 25 Jan 2019 10:05:31 +0100
Subject: packages: Add 'package-closure'.

* guix/packages.scm (package-closure): New procedure.
* tests/packages.scm ("package-closure"): New test.
---
 guix/packages.scm | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index e4c2ac3be5..f191327718 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -133,6 +133,7 @@
             bag-transitive-host-inputs
             bag-transitive-build-inputs
             bag-transitive-target-inputs
+            package-closure
 
             default-guile
             default-guile-derivation
@@ -798,6 +799,28 @@ dependencies are known to build on SYSTEM."
   "Return the \"target inputs\" of BAG, recursively."
   (transitive-inputs (bag-target-inputs bag)))
 
+(define* (package-closure packages #:key (system (%current-system)))
+  "Return the closure of PACKAGES on SYSTEM--i.e., PACKAGES and the list of
+packages they depend on, recursively."
+  (let loop ((packages packages)
+             (visited  vlist-null)
+             (closure  (list->setq packages)))
+    (match packages
+      (()
+       (set->list closure))
+      ((package . rest)
+       (if (vhash-assq package visited)
+           (loop rest visited closure)
+           (let* ((bag          (package->bag package system))
+                  (dependencies (filter-map (match-lambda
+                                              ((label (? package? package) . _)
+                                               package)
+                                              (_ #f))
+                                            (bag-direct-inputs bag))))
+             (loop (append dependencies rest)
+                   (vhash-consq package #t visited)
+                   (fold set-insert closure dependencies))))))))
+
 (define* (package-mapping proc #:optional (cut? (const #f)))
   "Return a procedure that, given a package, applies PROC to all the packages
 depended on and returns the resulting package.  The procedure stops recursion
-- 
cgit v1.2.3