Subject: [PATCH] fix: correct emacs-guix not finding packages from user channels

From: Sergio Pastor Pérez <[email-masked]>
Date: Fri, 6 Oct 2023 18:52:54 +0200

---
Hi.

I've noticed that `emacs-guix' is not able to fetch packages from user
channels. This is a quick fix that could be implemented much easier with some
help.

As you can see, there is lots of redundant code from modules of the guix core,
such as: 'gnu/packages.scm' as well as 'guix/describe.scm'.

The issue is that neither of the functions exposed, which are used on the call
hierarchy, accept a parameter for targeting a profile so all this functions need
to be reimplemented to change the lowest function on the call hierarchy.

I thought of using:
--8<---------------cut here---------------start------------->8---
(module-define! (resolve-module '(guix describe)) 'current-profile
  (lambda ()
      "Return the profile (created by 'guix pull') the calling process lives in,
  or #f if this is not applicable."
      (find (lambda (str)
              (string-contains str "current-guix"))
            (user-profiles))))
--8<---------------cut here---------------end--------------->8---

But this is not possible since most of the functions up in the call hierarchy
are memoized with `mlambda'.

For now this is what I'm using for myself. I submit this patch hopping that someone will have a more elegant solution.

Will it be okay to redefine the functions from the guix core into generic ones
that accept a profile as a parameter?

The ones we have could just call the more generic one with a specific parameter
so they will be the 'curried' versions.

What do you think? Any ideas?

Have a nice day,
Sergio.

 scheme/emacs-guix/packages.scm | 14 ++++--
 scheme/emacs-guix/profiles.scm | 79 +++++++++++++++++++++++++++++++++-
 2 files changed, 88 insertions(+), 5 deletions(-)

diff --git a/scheme/emacs-guix/packages.scm b/scheme/emacs-guix/packages.scm
index aba04d8..928a99d 100644
--- a/scheme/emacs-guix/packages.scm
+++ b/scheme/emacs-guix/packages.scm
@@ -338,6 +340,7 @@ See `fold-packages' for the meaning of SELECT?."
                        (cons pkg res)
                        res))
                  '()
+                 all-current-guix-package-modules
                  #:select? select?))
 
 (define (filter-packages-by-output packages output)
@@ -783,7 +786,8 @@ get information with all available parameters, which are: 'id', 'name',
   "Return a list of names of available packages."
   (fold-packages (lambda (pkg res)
                    (cons (package-name pkg) res))
-                 '()))
+                 '()
+                 all-current-guix-package-modules))
 
 (define (package-names*)
   "Return to emacs side a list of names of available packages."
@@ -792,7 +796,8 @@ get information with all available parameters, which are: 'id', 'name',
 (define (number-of-packages)
   "Return the number of available packages."
   (fold-packages (lambda (_ sum) (1+ sum))
-                 0))
+                 0
+                 all-current-guix-package-modules))
 
 
 ;;; Package locations
@@ -809,7 +814,8 @@ get information with all available parameters, which are: 'id', 'name',
                           (let ((file (location-file
                                        (package-location package))))
                             (vhash-cons file package table)))
-                        vlist-null)))
+                        vlist-null
+                        all-current-guix-package-modules)))
          (files (delay (vhash-fold
                         (lambda (file _ result)
                           (if (member file result)
diff --git a/scheme/emacs-guix/profiles.scm b/scheme/emacs-guix/profiles.scm
index 4792b25..5c9b224 100644
--- a/scheme/emacs-guix/profiles.scm
+++ b/scheme/emacs-guix/profiles.scm
@@ -27,6 +27,12 @@
 (define-module (emacs-guix profiles)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-71)
+  #:use-module ((gnu packages)
+                #:select (%default-package-module-path))
+  #:use-module ((guix discovery)
+                #:select (all-modules))
+  #:use-module (guix memoization)
   #:use-module (guix profiles)
   #:use-module (guix search-paths)
   #:use-module ((guix scripts package)
@@ -39,7 +45,8 @@
             manifest-entry-dependencies-file-names
             search-paths-specifications
             search-paths
-            user-profiles))
+            user-profiles
+            all-current-guix-package-modules))
 
 
 ;;; Manifest entries
@@ -154,4 +161,74 @@ Each specification is (VARIABLE SEPARATOR PATH) list."
                       (generation-profile root)))
                (gc-roots))))
 
+(define current-guix-profile
+  (mlambda ()
+    "Return the profile (created by 'guix pull') the calling process lives in,
+or #f if this is not applicable."
+    (find (lambda (str)
+            (string-contains str "current-guix"))
+          (user-profiles))))
+
+(define current-guix-profile-entries
+  (mlambda ()
+    "Return the list of entries in the 'guix pull' profile the calling process
+lives in, or the empty list if this is not applicable."
+    (match (current-guix-profile)
+      (#f '())
+      (profile
+       (let ((manifest (profile-manifest profile)))
+         (manifest-entries manifest))))))
+
+(define current-guix-channel-entries
+  (mlambda ()
+    "Return manifest entries corresponding to extra channels--i.e., not the
+'guix' channel."
+    (remove (lambda (entry)
+              (or (string=? (manifest-entry-name entry) "guix")
+
+                  ;; If ENTRY lacks the 'source' property, it's not an entry
+                  ;; from 'guix pull'.  See <https://bugs.gnu.org/48778>.
+                  (not (assq 'source (manifest-entry-properties entry)))))
+            (current-guix-profile-entries))))
+
+(define (current-guix-package-path-entries)
+  "Return two values: the list of package path entries to be added to the
+package search path, and the list to be added to %LOAD-COMPILED-PATH.  These
+entries are taken from the 'guix pull' profile the calling process lives in,
+when applicable."
+  ;; Filter out Guix itself.
+  (unzip2 (map (lambda (entry)
+                 (list (string-append (manifest-entry-item entry)
+                                      "/share/guile/site/"
+                                      (effective-version))
+                       (string-append (manifest-entry-item entry)
+                                      "/lib/guile/" (effective-version)
+                                      "/site-ccache")))
+               (current-guix-channel-entries))))
+
+(define %current-guix-package-module-path
+  ;; Search path for package modules.  Each item must be either a directory
+  ;; name or a pair whose car is a directory and whose cdr is a sub-directory
+  ;; to narrow the search.
+  (let* ((not-colon   (char-set-complement (char-set #\:)))
+         (environment (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "")
+                                       not-colon))
+         (channels-scm channels-go (current-guix-package-path-entries)))
+    ;; Automatically add channels and items from $GUIX_PACKAGE_PATH to Guile's
+    ;; search path.  For historical reasons, $GUIX_PACKAGE_PATH goes to the
+    ;; front; channels go to the back so that they don't override Guix' own
+    ;; modules.
+    (set! %load-path
+          (append environment %load-path channels-scm))
+    (set! %load-compiled-path
+          (append environment %load-compiled-path channels-go))
+
+    (make-parameter
+     (append environment
+             %default-package-module-path
+             channels-scm))))
+
+(define all-current-guix-package-modules
+  (all-modules (%current-guix-package-module-path)))
+
 ;;; profiles.scm ends here
-- 
2.41.0