guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#50960] [PATCH 04/10] DRAFT shell: By default load the local 'guix.s


From: Ludovic Courtès
Subject: [bug#50960] [PATCH 04/10] DRAFT shell: By default load the local 'guix.scm' or 'manifest.scm' file.
Date: Sat, 2 Oct 2021 12:22:34 +0200

DRAFT: Add doc.

* guix/scripts/shell.scm (parse-args): Add call to 'auto-detect-manifest'.
(find-file-in-parent-directories, auto-detect-manifest): New procedures.
* tests/guix-shell.sh: Add test.
---
 guix/scripts/shell.scm | 44 ++++++++++++++++++++++++++++++++++++++++--
 tests/guix-shell.sh    | 16 +++++++++++++++
 2 files changed, 58 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 6a4b7a5092..2f15befbd3 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -22,6 +22,8 @@
   #:autoload   (guix scripts build) (show-build-options-help)
   #:autoload   (guix transformations) (show-transformation-options-help)
   #:use-module (guix scripts)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
@@ -121,13 +123,51 @@ interactive shell in that environment.\n"))
   ;; The '--' token is used to separate the command to run from the rest of
   ;; the operands.
   (let ((args command (break (cut string=? "--" <>) args)))
-    (let ((opts (parse-command-line args %options (list %default-options)
-                                    #:argument-handler handle-argument)))
+    (let ((opts (auto-detect-manifest
+                 (parse-command-line args %options (list %default-options)
+                                     #:argument-handler handle-argument))))
       (match command
         (() opts)
         (("--") opts)
         (("--" command ...) (alist-cons 'exec command opts))))))
 
+(define (find-file-in-parent-directories candidates)
+  "Find one of CANDIDATES in the current directory or one of its ancestors."
+  (let loop ((directory (getcwd)))
+    (and (= (stat:uid (stat directory)) (getuid))
+         (or (any (lambda (candidate)
+                    (let ((candidate (string-append directory "/" candidate)))
+                      (and (file-exists? candidate) candidate)))
+                  candidates)
+             (loop (string-append directory "/..")))))) ;Unix ".." resolution
+
+(define (auto-detect-manifest opts)
+  "If OPTS do not specify packages or a manifest, load a \"guix.scm\" or
+\"manifest.scm\" file from the current directory or one of its ancestors.
+Return the modified OPTS."
+  (define (options-contain-payload? opts)
+    (match opts
+      (() #f)
+      ((('package . _) . _) #t)
+      ((('load . _) . _) #t)
+      ((('manifest . _) . _) #t)
+      ((('expression . _) . _) #t)
+      ((_ . rest) (options-contain-payload? rest))))
+
+  (if (options-contain-payload? opts)
+      opts
+      (match (find-file-in-parent-directories '("guix.scm" "manifest.scm"))
+        (#f
+         (warning (G_ "no packages specified; creating an empty 
environment~%"))
+         opts)
+        (file
+         (info (G_ "loading environment from '~a'...~%") file)
+         (match (basename file)
+           ("guix.scm"
+            (alist-cons 'load `(package ,file) opts))
+           ("manifest.scm"
+            (alist-cons 'manifest file opts)))))))
+
 
 (define-command (guix-shell . args)
   (category development)
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index f08637f7ff..498c1c5515 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -31,6 +31,16 @@ guix shell --bootstrap --pure guile-bootstrap -- guile 
--version
 # '--ad-hoc' is a thing of the past.
 ! guix shell --ad-hoc guile-bootstrap
 
+# Honoring the local 'manifest.scm' file.
+cat > "$tmpdir/manifest.scm" <<EOF
+(specifications->manifest '("guile-bootstrap"))
+EOF
+profile1="$(cd "$tmpdir"; guix shell --bootstrap -- "$SHELL" -c 'echo 
$GUIX_ENVIRONMENT')"
+profile2="$(guix shell --bootstrap guile-bootstrap -- "$SHELL" -c 'echo 
$GUIX_ENVIRONMENT')"
+test -n "$profile1"
+test "$profile1" = "$profile2"
+rm "$tmpdir/manifest.scm"
+
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
     # Compute the build environment for the initial GNU Make.
@@ -51,4 +61,10 @@ then
 
     # 'make-boot0' itself must not be listed.
     ! guix gc --references "$profile" | grep make-boot0
+
+    # Honoring the local 'guix.scm' file.
+    echo '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/guix.scm"
+    (cd "$tmpdir"; guix shell --bootstrap --search-paths --pure > "b")
+    cmp "$tmpdir/a" "$tmpdir/b"
+    rm "$tmpdir/guix.scm"
 fi
-- 
2.33.0






reply via email to

[Prev in Thread] Current Thread [Next in Thread]