From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id 4PeNF+QxA2BvXQAA0tVLHw (envelope-from ) for ; Sat, 16 Jan 2021 18:35:16 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id 8IhBE+QxA2A3XAAAbx9fmQ (envelope-from ) for ; Sat, 16 Jan 2021 18:35:16 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id AD2BC9402B1 for ; Sat, 16 Jan 2021 18:35:15 +0000 (UTC) Received: from localhost ([::1]:39972 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l0qPq-0004If-Mw for larch@yhetil.org; Sat, 16 Jan 2021 13:35:14 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:51128) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l0qPe-0004Hx-2Q for guix-patches@gnu.org; Sat, 16 Jan 2021 13:35:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:60727) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l0qPd-0006Nl-RR for guix-patches@gnu.org; Sat, 16 Jan 2021 13:35:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1l0qPd-0002Wi-P2 for guix-patches@gnu.org; Sat, 16 Jan 2021 13:35:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#45919] [PATCH 1/8] profiles: Add 'manifest->code'. References: <20210116182957.31075-1-ludo@gnu.org> In-Reply-To: <20210116182957.31075-1-ludo@gnu.org> Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 16 Jan 2021 18:35:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 45919 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 45919@debbugs.gnu.org Received: via spool by 45919-submit@debbugs.gnu.org id=B45919.16108220679600 (code B ref 45919); Sat, 16 Jan 2021 18:35:01 +0000 Received: (at 45919) by debbugs.gnu.org; 16 Jan 2021 18:34:27 +0000 Received: from localhost ([127.0.0.1]:44022 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l0qP5-0002Ug-7p for submit@debbugs.gnu.org; Sat, 16 Jan 2021 13:34:27 -0500 Received: from eggs.gnu.org ([209.51.188.92]:57896) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l0qP3-0002UB-2t for 45919@debbugs.gnu.org; Sat, 16 Jan 2021 13:34:25 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:57158) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l0qOx-0006AR-9z; Sat, 16 Jan 2021 13:34:19 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=36420 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1l0qOw-0000li-IB; Sat, 16 Jan 2021 13:34:19 -0500 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sat, 16 Jan 2021 19:34:02 +0100 Message-Id: <20210116183409.31229-1-ludo@gnu.org> X-Mailer: git-send-email 2.30.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: -1.85 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: AD2BC9402B1 X-Spam-Score: -1.85 X-Migadu-Scanner: scn1.migadu.com X-TUID: e+c7TFJMQ6ZD * 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 +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014, 2016 Alex Kost ;;; Copyright © 2015 Mark H Weaver @@ -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)))))))) + ;;; ;;; 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 +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2014 Alex Kost ;;; ;;; 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