[bug#32759] [PATCH 5/8] inferior: Add 'inferior-package->manifest-entry'.

[Ludovic Courtès]

* guix/inferior.scm (inferior-package->manifest-entry): New procedure.
* tests/inferior.scm (manifest-entry->list): New procedure.
("inferior-package->manifest-entry"): New test.
---
 guix/inferior.scm  | 42 ++++++++++++++++++++++++++++++++++++++----
 tests/inferior.scm | 18 ++++++++++++++++++
 2 files changed, 56 insertions(+), 4 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 3fa493009..c86fdd3ec 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -33,6 +33,7 @@
                 #:select (read-derivation-from-file))
   #:use-module (guix gexp)
   #:use-module (guix search-paths)
+  #:use-module (guix profiles)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
@@ -45,12 +46,12 @@
             inferior-eval
             inferior-object?
 
+            inferior-packages
+            lookup-inferior-packages
+
             inferior-package?
             inferior-package-name
             inferior-package-version
-
-            inferior-packages
-            lookup-inferior-packages
             inferior-package-synopsis
             inferior-package-description
             inferior-package-home-page
@@ -62,7 +63,9 @@
             inferior-package-native-search-paths
             inferior-package-transitive-native-search-paths
             inferior-package-search-paths
-            inferior-package-derivation))
+            inferior-package-derivation
+
+            inferior-package->manifest-entry))
 
 ;;; Commentary:
 ;;;
@@ -441,3 +444,34 @@ PACKAGE must be live."
                                         target)
   ;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET.
   (inferior-package->derivation package system #:target target))
+
+
+;;;
+;;; Manifest entries.
+;;;
+
+(define* (inferior-package->manifest-entry package
+                                           #:optional (output "out")
+                                           #:key (parent (delay #f))
+                                           (properties '()))
+  "Return a manifest entry for the OUTPUT of package PACKAGE."
+  ;; For each dependency, keep a promise pointing to its "parent" entry.
+  (letrec* ((deps  (map (match-lambda
+                          ((label package)
+                           (inferior-package->manifest-entry package
+                                                             #:parent (delay 
entry)))
+                          ((label package output)
+                           (inferior-package->manifest-entry package output
+                                                             #:parent (delay 
entry))))
+                        (inferior-package-propagated-inputs package)))
+            (entry (manifest-entry
+                     (name (inferior-package-name package))
+                     (version (inferior-package-version package))
+                     (output output)
+                     (item package)
+                     (dependencies (delete-duplicates deps))
+                     (search-paths
+                      (inferior-package-transitive-native-search-paths 
package))
+                     (parent parent)
+                     (properties properties))))
+    entry))
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 99d736bd4..6f6abd28a 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -21,6 +21,7 @@
   #:use-module (guix inferior)
   #:use-module (guix packages)
   #:use-module (guix store)
+  #:use-module (guix profiles)
   #:use-module (guix derivations)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
@@ -38,6 +39,13 @@
 (define %store
   (open-connection-for-tests))
 
+(define (manifest-entry->list entry)
+  (list (manifest-entry-name entry)
+        (manifest-entry-version entry)
+        (manifest-entry-output entry)
+        (manifest-entry-search-paths entry)
+        (map manifest-entry->list (manifest-entry-dependencies entry))))
+
 
 (test-begin "inferior")
 
@@ -164,4 +172,14 @@
          (list (inferior-package-derivation %store guile "x86_64-linux")
                (inferior-package-derivation %store guile "armhf-linux")))))
 
+(test-equal "inferior-package->manifest-entry"
+  (manifest-entry->list (package->manifest-entry
+                         (first (find-best-packages-by-name "guile" #f))))
+  (let* ((inferior (open-inferior %top-builddir
+                                  #:command "scripts/guix"))
+         (guile    (first (lookup-inferior-packages inferior "guile")))
+         (entry    (inferior-package->manifest-entry guile)))
+    (close-inferior inferior)
+    (manifest-entry->list entry)))
+
 (test-end "inferior")
-- 
2.18.0