[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Unexpected --export-manifest with simple transformations
From: |
Ludovic Courtès |
Subject: |
Re: Unexpected --export-manifest with simple transformations |
Date: |
Mon, 22 Feb 2021 23:41:37 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux) |
Hi,
zimoun <zimon.toutoune@gmail.com> skribis:
> Hi Ludo,
>
> On Thu, 11 Feb 2021 at 00:01, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> That’s because when using ‘-m’, transformations are not recorded.
>
> Yes. The question is: is it a conscientious choice or a missing
> feature?
[...]
> For example, ’package->manifest-entry*’ is "Like
> 'package->manifest-entry', but attach PACKAGE provenance meta-data to
> the resulting manifest entry." (I have not tried.) Therefore, we could
> have something similar with ’options->transform’, i.e., attach somehow
> meta-data.
>
> Well, because the feature is missing, the story about #2 is incomplete.
> And I would like to have a self-reproducible Docker image produced by
> ‘guix pack’.
>
> This “missing feature“, is it a conscientious choice or an use-case not
> thought yet?
I looked into it more closely. It wasn’t really conscious.
As you point out, we can have the ‘transformations’ property of manifest
entries created automatically by default; the patch below does that.
That way, the ‘transformations’ property is saved by default whether you
use a manifest or the imperative model, and ‘--export-manifest’ and ‘-m’
are dual.
How does that sound?
Thanks,
Ludo’.
diff --git a/guix/profiles.scm b/guix/profiles.scm
index ea8bc6e593..f942ae38d8 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -362,9 +362,14 @@ file name."
#t
lst)))
+(define (default-properties package)
+ (match (assq-ref (package-properties package) 'transformations)
+ (#f '())
+ (transformations `((transformations . ,transformations)))))
+
(define* (package->manifest-entry package #:optional (output "out")
#:key (parent (delay #f))
- (properties '()))
+ (properties (default-properties package)))
"Return a manifest entry for the OUTPUT of package PACKAGE."
;; For each dependency, keep a promise pointing to its "parent" entry.
(letrec* ((deps (map (match-lambda
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 8ecdcb823f..b653138f2c 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès
<ludo@gnu.org>
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
@@ -1170,24 +1170,19 @@ Create a bundle of PACKAGE.\n"))
manifest))
identity))
- (define (with-transformations manifest)
- (map-manifest-entries manifest-entry-with-transformations
- manifest))
-
(with-provenance
- (with-transformations
- (cond
- ((and (not (null? manifests)) (not (null? packages)))
- (leave (G_ "both a manifest and a package list were given~%")))
- ((not (null? manifests))
- (concatenate-manifests
- (map (lambda (file)
- (let ((user-module (make-user-module
- '((guix profiles) (gnu)))))
- (load* file user-module)))
- manifests)))
- (else
- (packages->manifest packages)))))))
+ (cond
+ ((and (not (null? manifests)) (not (null? packages)))
+ (leave (G_ "both a manifest and a package list were given~%")))
+ ((not (null? manifests))
+ (concatenate-manifests
+ (map (lambda (file)
+ (let ((user-module (make-user-module
+ '((guix profiles) (gnu)))))
+ (load* file user-module)))
+ manifests)))
+ (else
+ (packages->manifest packages))))))
(with-error-handling
(with-store store
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 8234a1703d..fc5bf8137b 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -235,14 +235,12 @@ non-zero relevance score."
(case (version-compare candidate-version version)
((>)
(manifest-transaction-install-entry
- (manifest-entry-with-transformations
- (package->manifest-entry* pkg output))
+ (package->manifest-entry* pkg output)
transaction))
((<)
transaction)
((=)
- (let* ((new (manifest-entry-with-transformations
- (package->manifest-entry* pkg output))))
+ (let* ((new (package->manifest-entry* pkg output)))
;; Here we want to determine whether the NEW actually
;; differs from ENTRY, but we need to intercept
;; 'build-things' calls because they would prevent us from
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 7877029486..902bd45a6a 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -20,6 +20,9 @@
#:use-module (guix tests)
#:use-module (guix store)
#:use-module ((guix gexp) #:select (lower-object))
+ #:use-module ((guix profiles)
+ #:select (package->manifest-entry
+ manifest-entry-properties))
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix git-download)
@@ -413,6 +416,13 @@
`((with-latest . "foo")))))
(package-version (t p)))))
+(test-equal "options->transformation + package->manifest-entry"
+ '((transformations . ((without-tests . "foo"))))
+ (let* ((p (dummy-package "foo"))
+ (t (options->transformation '((without-tests . "foo"))))
+ (e (package->manifest-entry (t p))))
+ (manifest-entry-properties e)))
+
(test-end)
;;; Local Variables: