From 65a2b4c7c7818d1ddfc47feacaca452844be3c0b Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sat, 9 Apr 2022 00:42:58 +0530
Subject: utils: Add with-manifest.

* guix/forge/utils.scm: Import (guix modules).
(with-manifest): New function.
---
 guix/forge/utils.scm | 35 ++++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

(limited to 'guix/forge/utils.scm')

diff --git a/guix/forge/utils.scm b/guix/forge/utils.scm
index dd980ef..f23f763 100644
--- a/guix/forge/utils.scm
+++ b/guix/forge/utils.scm
@@ -21,11 +21,44 @@
   #:use-module (ice-9 match)
   #:use-module (guix derivations)
   #:use-module (guix gexp)
+  #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix profiles)
   #:use-module (guix search-paths)
   #:use-module (guix store)
-  #:export (with-packages))
+  #:export (with-manifest
+            with-packages))
+
+(define (with-manifest manifest exp)
+  "Return a gexp executing EXP, another gexp, in a profile defined by
+MANIFEST."
+  (with-imported-modules (source-module-closure '((guix search-paths)))
+    #~(begin
+        ;; Set the environment.
+        ;; We pull out match-lambda using module-ref instead of using
+        ;; use-modules because this gexp will be substituted into other
+        ;; gexps and use-modules only works at the top-level.
+        (let-syntax ((match-lambda (macro-transformer
+                                    (module-ref (resolve-module '(ice-9 match))
+                                                'match-lambda))))
+          (let ((evaluate-search-paths (@@ (guix search-paths) evaluate-search-paths))
+                (search-path-specification-variable (@@ (guix search-paths)
+                                                        search-path-specification-variable))
+                (sexp->search-path-specification (@@ (guix search-paths)
+                                                     sexp->search-path-specification)))
+            (for-each (match-lambda
+                        ((specification . value)
+                         (setenv (search-path-specification-variable specification)
+                                 value)))
+                      (evaluate-search-paths
+                       (map sexp->search-path-specification
+                            '#$(map search-path-specification->sexp
+                                    (manifest-search-paths manifest)))
+                       (list #$(profile
+                                (content manifest)
+                                (allow-collisions? #t)))))))
+        ;; Run the provided expression.
+        #$exp)))
 
 (define (profile-with-packages packages)
   "Return profile with PACKAGES."
-- 
cgit v1.2.3