[bug#40373] [PATCH] guix: new command "guix run-script"

[Konrad Hinsen]

* guix/scripts/run-script.scm: New file.
* Makefile.am: (MODULES): Add it.
* doc/guix.texi: Document "guix run-script"
---
 Makefile.am                 |   1 +
 doc/guix.texi               |  32 +++++++++++
 guix/scripts/run-script.scm | 105 ++++++++++++++++++++++++++++++++++++
 3 files changed, 138 insertions(+)
 create mode 100644 guix/scripts/run-script.scm

diff --git a/Makefile.am b/Makefile.am
index 344ecdbc42..28ac7344e8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -283,6 +283,7 @@ MODULES =                                   \
   guix/scripts/container/exec.scm              \
   guix/scripts/deploy.scm                      \
   guix/scripts/time-machine.scm                        \
+  guix/scripts/run-script.scm                  \
   guix.scm                                     \
   $(GNU_SYSTEM_MODULES)
 
diff --git a/doc/guix.texi b/doc/guix.texi
index 8cb85fe62c..0a64af24dc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -235,6 +235,7 @@ Programming Interface
 * The Store Monad::             Purely functional interface to the store.
 * G-Expressions::               Manipulating build expressions.
 * Invoking guix repl::          Fiddling with Guix interactively.
+* Invoking guix run-script::    Running Guix scripts.
 
 Defining Packages
 
@@ -5347,6 +5348,7 @@ package definitions.
 * The Store Monad::             Purely functional interface to the store.
 * G-Expressions::               Manipulating build expressions.
 * Invoking guix repl::          Fiddling with Guix interactively.
+* Invoking guix run-script::    Running Guix scripts.
 @end menu
 
 @node Package Modules
@@ -8121,6 +8123,36 @@ Inhibit loading of the @file{~/.guile} file.  By 
default, that
 configuration file is loaded when spawning a @code{guile} REPL.
 @end table
 
+@node Invoking guix run-script
+@section Invoking @command{guix run-script}
+
+@cindex script
+
+The @command{guix run-script} command executes a Guile script
+(@pxref{Running Guile Scripts,,, guile, GNU Guile Reference Manual}).
+Compared to just launching the @command{guile} command,
+@command{guix run-script} guarantees that all the Guix modules
+and all its dependencies are available in the search path.
+
+The general syntax is:
+
+@example
+guix run-script @var{options} @var{file}
+@end example
+
+The available options are as follows:
+
+@table @code
+@item --load-path=@var{directory}
+@itemx -L @var{directory}
+Add @var{directory} to the front of the package module search path
+(@pxref{Package Modules}).
+
+@item -q
+Inhibit loading of the @file{~/.guile} file.  By default, that
+configuration file is loaded before executing the script.
+@end table
+
 @c *********************************************************************
 @node Utilities
 @chapter Utilities
diff --git a/guix/scripts/run-script.scm b/guix/scripts/run-script.scm
new file mode 100644
index 0000000000..2e0ef2aff3
--- /dev/null
+++ b/guix/scripts/run-script.scm
@@ -0,0 +1,105 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Konrad Hinsen <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts run-script)
+  #:use-module (guix ui)
+  #:use-module (guix scripts)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (ice-9 match)
+  #:export (guix-run-script))
+
+;;; Commentary:
+;;;
+;;; This command allows to run Guile scripts in an environment
+;;; that contains all the modules comprising Guix.
+
+(define %default-options
+  '())
+
+(define %options
+  (list (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix run-script")))
+        (option '(#\q) #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'ignore-dot-guile? #t result)))
+        (option '(#\L "load-path") #t #f
+                (lambda (opt name arg result)
+                  ;; XXX: Imperatively modify the search paths.
+                  (set! %load-path (cons arg %load-path))
+                  (set! %load-compiled-path (cons arg %load-compiled-path))
+                  result))))
+
+
+(define (show-help)
+  (display (G_ "Usage: guix run-script [OPTIONS...] FILE
+Run FILE as a Guile script in the Guix execution environment.\n"))
+  (display (G_ "
+  -q                     inhibit loading of ~/.guile"))
+  (newline)
+  (display (G_ "
+  -L, --load-path=DIR    prepend DIR to the package module search path"))
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define user-module
+  ;; Module where we execute user code.
+  (let ((module (resolve-module '(guix-user) #f #f #:ensure #t)))
+    (beautify-user-module! module)
+    module))
+
+
+(define (guix-run-script . args)
+  (define opts
+    (args-fold* args %options
+                (lambda (opt name arg result)
+                  (leave (G_ "~A: unrecognized option~%") name))
+                (lambda (arg result)
+                  (when (assq 'argument result)
+                    (leave (G_ "~A: extraneous argument~%") arg))
+                  (alist-cons 'argument arg result))
+                %default-options))
+
+  (define script
+    (or (assq-ref opts 'argument)
+        (leave (G_ "no script filename specified~%"))))
+
+  (define user-config
+    (and=> (getenv "HOME")
+           (lambda (home)
+             (string-append home "/.guile"))))
+
+  (with-error-handling
+    (save-module-excursion
+     (lambda ()
+       (set-current-module user-module)
+       (when (and (not (assoc-ref opts 'ignore-dot-guile?))
+                  user-config
+                  (file-exists? user-config))
+         (load user-config))
+       (load script)))))
-- 
2.26.0