From cf289d7cfa34315bf13b3114b9a5bf3d3c05ebea Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Tue, 5 Jan 2021 11:14:51 +0100
Subject: Discover extensions via GUIX_EXTENSIONS_PATH.

* guix/scripts.scm (%command-categories): Add extension category.
* guix/ui.scm (source-file-command): Also parse extensions files.
(command-files): Accept an optional directory argument.
(extension-directories): New procedure.
(commands): Use it.
(show-guix-help): Hide empty categories.
(run-guix-command): Try loading an extension if there is no matching Guix
command.
---
 guix/ui.scm | 65 +++++++++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 46 insertions(+), 19 deletions(-)

(limited to 'guix/ui.scm')

diff --git a/guix/ui.scm b/guix/ui.scm
index 0a1c9bd615..7f52518023 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2021,10 +2021,11 @@ optionally contain a version number and an output name, as in these examples:
 on the 'define-command' top-level form found therein, or #f if FILE does not
 contain a 'define-command' form."
   (define command-name
-    (match (string-split file #\/)
-      ((_ ... "guix" "scripts" name)
+    (match (filter (negate string-null?)
+                   (string-split file #\/))
+      ((_ ... "guix" (or "scripts" "extensions") name)
        (list (file-sans-extension name)))
-      ((_ ... "guix" "scripts" first second)
+      ((_ ... "guix" (or "scripts" "extensions") first second)
        (list first (file-sans-extension second)))))
 
   ;; The strategy here is to parse FILE.  This is much cheaper than a
@@ -2046,24 +2047,34 @@ contain a 'define-command' form."
           (_
            (loop)))))))
 
-(define (command-files)
+(define* (command-files #:optional directory)
   "Return the list of source files that define Guix sub-commands."
-  (define directory
-    (and=> (search-path %load-path "guix.scm")
-           (compose (cut string-append <> "/guix/scripts")
-                    dirname)))
+  (define directory*
+    (or directory
+        (and=> (search-path %load-path "guix.scm")
+               (compose (cut string-append <> "/guix/scripts")
+                        dirname))))
 
   (define dot-scm?
     (cut string-suffix? ".scm" <>))
 
-  (if directory
-      (map (cut string-append directory "/" <>)
-           (scandir directory dot-scm?))
+  (if directory*
+      (map (cut string-append directory* "/" <>)
+           (scandir directory* dot-scm?))
       '()))
 
+(define (extension-directories)
+  "Return the list of directories containing Guix extensions."
+  (filter file-exists?
+          (parse-path
+           (getenv "GUIX_EXTENSIONS_PATH"))))
+
 (define (commands)
   "Return the list of commands, alphabetically sorted."
-  (filter-map source-file-command (command-files)))
+  (filter-map source-file-command
+              (append (command-files)
+                      (append-map command-files
+                                  (extension-directories)))))
 
 (define (show-guix-help)
   (define (internal? command)
@@ -2098,9 +2109,14 @@ Run COMMAND with ARGS.\n"))
                 (('internal . _)
                  #t)                              ;hide internal commands
                 ((category . synopsis)
-                 (format #t "~%  ~a~%" (G_ synopsis))
-                 (display-commands (filter (category-predicate category)
-                                           commands))))
+                 (let ((relevant-commands (filter (category-predicate category)
+                                                  commands)))
+                   ;; Only print categories that contain commands.
+                   (match relevant-commands
+                     ((one . more)
+                      (format #t "~%  ~a~%" (G_ synopsis))
+                      (display-commands relevant-commands))
+                     (_ #f)))))
               categories))
   (show-bug-report-information))
 
@@ -2111,10 +2127,21 @@ found."
     (catch 'misc-error
       (lambda ()
         (resolve-interface `(guix scripts ,command)))
-      (lambda -
-        (format (current-error-port)
-                (G_ "guix: ~a: command not found~%") command)
-        (show-guix-usage))))
+      (lambda _
+        ;; Check if there is a matching extension.
+        (catch 'misc-error
+          (lambda ()
+            (match (search-path (extension-directories)
+                                (format #f "~a.scm" command))
+              (file
+               (load file)
+               (resolve-interface `(guix extensions ,command)))
+              (_
+               (throw 'misc-error))))
+          (lambda _
+            (format (current-error-port)
+                    (G_ "guix: ~a: command not found~%") command)
+            (show-guix-usage))))))
 
   (let ((command-main (module-ref module
                                   (symbol-append 'guix- command))))
-- 
cgit v1.2.3