[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH v3 1/1] packages: Support for full Guix specification
From: |
Olivier Dion |
Subject: |
[PATCH v3 1/1] packages: Support for full Guix specification |
Date: |
Fri, 29 Apr 2022 14:02:47 -0400 |
Guix package specifications match:
PACKAGE [@VERSION] [:OUTPUT]
thus the following are all valid package specifications:
- "guile"
- "guile@3.0.8"
- "guile:debug"
- "guile@3.0.8:debug"
This is not currently supported by gwl. To do so, packages and their output are
wrapped in a <package-wrapper> record. The record can be unwrapped with
PACKAGE-UNWRAP to access the underlying Guix's package. Patterns matching is
used for dispatching of procedure such as PACKAGE-NATIVE-INPUTS or PACKAGE-NAME.
---
gwl/packages.scm | 96 +++++++++++++++++++++++++++++++++--------
gwl/processes.scm | 6 +--
gwl/workflows/graph.scm | 2 +-
3 files changed, 81 insertions(+), 23 deletions(-)
diff --git a/gwl/packages.scm b/gwl/packages.scm
index 6fe82d4..8016bd4 100644
--- a/gwl/packages.scm
+++ b/gwl/packages.scm
@@ -21,7 +21,9 @@
#:use-module ((guix store)
#:select (open-connection close-connection))
#:use-module ((guix packages)
- #:select (package? package-full-name))
+ #:select (package?
+ package-full-name
+ (package-native-inputs .
guix:package-native-inputs)))
#:use-module ((guix inferior)
#:select (open-inferior
inferior?
@@ -31,9 +33,13 @@
inferior-package-version
inferior-package-native-inputs
inferior-package-derivation))
+ #:use-module ((guix ui)
+ #:select (package-specification->name+version+output))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -43,11 +49,56 @@
lookup-package
valid-package?
package-name
+ package-unwrap
+ package->package+output
bash-minimal
build-time-guix
default-guile
- default-guile-derivation))
+ default-guile-derivation
+ guile-gcrypt))
+
+(define-record-type <package-wrapper>
+ (make-package-wrapper package output)
+ package-wrapper?
+ (package package-wrapper-package)
+ (output package-wrapper-output))
+
+(define package-native-inputs
+ (match-lambda
+ ((? package? pkg)
+ (package-native-inputs pkg))
+ ((? inferior-package? pkg)
+ (inferior-package-native-inputs pkg))
+ ((? package-wrapper? pkg)
+ (package-native-inputs (package-wrapper-package pkg)))))
+
+(define package-name
+ (match-lambda
+ ((? package? pkg)
+ (package-full-name pkg))
+ ((? inferior-package? pkg)
+ (inferior-package-full-name pkg))
+ ((? package-wrapper? pkg)
+ (package-name (package-wrapper-package pkg)))))
+
+(define package-unwrap
+ (match-lambda
+ ((or (? package? pkg)
+ (? inferior-package? pkg))
+ pkg)
+ ((? package-wrapper? pkg)
+ (package-wrapper-package pkg))))
+
+(define package->package+output
+ (match-lambda
+ ((or (? package? pkg)
+ (? inferior-package? pkg))
+ (list pkg "out"))
+ ((? package-wrapper? pkg)
+ (list
+ (package-wrapper-package pkg)
+ (package-wrapper-output pkg)))))
(define current-guix
(let ((current-guix-inferior #false))
@@ -73,15 +124,25 @@
(define (lookup-package specification)
(log-event 'guix (G_ "Looking up package `~a'~%") specification)
- (match (lookup-inferior-packages (current-guix) specification)
- ((first . rest) first)
- (_ (raise (condition
- (&gwl-package-error
- (package-spec specification)))))))
+ (let-values (((name version output)
+ (package-specification->name+version+output
+ specification)))
+ (let* ((inferior-package
+ (lookup-inferior-packages (current-guix)
+ name version))
+ (package (match inferior-package
+ ((first . rest) first)
+ (_ (raise (condition
+ (&gwl-package-error
+ (package-spec specification))))))))
+ (make-package-wrapper package output))))
(define (valid-package? val)
- (or (package? val)
- (inferior-package? val)))
+ (match val
+ ((or (? package?)
+ (? inferior-package?)
+ (? package-wrapper?)) #t)
+ (_ #f)))
;; Just like package-full-name from (guix packages) but for inferior
;; packages.
@@ -93,27 +154,24 @@ the version. By default, DELIMITER is \"@\"."
delimiter
(inferior-package-version inferior-package)))
-(define package-name
- (match-lambda
- ((? package? pkg)
- (package-full-name pkg))
- ((? inferior-package? pkg)
- (inferior-package-full-name pkg))))
-
(define bash-minimal
(mlambda ()
- (lookup-package "bash-minimal")))
+ (package-unwrap (lookup-package "bash-minimal"))))
+
+(define guile-gcrypt
+ (mlambda ()
+ (package-unwrap (lookup-package "guile-gcrypt"))))
(define build-time-guix
(mlambda ()
- (lookup-package "guix")))
+ (package-unwrap (lookup-package "guix"))))
(define default-guile
(mlambda ()
"Return the variant of Guile that was used to build the \"guix\"
package, which provides all library features used by the GWL. We use
this Guile to run scripts."
- (and=> (assoc-ref (inferior-package-native-inputs (build-time-guix))
+ (and=> (assoc-ref (package-native-inputs (build-time-guix))
"guile") first)))
(define (default-guile-derivation)
diff --git a/gwl/processes.scm b/gwl/processes.scm
index ce40d12..dd5ed02 100644
--- a/gwl/processes.scm
+++ b/gwl/processes.scm
@@ -611,7 +611,7 @@ tags if WITH-TAGS? is #FALSE or missing."
"Return a file that contains the list of references of ITEM."
(if (struct? item) ;lowerable object
(computed-file name
- (with-extensions (list (lookup-package "guile-gcrypt"))
;for store-copy
+ (with-extensions (list (guile-gcrypt)) ;for store-copy
(with-imported-modules (source-module-closure
'((guix build store-copy)))
#~(begin
@@ -643,7 +643,7 @@ PROCESS."
(let* ((name (process-full-name process))
(packages (cons (bash-minimal)
(process-packages process)))
- (manifest (packages->manifest packages))
+ (manifest (packages->manifest (map package->package+output
packages)))
(profile (profile (content manifest)))
(search-paths (delete-duplicates
(map search-path-specification->sexp
@@ -657,7 +657,7 @@ PROCESS."
(set-search-paths (map sexp->search-path-specification
',search-paths)
(cons ,profile
- ',packages))))
+ ',(map package-unwrap
packages)))))
#$(if out `(setenv "out" ,out) "")
(setenv "_GWL_PROFILE" #$profile)
(use-modules (ice-9 match))
diff --git a/gwl/workflows/graph.scm b/gwl/workflows/graph.scm
index ea3fec9..c435644 100644
--- a/gwl/workflows/graph.scm
+++ b/gwl/workflows/graph.scm
@@ -43,7 +43,7 @@ label=<<FONT POINT-SIZE=\"14\">~a</FONT><BR/>\
(take-color)
(string-upcase pretty-name)
(process-synopsis process)
- (match (process-packages process)
+ (match (map package-unwrap (process-packages process))
(() "")
(inputs (format #f "<BR/>Uses: ~{~a~^, ~}."
(map package-name inputs)))))))
--
2.35.1
- Re: [PATCH v1 1/2] packages: Support for full Guix specification, (continued)
- Re: [PATCH v1 1/2] packages: Support for full Guix specification, Olivier Dion, 2022/04/21
- [PATCH v2 0/2] Support full package specifications, Olivier Dion, 2022/04/22
- [PATCH v2 1/2] packages: Support for full Guix specification, Olivier Dion, 2022/04/22
- Re: [PATCH v2 1/2] packages: Support for full Guix specification, Ricardo Wurmus, 2022/04/26
- Re: [PATCH v2 1/2] packages: Support for full Guix specification, Olivier Dion, 2022/04/26
- Re: [PATCH v2 1/2] packages: Support for full Guix specification, Ricardo Wurmus, 2022/04/26
- Re: [PATCH v2 1/2] packages: Support for full Guix specification, Olivier Dion, 2022/04/26
- [PATCH v2 2/2] pre-inst-env.in: Export GUIX_EXTENSIONS_PATH, Olivier Dion, 2022/04/22
- Re: [PATCH v2 2/2] pre-inst-env.in: Export GUIX_EXTENSIONS_PATH, zimoun, 2022/04/29
- [PATCH v3 0/1] Support full package specifications, Olivier Dion, 2022/04/29
- [PATCH v3 1/1] packages: Support for full Guix specification,
Olivier Dion <=