[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#53210: [WIP PATCH 3/4] gnu: current-guix: Support when running outsi
From: |
Josselin Poiret |
Subject: |
bug#53210: [WIP PATCH 3/4] gnu: current-guix: Support when running outside a checkout. |
Date: |
Mon, 14 Feb 2022 10:29:07 +0100 |
* 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