bug#53210: [WIP PATCH 3/4] gnu: current-guix: Support when running outside a checkout.

[Josselin Poiret via Bug reports for GNU Guix <bug-guix@gnu.org>]

* guix/channels.scm (channel-build-system): Add build system that
turns a channel record into a package.
* gnu/packages/package-management.scm (current-guix): Use
channel-build-system.
---
 gnu/packages/package-management.scm | 45 +++++++++++++++++++++--------
 guix/channels.scm                   | 23 +++++++++++++++
 2 files changed, 56 insertions(+), 12 deletions(-)

diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 35913e6153..fe906fd440 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -116,10 +116,14 @@ (define-module (gnu packages package-management)
   #:use-module (guix build-system trivial)
   ;; This will be loaded by build-self.scm, but guile-git is unavailable, so
   ;; lazily load instead.
-  #:autoload (guix channels) (channel-build-system guix-channel?)
+  #:autoload (guix channels) (channel-profile-build-system
+                              channel-build-system
+                              guix-channel?)
+  #:use-module (guix describe)
   #:use-module (guix download)
   #:use-module (guix gexp)
   #:use-module (guix git-download)
+  #:autoload (guix git) (git-checkout)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
   #:use-module (guix utils)
@@ -588,6 +592,18 @@ (define-public channel-source->profile-package
       (native-inputs '())
       (propagated-inputs '()))))
 
+(define-public channel->package
+  (lambda (channel)
+    "Return a package for the given CHANNEL."
+    (package
+      (inherit guix)
+      (version (string-append (package-version guix) "+"))
+      (build-system channel-build-system)
+      (arguments `(#:channel ,channel))
+      (inputs '())
+      (native-inputs '())
+      (propagated-inputs '()))))
+
 (define-public current-guix-package
   ;; This parameter allows callers to override the package that 'current-guix'
   ;; returns.  This is useful when 'current-guix' cannot compute it by itself,
@@ -595,22 +611,27 @@ (define-public current-guix-package
   (make-parameter #f))
 
 (define-public current-guix
-  (let* ((repository-root (delay (canonicalize-path
-                                  (string-append (current-source-directory)
-                                                 "/../.."))))
-         (select? (delay (or (git-predicate (force repository-root))
-                             source-file?))))
-    (lambda ()
-      "Return a package representing Guix built from the current source tree.
-This works by adding the current source tree to the store (after filtering it
-out) and returning a package that uses that as its 'source'."
+  (lambda ()
+    "Return a package representing Guix built from the currently used one.
+This works by either looking up profile or build metadata, and building from
+the current Guix channel.  If that metadata is missing, assume we are running
+from a Git checkout, so add the current source tree to the store (after
+filtering it out) and return a package that uses that as its 'source'."
+    (let* ((guix-channel (find guix-channel? (current-channels)))
+           (repository-root (canonicalize-path
+                             (string-append (current-source-directory)
+                                            "/../..")))
+           (select? (or (git-predicate  repository-root)
+                        source-file?)))
       (or (current-guix-package)
+          (and guix-channel
+               (channel->package guix-channel))
           (package
             (inherit guix)
             (version (string-append (package-version guix) "+"))
-            (source (local-file (force repository-root) "guix-current"
+            (source (local-file repository-root "guix-current"
                                 #:recursive? #t
-                                #:select? (force select?))))))))
+                                #:select? select?)))))))
 
 (define-public guix-icons
   (package
diff --git a/guix/channels.scm b/guix/channels.scm
index 01f63d9631..c930fd2ae7 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -94,6 +94,7 @@ (define-module (guix channels)
             channel-instances->derivation
             ensure-forward-channel-update
 
+            channel-build-system
             channel-profile-build-system
 
             profile-channels
@@ -955,6 +956,28 @@ (define* (latest-channel-derivation #:optional (channels %default-channels)
                                                   validate-pull)))
     (channel-instances->derivation instances)))
 
+(define channel-build-system
+  ;; Build system used to "convert" a channel to a package.
+  (let* ((build (lambda* (name inputs
+                               #:key channel system
+                               #:allow-other-keys)
+                  (mlet* %store-monad ((instance
+                                        ((store-lift latest-channel-instance)
+                                         channel
+                                         #:authenticate? #f
+                                         #:validate-pull (lambda (. rest) #t))))
+                    (build-from-source instance #:system system))))
+         (lower (lambda* (name #:key system channel
+                               #:allow-other-keys)
+                  (bag
+                    (name name)
+                    (system system)
+                    (build build)
+                    (arguments `(#:channel ,channel))))))
+    (build-system (name 'channel)
+                  (description "Turn a channel into a package.")
+                  (lower lower))))
+
 (define channel-profile-build-system
   ;; Build system used to "convert" a channel instance to a profile, in
   ;; package form.
-- 
2.34.0