From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms8.migadu.com with LMTPS id cB2xDNu9Q2X1dwAAauVa8A:P1 (envelope-from ) for ; Thu, 02 Nov 2023 16:18:51 +0100 Received: from aspmx1.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id cB2xDNu9Q2X1dwAAauVa8A (envelope-from ) for ; Thu, 02 Nov 2023 16:18:51 +0100 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 DCF3364CF6 for ; Thu, 2 Nov 2023 16:18:50 +0100 (CET) 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+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" ARC-Seal: i=1; s=key1; d=yhetil.org; t=1698938331; a=rsa-sha256; cv=none; b=kBwk5ABbskOqnLgJm9Wxcpox8eVjpYf0QH26rQatARlnc/Anf8ebqAxsVHE+DI7rnWVZRc jlqaDbqh+rMd/IzBRXisqi5cBgImT35Ai32x/XWGaG2IrbTNEw0MyG405m3eWtg+OhZLHq A8hOPCcdDkI2js9bA4VFtg4A6Vdul4KXN9s3Z1ffhITM17TIxunfhOlV9VgQyWtemqK6D9 qOdKrqiQn+uIivJtbNiVMj8xfWyJXMRPXZeCacvn4obBgN6e64XXeyzqUWK8s3KgtOpTKL tyAkKgCQwrNSyUbuZILkXkt76ewolj47nxukAd+YS4MHWb5KhV1ZZ3Rs9x+kzQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1698938331; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=aiMFiozuZ3vhFgRjjDESgUnZ93YC5MTihtDY7aARDO8=; b=PGuoqLVcQRVAl/lxnNZKJMDxosYgg3acz7SbNbfKHk/RnZy4GCfozhvaL1WXUx7vDzGjmu 5Nl0uo3MlpffYWDZbnotltqKcrIfBZVsHqBAEMzbBu3nSTr3J88GunYFzViDs/Cf+d/+v3 +UefA7DEKmso1WtHqlYaVzfd2pQTkY6BMYMOoQTq+AgzIYThXKNjfzugH7zyiPgEIA7Oly iAY9h0WJAyR8+rKLtsx2On9/13jVYZHv0lNFy+7pWViFqqKvi8OAeP9UzYkk8eeF1vLEB4 vF2ijVePddli5dBoax+oCiJHWci1TG893RnFCIaFzhtO8h+fyvA/uax3uSlLsA== Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qyZSs-000073-D8; Thu, 02 Nov 2023 11:18:34 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qyZSo-00005v-Kj for guix-patches@gnu.org; Thu, 02 Nov 2023 11:18:30 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qyZSo-0003qC-2w for guix-patches@gnu.org; Thu, 02 Nov 2023 11:18:30 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qyZTN-0006cL-1a for guix-patches@gnu.org; Thu, 02 Nov 2023 11:19:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42338] [PATCH v5 8/9] guix: import: composer: Full rewrite composer-fetch. Resent-From: Nicolas Graves Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 02 Nov 2023 15:19:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42338 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42338@debbugs.gnu.org Cc: ngraves@ngraves.fr Received: via spool by 42338-submit@debbugs.gnu.org id=B42338.169893830525320 (code B ref 42338); Thu, 02 Nov 2023 15:19:04 +0000 Received: (at 42338) by debbugs.gnu.org; 2 Nov 2023 15:18:25 +0000 Received: from localhost ([127.0.0.1]:55790 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qyZSi-0006aE-Tt for submit@debbugs.gnu.org; Thu, 02 Nov 2023 11:18:25 -0400 Received: from 7.mo575.mail-out.ovh.net ([46.105.63.230]:35809) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qyZSe-0006ZG-6W for 42338@debbugs.gnu.org; Thu, 02 Nov 2023 11:18:21 -0400 Received: from director8.ghost.mail-out.ovh.net (unknown [10.109.143.79]) by mo575.mail-out.ovh.net (Postfix) with ESMTP id 21FDA28F49 for <42338@debbugs.gnu.org>; Thu, 2 Nov 2023 15:17:44 +0000 (UTC) Received: from ghost-submission-6684bf9d7b-vt5f5 (unknown [10.110.103.93]) by director8.ghost.mail-out.ovh.net (Postfix) with ESMTPS id B5C3A1FEB4; Thu, 2 Nov 2023 15:17:43 +0000 (UTC) Received: from ngraves.fr ([37.59.142.99]) by ghost-submission-6684bf9d7b-vt5f5 with ESMTPSA id x1lWKZe9Q2Vq5gAA5SnFsg (envelope-from ); Thu, 02 Nov 2023 15:17:43 +0000 X-OVh-ClientIp: 87.88.157.103 Date: Thu, 2 Nov 2023 16:16:55 +0100 Message-ID: <20231102151725.31362-9-ngraves@ngraves.fr> X-Mailer: git-send-email 2.41.0 In-Reply-To: <20231102151725.31362-1-ngraves@ngraves.fr> References: <20231102151725.31362-1-ngraves@ngraves.fr> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Ovh-Tracer-Id: 13661669471634907874 X-VR-SPAMSTATE: OK X-VR-SPAMSCORE: 0 X-VR-SPAMCAUSE: gggruggvucftvghtrhhoucdtuddrgedvkedruddtiedgjeehucetufdoteggodetrfdotffvucfrrhhofhhilhgvmecuqfggjfdpvefjgfevmfevgfenuceurghilhhouhhtmecuhedttdenucenucfjughrpefhvfevufffkffojghfggfgsedtkeertdertddtnecuhfhrohhmpefpihgtohhlrghsucfirhgrvhgvshcuoehnghhrrghvvghssehnghhrrghvvghsrdhfrheqnecuggftrfgrthhtvghrnhepgffgfeevhfegueetgeektdeiueejieelteffudeugfefffelffegveeffeetffdtnecuffhomhgrihhnpehprggtkhgrghhishhtrdhorhhgnecukfhppeduvdejrddtrddtrddupdekjedrkeekrdduheejrddutdefpdefjedrheelrddugedvrdelleenucevlhhushhtvghrufhiiigvpedunecurfgrrhgrmhepihhnvghtpeduvdejrddtrddtrddupdhmrghilhhfrhhomhepoehnghhrrghvvghssehnghhrrghvvghsrdhfrheqpdhnsggprhgtphhtthhopedupdhrtghpthhtohepgedvfeefkeesuggvsggsuhhgshdrghhnuhdrohhrghdpoffvtefjohhsthepmhhoheejhedpmhhouggvpehsmhhtphhouhht 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: , Reply-to: Nicolas Graves X-ACL-Warn: , Nicolas Graves via Guix-patches From: Nicolas Graves via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Queue-Id: DCF3364CF6 X-Migadu-Scanner: mx12.migadu.com X-Migadu-Spam-Score: -6.11 X-Spam-Score: -6.11 X-TUID: 8DRxUbeKDmBb Change-Id: I1c01c242cefe0bc4cfc9bd9a5717d10a61dd575e --- guix/import/composer.scm | 154 +++++++++++++++++++-------------------- 1 file changed, 77 insertions(+), 77 deletions(-) diff --git a/guix/import/composer.scm b/guix/import/composer.scm index 89c8ea9113..2cc8861bdd 100644 --- a/guix/import/composer.scm +++ b/guix/import/composer.scm @@ -19,7 +19,7 @@ (define-module (guix import composer) #:use-module (ice-9 match) #:use-module (json) - #:use-module (gcrypt hash) + #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix build git) #:use-module (guix build utils) @@ -44,27 +44,6 @@ (define-module (guix import composer) (define %composer-base-url (make-parameter "https://repo.packagist.org")) -;; XXX adapted from (guix scripts hash) -(define (file-hash file select? recursive?) - ;; Compute the hash of FILE. - (if recursive? - (let-values (((port get-hash) (open-sha256-port))) - (write-file file port #:select? select?) - (force-output port) - (get-hash)) - (call-with-input-file file port-sha256))) - -;; XXX taken from (guix scripts hash) -(define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - (define (fix-version version) "Return a fixed version from a version string. For instance, v10.1 -> 10.1" (cond @@ -114,22 +93,36 @@ (define-json-mapping make-composer-package composer-package? (car l) `(list ,@l)))))) -(define* (composer-fetch name #:optional version) - "Return an alist representation of the Composer metadata for the package NAME, -or #f on failure." - (let ((package (json-fetch - (string-append (%composer-base-url) "/p/" name ".json")))) - (if package - (let* ((packages (assoc-ref package "packages")) - (package (or (assoc-ref packages name) package)) - (versions (filter - (lambda (version) - (and (not (string-contains version "dev")) - (not (string-contains version "beta")))) - (map car package))) - (version (or (if (null? version) #f version) - (latest-version versions)))) - (assoc-ref package version)) +(define (valid-version? v) + (let ((d (string-downcase v))) + (and (not (string-contains d "dev")) + (not (string-contains d "beta")) + (not (string-contains d "rc"))))) + +(define* (composer-fetch name #:key (version #f)) + "Return a composer-package representation of the Composer metadata for the +package NAME with optional VERSION, or #f on failure." + (let* ((url (string-append (%composer-base-url) "/p/" name ".json")) + (packages (and=> (json-fetch url) + (lambda (pkg) + (let ((pkgs (assoc-ref pkg "packages"))) + (or (assoc-ref pkgs name) pkg)))))) + (if packages + (json->composer-package + (if version + (assoc-ref packages version) + (cdr + (reduce + (lambda (new cur-max) + (match new + (((? valid-version? version) . tail) + (if (version>? (fix-version version) + (fix-version (car cur-max))) + (cons* version tail) + cur-max)) + (_ cur-max))) + (cons* "0.0.0" #f) + packages)))) #f))) (define (php-package-name name) @@ -158,47 +151,55 @@ (define (make-php-sexp composer-package) (composer-source-reference source) temp)) (url-fetch (composer-source-url source) temp)) - `(package - (name ,(composer-package-name composer-package)) - (version ,(composer-package-version composer-package)) - (source (origin - ,@(if git? - `((method git-fetch) - (uri (git-reference - (url ,(composer-source-url source)) - (commit ,(composer-source-reference source)))) - (file-name (git-file-name name version)) - (sha256 - (base32 - ,(bytevector->nix-base32-string - (file-hash temp (negate vcs-file?) #t))))) - `((method url-fetch) - (uri ,(composer-source-url source)) - (sha256 (base32 ,(guix-hash-url temp))))))) - (build-system composer-build-system) - ,@(if (null? dependencies) - '() - `((inputs - (list ,@(map string->symbol dependencies))))) - ,@(if (null? dev-dependencies) - '() - `((native-inputs - (list ,@(map string->symbol dev-dependencies))))) - (synopsis "") - (description ,(composer-package-description composer-package)) - (home-page ,(composer-package-homepage composer-package)) - (license ,(or (composer-package-license composer-package) - 'unknown-license!)))))))) + `(define-public ,(string->symbol + (composer-package-name composer-package)) + (package + (name ,(composer-package-name composer-package)) + (version ,(composer-package-version composer-package)) + (source + (origin + ,@(if git? + `((method git-fetch) + (uri (git-reference + (url ,(if (string-suffix? + ".git" + (composer-source-url source)) + (string-drop-right + (composer-source-url source) + (string-length ".git")) + (composer-source-url source))) + (commit ,(composer-source-reference source)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (file-hash* temp))))) + `((method url-fetch) + (uri ,(composer-source-url source)) + (sha256 (base32 ,(guix-hash-url temp))))))) + (build-system composer-build-system) + ,@(if (null? dependencies) + '() + `((inputs + (list ,@(map string->symbol dependencies))))) + ,@(if (null? dev-dependencies) + '() + `((native-inputs + (list ,@(map string->symbol dev-dependencies))))) + (synopsis "") + (description ,(composer-package-description composer-package)) + (home-page ,(composer-package-homepage composer-package)) + (license ,(or (composer-package-license composer-package) + 'unknown-license!))))))))) (define composer->guix-package (memoize - (lambda* (package-name #:key version #:allow-other-keys) + (lambda* (package-name #:key (version #f) #:allow-other-keys) "Fetch the metadata for PACKAGE-NAME from packagist.org, and return the `package' s-expression corresponding to that package, or #f on failure." - (let ((package (composer-fetch package-name version))) + (let ((package (composer-fetch package-name #:version version))) (and package - (let* ((package (json->composer-package package)) - (dependencies-names (composer-package-require package)) + (let* ((dependencies-names (composer-package-require package)) (dev-dependencies-names (composer-package-dev-require package))) (values (make-php-sexp package) (append dependencies-names dev-dependencies-names)))))))) @@ -238,14 +239,13 @@ (define (string->license str) (define (php-package? package) "Return true if PACKAGE is a PHP package from Packagist." (and - (eq? (build-system-name (package-build-system package)) 'composer) - (string-prefix? "php-" (package-name package)))) + (eq? (package-build-system package) composer-build-system) + (string-prefix? "php-" (package-name package)))) (define (latest-release package) "Return an for the latest release of PACKAGE." (let* ((php-name (guix-package->composer-name package)) - (metadata (composer-fetch php-name)) - (package (json->composer-package metadata)) + (package (composer-fetch php-name)) (version (composer-package-version package)) (url (composer-source-url (composer-package-source package)))) (upstream-source -- 2.41.0