all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [PATCH] processes: Store packages as manifest.
@ 2022-08-04  7:43 Liliana Marie Prikler
  2022-08-25 12:13 ` Ricardo Wurmus
  0 siblings, 1 reply; 3+ messages in thread
From: Liliana Marie Prikler @ 2022-08-04  7:43 UTC (permalink / raw)
  To: gwl-devel; +Cc: Olivier Dion

This makes handling of package outputs nondestructive.  It also fixes
an unrelated issue in the ordering of process packages – the implicit
bash-minimal is now ordered *last*.

* gwl/packages.scm (lookup-package): Return multiple values.
(package-output): Deleted variable.
* gwl/workflows/utils.scm (activate-workflow-environment!): Adjust accordingly.
* gwl/processes.scm (<process>)[packages]: Use manifest as init-form.
Use manifest? as validator.  Return a manifest in transformer.
* gwl/processes.scm (process->script): Adjust accordingly.
* gwl/workflows/graph.scm (workflow-dot-prettify-node): Likewise.
---
 gwl/packages.scm        |  6 +---
 gwl/processes.scm       | 64 ++++++++++++++++++++++-------------------
 gwl/workflows/graph.scm |  3 +-
 gwl/workflows/utils.scm |  2 +-
 4 files changed, 39 insertions(+), 36 deletions(-)

diff --git a/gwl/packages.scm b/gwl/packages.scm
index 6a598ba..37107f6 100644
--- a/gwl/packages.scm
+++ b/gwl/packages.scm
@@ -46,7 +46,6 @@
             lookup-package
             valid-package?
             package-name
-            package-output
 
             bash-minimal
             build-time-guix
@@ -86,8 +85,7 @@
                     (_ (raise (condition
                                (&gwl-package-error
                                 (package-spec specification))))))))
-    (set! (package-output package) output)
-    package))
+    (values package output)))
 
 (define (valid-package? val)
   (or (package? val)
@@ -110,8 +108,6 @@ the version.  By default, DELIMITER is \"@\"."
     ((? inferior-package? pkg)
      (inferior-package-full-name pkg))))
 
-(define package-output (make-object-property))
-
 (define bash-minimal
   (mlambda ()
     (lookup-package "bash-minimal")))
diff --git a/gwl/processes.scm b/gwl/processes.scm
index 2452d1f..07b376a 100644
--- a/gwl/processes.scm
+++ b/gwl/processes.scm
@@ -24,8 +24,10 @@
   #:use-module ((guix profiles)
                 #:select
                 (profile
+                 manifest manifest?
                  manifest-search-paths
-                 packages->manifest))
+                 packages->manifest
+                 concatenate-manifests))
   #:use-module ((guix search-paths)
                 #:select
                 (search-path-specification->sexp))
@@ -38,6 +40,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 rdelim)
   #:export (make-process
@@ -184,27 +187,33 @@
   (packages
    #:accessor process-packages
    #:init-keyword #:packages
-   #:init-value '()
+   #:init-form (manifest '())
    #:implicit-list? #t
-   #:validator (lambda (value)
-                 (every valid-package? value))
+   #:validator manifest?
    #:transformer
    ;; TODO: the instance name is not be available at this point, so we
    ;; can't report the process name here.  We should move the
    ;; transformers and validators to a point after initialization.
-   (lambda (instance value)
-     (map (match-lambda
-            ((and (? string?) spec)
-             (lookup-package spec))
-            ((and (? valid-package?) pkg)
-             pkg)
-            (x
-             (raise
-              (condition
-               (&gwl-type-error
-                (expected-type (list "<package>" "<inferior-package>" "<string>"))
-                (actual-value x))))))
-          value)))
+   (match-lambda*
+     ((_ (? manifest? value)) value)
+     ((_ packages)
+      (packages->manifest
+       (map
+        (match-lambda
+          ((? string? spec)
+           (let ((pkg out (lookup-package spec)))
+             (list pkg out)))
+          ((? valid-package? pkg)
+           pkg)
+          (((? valid-package? pkg) (? string? out))
+           (list pkg out))
+          (x
+           (raise
+            (condition
+             (&gwl-type-error
+              (expected-type (list "<package>" "<inferior-package>" "<string>"))
+              (actual-value x))))))
+        packages)))))
   (inputs
    #:accessor process-raw-inputs
    #:init-keyword #:inputs
@@ -686,12 +695,11 @@ tags if WITH-TAGS? is #FALSE or missing."
   "Return a lowerable object for the script that will execute the
 PROCESS."
   (let* ((name         (process-full-name process))
-         (packages     (cons (bash-minimal)
-                             (process-packages process)))
-         (manifest     (packages->manifest (map
-                                            (lambda (pkg)
-                                              (list pkg (package-output pkg)))
-                                            packages)))
+         (manifest     (concatenate-manifests
+                        ;; Put process packages before bash-minimal, so that
+                        ;; they're not shadowed.
+                        (list (process-packages process)
+                              (packages->manifest (list (bash-minimal))))))
          (profile      (profile (content manifest)))
          (search-paths (delete-duplicates
                         (map search-path-specification->sexp
@@ -700,12 +708,10 @@ PROCESS."
          (exp
           (with-imported-modules (source-module-closure (script-modules))
             #~(begin
-                #$@(if (null? packages) '()
-                       `((use-modules (guix search-paths))
-                         (set-search-paths (map sexp->search-path-specification
-                                                ',search-paths)
-                                           (cons ,profile
-                                                 ',packages))))
+                (use-modules (guix search-paths))
+                (set-search-paths (map sexp->search-path-specification
+                                       '#$search-paths)
+                                  (list #$profile))
                 #$(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..7ea2fca 100644
--- a/gwl/workflows/graph.scm
+++ b/gwl/workflows/graph.scm
@@ -17,6 +17,7 @@
 (define-module (gwl workflows graph)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (guix profiles)
   #:use-module (gwl packages)
   #:use-module (gwl processes)
   #:use-module (gwl workflows)
@@ -46,7 +47,7 @@ label=<<FONT POINT-SIZE=\"14\">~a</FONT><BR/>\
             (match (process-packages process)
               (() "")
               (inputs (format #f "<BR/>Uses: ~{~a~^, ~}."
-                              (map package-name inputs)))))))
+                              (map manifest-entry-name inputs)))))))
 
 (define (workflow-restriction->dot process . restrictions)
   "Write the dependency relationships of a restriction in dot format."
diff --git a/gwl/workflows/utils.scm b/gwl/workflows/utils.scm
index 666d5f0..22e6ced 100644
--- a/gwl/workflows/utils.scm
+++ b/gwl/workflows/utils.scm
@@ -180,7 +180,7 @@ modify the load path of the current process."
       ((package-names (required-packages file-name))
        (_assert       (not (null? package-names)))
        (manifest      (packages->manifest
-                       (map lookup-package package-names)))
+                       (map (compose list lookup-package) package-names)))
        (profile       (profile (content manifest)))
        (profile-directory
         (parameterize ((%guile-for-build (default-guile-derivation)))
-- 
2.37.1



^ permalink raw reply related	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2022-10-06 14:40 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-08-04  7:43 [PATCH] processes: Store packages as manifest Liliana Marie Prikler
2022-08-25 12:13 ` Ricardo Wurmus
2022-10-06 14:34   ` Olivier Dion via

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.