profiles: Add 'manifest->code'.

* guix/profiles.scm (manifest->code): New procedure.
* tests/profiles.scm ("manifest->code, simple")
("manifest->code, simple, versions")
("manifest->code, transformations"): New tests.
This commit is contained in:
Ludovic Courtès 2021-01-10 11:23:40 +01:00
parent 73744725dd
commit b41e21488f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 114 additions and 2 deletions

View file

@ -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 @@ (define-module (guix profiles)
manifest-search-paths
check-for-collisions
manifest->code
manifest-transaction
manifest-transaction?
manifest-transaction-install
@ -667,6 +669,88 @@ (define (manifest-search-paths manifest)
(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))))))))
;;;
;;; Manifest transactions.

View file

@ -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 @@ (define glibc
(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