From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp10.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id gBNbNFoobGIXHwEAbAwnHQ (envelope-from ) for ; Fri, 29 Apr 2022 20:03:06 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp10.migadu.com with LMTPS id iFeNM1oobGImuwAAG6o9tA (envelope-from ) for ; Fri, 29 Apr 2022 20:03:06 +0200 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 273D8389CB for ; Fri, 29 Apr 2022 20:03:06 +0200 (CEST) Received: from localhost ([::1]:35662 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nkUxN-0006mg-8g for larch@yhetil.org; Fri, 29 Apr 2022 14:03:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:48920) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nkUxJ-0006kL-G5 for gwl-devel@gnu.org; Fri, 29 Apr 2022 14:03:01 -0400 Received: from smtp.polymtl.ca ([132.207.4.11]:36186) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nkUxG-0005mG-Br for gwl-devel@gnu.org; Fri, 29 Apr 2022 14:03:00 -0400 Received: from laura.hitronhub.home (modemcable094.169-200-24.mc.videotron.ca [24.200.169.94]) (authenticated bits=0) by smtp.polymtl.ca (8.14.7/8.14.7) with ESMTP id 23TI2mlu004780 (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128 verify=NOT); Fri, 29 Apr 2022 14:02:56 -0400 DKIM-Filter: OpenDKIM Filter v2.11.0 smtp.polymtl.ca 23TI2mlu004780 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=polymtl.ca; s=default; t=1651255376; bh=kE56qoIrXetdOalID1zKHa4kDTM7xd5q+yG1tHXmvzw=; h=From:To:Subject:Date:In-Reply-To:References:From; b=NPFnck1eArsAerCrp07GV9dsqKgA3Oh1DTMFYk2eSBmK52nG/qsh05Ok0lyccoFfd ToRB10MTHkqeQD9KK4L8YEfDErTWqergQscDXgn60ZvkYzcvQNrbK1arhaXUwyn2mP rCrX1j+VvAKOx6Ph2kasaCIbXnZtEwEmzbvxL3Mo= From: Olivier Dion To: Olivier Dion , Olivier Dion via Subject: [PATCH v3 1/1] packages: Support for full Guix specification Date: Fri, 29 Apr 2022 14:02:47 -0400 Message-Id: <20220429180247.17830-2-olivier.dion@polymtl.ca> X-Mailer: git-send-email 2.35.1 In-Reply-To: <20220429180247.17830-1-olivier.dion@polymtl.ca> References: <20220422184359.7929-1-olivier.dion@polymtl.ca> <20220429180247.17830-1-olivier.dion@polymtl.ca> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Poly-FromMTA: (modemcable094.169-200-24.mc.videotron.ca [24.200.169.94]) at Fri, 29 Apr 2022 18:02:48 +0000 Received-SPF: pass client-ip=132.207.4.11; envelope-from=olivier.dion@polymtl.ca; helo=smtp.polymtl.ca X-Spam_score_int: -43 X-Spam_score: -4.4 X-Spam_bar: ---- X-Spam_report: (-4.4 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_MED=-2.3, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: gwl-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gwl-devel-bounces+larch=yhetil.org@gnu.org Sender: "gwl-devel" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1651255386; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=kE56qoIrXetdOalID1zKHa4kDTM7xd5q+yG1tHXmvzw=; b=rFKfsLjmFnhRUmZSoRja6jvGOK9PNxgXrImn6GWhOePmLQUp62g1eDXugfxpthsMWWdToN oeSU+biqHFXrpGi2HueOPFsY26k2OJGDWpy288fPxgU9p+LW+2st/WhjnU7wRB3EvMyPvX kJuiTE0MtyvIXThUux9Vr54/sWYAeS8U3TsiJE67q0t82tP9JhVLlCqvj+3yUnNpcWFj/P PD4ZGJtUbS8jEURVyT80oIFqAzx3VRAFPiV60We+XZSQqwmZ00GHO6XGgEJnZ473zAYQb4 jkhskN9LiB1uSdgMnJ1YazR38ftUVirSCim2iS2Fti8vrMc05G3rk44HJ08mRQ== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1651255386; a=rsa-sha256; cv=none; b=SCu6SoJcTj/igbmUIUsLI0KpQtlT5faymCNPa/rZE/X1N6KWxvxnnl90oOyed+FKGm1uZs lrOTm7VIkAvAYUq5738xzI3cgscK14KO5FUtSSuQRuwAT1A3Kcz+ptvRgVUxAKGpcatWBR xCSiZnMXGNe2wJ94AIJNC6/sIRHPEbVwL20jopMRNAuCPOxaA/fwtUN4imd8thIB/q713t /lX5caNS6UnUsh8t5m57sjwnv3Nf79l3RxK8UbP7+dvPjKeKfRnWBHsnarwR+DMKOezlmq BK1OneitDbFdZEBsWQsFgpV0tXUuMbSnidMWAs9W9mlbYjqAOIZMLRAlA3jwPg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=polymtl.ca header.s=default header.b=NPFnck1e; dmarc=pass (policy=quarantine) header.from=polymtl.ca; spf=pass (aspmx1.migadu.com: domain of "gwl-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="gwl-devel-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -7.50 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=polymtl.ca header.s=default header.b=NPFnck1e; dmarc=pass (policy=quarantine) header.from=polymtl.ca; spf=pass (aspmx1.migadu.com: domain of "gwl-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="gwl-devel-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 273D8389CB X-Spam-Score: -7.50 X-Migadu-Scanner: scn0.migadu.com X-TUID: ngVe98sy8Pak Guix package specifications match: PACKAGE [@VERSION] [:OUTPUT] thus the following are all valid package specifications: - "guile" - "guile@3.0.8" - "guile:debug" - "guile@3.0.8:debug" This is not currently supported by gwl. To do so, packages and their output are wrapped in a record. The record can be unwrapped with PACKAGE-UNWRAP to access the underlying Guix's package. Patterns matching is used for dispatching of procedure such as PACKAGE-NATIVE-INPUTS or PACKAGE-NAME. --- gwl/packages.scm | 96 +++++++++++++++++++++++++++++++++-------- gwl/processes.scm | 6 +-- gwl/workflows/graph.scm | 2 +- 3 files changed, 81 insertions(+), 23 deletions(-) diff --git a/gwl/packages.scm b/gwl/packages.scm index 6fe82d4..8016bd4 100644 --- a/gwl/packages.scm +++ b/gwl/packages.scm @@ -21,7 +21,9 @@ #:use-module ((guix store) #:select (open-connection close-connection)) #:use-module ((guix packages) - #:select (package? package-full-name)) + #:select (package? + package-full-name + (package-native-inputs . guix:package-native-inputs))) #:use-module ((guix inferior) #:select (open-inferior inferior? @@ -31,9 +33,13 @@ inferior-package-version inferior-package-native-inputs inferior-package-derivation)) + #:use-module ((guix ui) + #:select (package-specification->name+version+output)) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -43,11 +49,56 @@ lookup-package valid-package? package-name + package-unwrap + package->package+output bash-minimal build-time-guix default-guile - default-guile-derivation)) + default-guile-derivation + guile-gcrypt)) + +(define-record-type + (make-package-wrapper package output) + package-wrapper? + (package package-wrapper-package) + (output package-wrapper-output)) + +(define package-native-inputs + (match-lambda + ((? package? pkg) + (package-native-inputs pkg)) + ((? inferior-package? pkg) + (inferior-package-native-inputs pkg)) + ((? package-wrapper? pkg) + (package-native-inputs (package-wrapper-package pkg))))) + +(define package-name + (match-lambda + ((? package? pkg) + (package-full-name pkg)) + ((? inferior-package? pkg) + (inferior-package-full-name pkg)) + ((? package-wrapper? pkg) + (package-name (package-wrapper-package pkg))))) + +(define package-unwrap + (match-lambda + ((or (? package? pkg) + (? inferior-package? pkg)) + pkg) + ((? package-wrapper? pkg) + (package-wrapper-package pkg)))) + +(define package->package+output + (match-lambda + ((or (? package? pkg) + (? inferior-package? pkg)) + (list pkg "out")) + ((? package-wrapper? pkg) + (list + (package-wrapper-package pkg) + (package-wrapper-output pkg))))) (define current-guix (let ((current-guix-inferior #false)) @@ -73,15 +124,25 @@ (define (lookup-package specification) (log-event 'guix (G_ "Looking up package `~a'~%") specification) - (match (lookup-inferior-packages (current-guix) specification) - ((first . rest) first) - (_ (raise (condition - (&gwl-package-error - (package-spec specification))))))) + (let-values (((name version output) + (package-specification->name+version+output + specification))) + (let* ((inferior-package + (lookup-inferior-packages (current-guix) + name version)) + (package (match inferior-package + ((first . rest) first) + (_ (raise (condition + (&gwl-package-error + (package-spec specification)))))))) + (make-package-wrapper package output)))) (define (valid-package? val) - (or (package? val) - (inferior-package? val))) + (match val + ((or (? package?) + (? inferior-package?) + (? package-wrapper?)) #t) + (_ #f))) ;; Just like package-full-name from (guix packages) but for inferior ;; packages. @@ -93,27 +154,24 @@ the version. By default, DELIMITER is \"@\"." delimiter (inferior-package-version inferior-package))) -(define package-name - (match-lambda - ((? package? pkg) - (package-full-name pkg)) - ((? inferior-package? pkg) - (inferior-package-full-name pkg)))) - (define bash-minimal (mlambda () - (lookup-package "bash-minimal"))) + (package-unwrap (lookup-package "bash-minimal")))) + +(define guile-gcrypt + (mlambda () + (package-unwrap (lookup-package "guile-gcrypt")))) (define build-time-guix (mlambda () - (lookup-package "guix"))) + (package-unwrap (lookup-package "guix")))) (define default-guile (mlambda () "Return the variant of Guile that was used to build the \"guix\" package, which provides all library features used by the GWL. We use this Guile to run scripts." - (and=> (assoc-ref (inferior-package-native-inputs (build-time-guix)) + (and=> (assoc-ref (package-native-inputs (build-time-guix)) "guile") first))) (define (default-guile-derivation) diff --git a/gwl/processes.scm b/gwl/processes.scm index ce40d12..dd5ed02 100644 --- a/gwl/processes.scm +++ b/gwl/processes.scm @@ -611,7 +611,7 @@ tags if WITH-TAGS? is #FALSE or missing." "Return a file that contains the list of references of ITEM." (if (struct? item) ;lowerable object (computed-file name - (with-extensions (list (lookup-package "guile-gcrypt")) ;for store-copy + (with-extensions (list (guile-gcrypt)) ;for store-copy (with-imported-modules (source-module-closure '((guix build store-copy))) #~(begin @@ -643,7 +643,7 @@ PROCESS." (let* ((name (process-full-name process)) (packages (cons (bash-minimal) (process-packages process))) - (manifest (packages->manifest packages)) + (manifest (packages->manifest (map package->package+output packages))) (profile (profile (content manifest))) (search-paths (delete-duplicates (map search-path-specification->sexp @@ -657,7 +657,7 @@ PROCESS." (set-search-paths (map sexp->search-path-specification ',search-paths) (cons ,profile - ',packages)))) + ',(map package-unwrap packages))))) #$(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..c435644 100644 --- a/gwl/workflows/graph.scm +++ b/gwl/workflows/graph.scm @@ -43,7 +43,7 @@ label=<~a
\ (take-color) (string-upcase pretty-name) (process-synopsis process) - (match (process-packages process) + (match (map package-unwrap (process-packages process)) (() "") (inputs (format #f "
Uses: ~{~a~^, ~}." (map package-name inputs))))))) -- 2.35.1