From: "Ludovic Courtès" <ludo@gnu.org>
To: 45919@debbugs.gnu.org
Subject: [bug#45919] [PATCH 1/8] profiles: Add 'manifest->code'.
Date: Sat, 16 Jan 2021 19:34:02 +0100 [thread overview]
Message-ID: <20210116183409.31229-1-ludo@gnu.org> (raw)
In-Reply-To: <20210116182957.31075-1-ludo@gnu.org>
* guix/profiles.scm (manifest->code): New procedure.
* tests/profiles.scm ("manifest->code, simple")
("manifest->code, simple, versions")
("manifest->code, transformations"): New tests.
---
guix/profiles.scm | 86 +++++++++++++++++++++++++++++++++++++++++++++-
tests/profiles.scm | 30 +++++++++++++++-
2 files changed, 114 insertions(+), 2 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 59a313ea08..ea8bc6e593 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@@ -107,6 +107,8 @@
manifest-search-paths
check-for-collisions
+ manifest->code
+
manifest-transaction
manifest-transaction?
manifest-transaction-install
@@ -667,6 +669,88 @@ including the search path specification for $PATH."
(append-map manifest-entry-search-paths
(manifest-entries manifest)))))
+(define* (manifest->code manifest
+ #:key (entry-package-version (const "")))
+ "Return an sexp representing code to build an approximate version of
+MANIFEST; the code is wrapped in a top-level 'begin' form. Call
+ENTRY-PACKAGE-VERSION to determine the version number to use in the spec for a
+given entry; it can be set to 'manifest-entry-version' for fully-specified
+version numbers, or to some other procedure to disambiguate versions for
+packages for which several versions are available."
+ (define (entry-transformations entry)
+ ;; Return the transformations that apply to ENTRY.
+ (assoc-ref (manifest-entry-properties entry) 'transformations))
+
+ (define transformation-procedures
+ ;; List of transformation options/procedure name pairs.
+ (let loop ((entries (manifest-entries manifest))
+ (counter 1)
+ (result '()))
+ (match entries
+ (() result)
+ ((entry . tail)
+ (match (entry-transformations entry)
+ (#f
+ (loop tail counter result))
+ (options
+ (if (assoc-ref result options)
+ (loop tail counter result)
+ (loop tail (+ 1 counter)
+ (alist-cons options
+ (string->symbol
+ (format #f "transform~a" counter))
+ result)))))))))
+
+ (define (qualified-name entry)
+ ;; Return the name of ENTRY possibly with "@" followed by a version.
+ (match (entry-package-version entry)
+ ("" (manifest-entry-name entry))
+ (version (string-append (manifest-entry-name entry)
+ "@" version))))
+
+ (if (null? transformation-procedures)
+ `(begin ;simplest case
+ (specifications->manifest
+ (list ,@(map (lambda (entry)
+ (match (manifest-entry-output entry)
+ ("out" (qualified-name entry))
+ (output (string-append (qualified-name entry)
+ ":" output))))
+ (manifest-entries manifest)))))
+ (let* ((transform (lambda (options exp)
+ (if (not options)
+ exp
+ (let ((proc (assoc-ref transformation-procedures
+ options)))
+ `(,proc ,exp))))))
+ `(begin ;transformations apply
+ (use-modules (guix transformations))
+
+ ,@(map (match-lambda
+ ((options . name)
+ `(define ,name
+ (options->transformation ',options))))
+ transformation-procedures)
+
+ (packages->manifest
+ (list ,@(map (lambda (entry)
+ (define options
+ (entry-transformations entry))
+
+ (define name
+ (qualified-name entry))
+
+ (match (manifest-entry-output entry)
+ ("out"
+ (transform options
+ `(specification->package ,name)))
+ (output
+ `(list ,(transform
+ options
+ `(specification->package ,name))
+ ,output))))
+ (manifest-entries manifest))))))))
+
\f
;;;
;;; Manifest transactions.
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 2dec42bec1..ce77711d63 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -154,6 +154,34 @@
(manifest-entries (manifest-add (manifest '())
(list guile-2.0.9 guile-2.0.9))))
+(test-equal "manifest->code, simple"
+ '(begin
+ (specifications->manifest (list "guile" "guile:debug" "glibc")))
+ (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))))
+
+(test-equal "manifest->code, simple, versions"
+ '(begin
+ (specifications->manifest (list "guile@2.0.9" "guile@2.0.9:debug"
+ "glibc@2.19")))
+ (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))
+ #:entry-package-version manifest-entry-version))
+
+(test-equal "manifest->code, transformations"
+ '(begin
+ (use-modules (guix transformations))
+
+ (define transform1
+ (options->transformation '((foo . "bar"))))
+
+ (packages->manifest
+ (list (transform1 (specification->package "guile"))
+ (specification->package "glibc"))))
+ (manifest->code (manifest (list (manifest-entry
+ (inherit guile-2.0.9)
+ (properties `((transformations
+ . ((foo . "bar"))))))
+ glibc))))
+
(test-assert "manifest-perform-transaction"
(let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
(t1 (manifest-transaction
--
2.30.0
next prev parent reply other threads:[~2021-01-16 18:35 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-16 18:29 [bug#45919] [PATCH 0/8] Exporting a manifest and channels from a profile Ludovic Courtès
2021-01-16 18:34 ` Ludovic Courtès [this message]
2021-01-16 18:34 ` [bug#45919] [PATCH 2/8] utils: Add 'version-unique-prefix' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 3/8] guix package: Add '--export-manifest' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 4/8] channels: Factorize 'manifest-entry-channel' and channel serialization Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 5/8] channels: Add the channel name to channel sexps Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 6/8] guix describe: Use 'manifest-entry-channel' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 7/8] channels: Add 'channel->code' Ludovic Courtès
2021-01-16 18:34 ` [bug#45919] [PATCH 8/8] guix package: Add '--export-channels' Ludovic Courtès
[not found] ` <87wnvyv7w6.fsf@gnu.org>
[not found] ` <871re5t2lg.fsf@ambrevar.xyz>
2021-01-29 17:57 ` [bug#45919] [PATCH 0/8] Exporting a manifest and channels from a profile Pierre Neidhardt
[not found] ` <865z3fh8pn.fsf@gmail.com>
[not found] ` <87eei3quma.fsf@ambrevar.xyz>
2021-01-30 14:31 ` zimoun
[not found] ` <87o8h6fs1n.fsf_-_@gnu.org>
[not found] ` <875z3dqaq5.fsf@ambrevar.xyz>
[not found] ` <8735yfhqcd.fsf_-_@gnu.org>
[not found] ` <87v9bbolbq.fsf@ambrevar.xyz>
2021-02-01 17:04 ` bug#45919: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210116183409.31229-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=45919@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).