[bug#48277] [PATCH 1/1] guix: search-paths: Add wrap-in-search-paths

[Edouard Klein]

From: edk@beaver-labs.com

---
 guix/search-paths.scm | 35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/guix/search-paths.scm b/guix/search-paths.scm
index 002e6342bb..34a632077c 100644
--- a/guix/search-paths.scm
+++ b/guix/search-paths.scm
@@ -18,6 +18,8 @@
 
 (define-module (guix search-paths)
   #:use-module (guix records)
+  #:use-module (guix profiles)
+  #:use-module (guix gexp)
   #:use-module (guix build utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -35,6 +37,8 @@
 
             search-path-specification->sexp
             sexp->search-path-specification
+            esps->wrap-sexp
+            wrap-in-search-paths
             string-tokenize*
             evaluate-search-paths
             environment-variable-definition
@@ -96,6 +100,37 @@ a <search-path-specification> object."
   (with-error-to-port (%make-void-port "w")
     (lambda () exp)))
 
+(define (esps->wrap-sexp esps)
+  "Return a list '(VARIABLE POSITION (STRING)) as expected by wrap-program, 
converted from the evaluated search-path-specification ESPS.
+
+     An evaluated search-path-specification is the type of things returned in 
a list by evaluate-search-paths: (sps . string) couples.
+
+     We do abuse wrap-program a bit, because it expects a list of directories, 
and the string we return is already a concatenation of the relevant 
directories. There would be no point in splitting it again and then having 
wrap-program joining it again, so we just pass it as is."
+  (match esps
+         ((sps . str) `(,(search-path-specification-variable sps) = (,str)))))
+
+(define (wrap-in-search-paths exec packages)
+  "Wrap EXEC in a script that will set the search paths to the values needed 
by the list of package PACKAGES."
+  (define (reconstruct-sps sps)
+    "Return a G-exp that evaluates, on the build strata, to the 
search-path-specification SPS."
+    #~(search-path-specification
+       (variable     #$(search-path-specification-variable sps))
+       (files        (list #$@(search-path-specification-files sps)))
+       (separator    #$(search-path-specification-separator sps))
+       (file-type    (quote #$(search-path-specification-file-type sps)))
+       (file-pattern #$(search-path-specification-file-pattern sps))))
+
+  (define (reconstruct-sps-list spsl)
+    "Return a G-exp that evaluates, on the build strata, to the list of 
search-path-specifications SPSL."
+    #~(list #$@(map reconstruct-sps spsl)))
+
+  (let ((manifest (packages->manifest packages)))
+    #~(apply wrap-program #$exec
+             (map esps->wrap-sexp
+                  (evaluate-search-paths
+                   #$(reconstruct-sps-list (manifest-search-paths manifest))
+                   (list #$@(map manifest-entry-item 
(manifest-transitive-entries manifest))))))))
+
 ;; XXX: This procedure used to be in (guix utils) but since we want to be able
 ;; to use (guix search-paths) on the build side, we want to avoid the
 ;; dependency on (guix utils), and so this procedure is back here for now.
-- 
2.31.1