From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms8.migadu.com with LMTPS id qPUcE3S9Q2VQAgAA9RJhRA:P1 (envelope-from ) for ; Thu, 02 Nov 2023 16:17:08 +0100 Received: from aspmx1.migadu.com ([2001:41d0:403:58f0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id qPUcE3S9Q2VQAgAA9RJhRA (envelope-from ) for ; Thu, 02 Nov 2023 16:17:08 +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 BF9BE138B1 for ; Thu, 2 Nov 2023 16:17:04 +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=1698938225; a=rsa-sha256; cv=none; b=TwKWHsA+nVVXuCgoa+ZnU1feCOtvvUqzh4LsDLDVJACbjxM8yav7yio69xWlW/qB33W7jR 2SKE7sNfSTENNcNBGIBGTXA9x1v8gPNoTKMQOgrrJ7S1jQu4v32d4uzMZHosV//tc3xccZ vQMYQxkCrfw5Y721pRdSpE2epATNWStxzbmW8EM+vFVTrPMyKFMFnNHN8Hqy/WxoOM86Zm QPyAxDyPHhs/39DlJRrnVIoW18tLdP/tA4WB2/6RwdOzRCIrMDkmlJ/orS1pqZLsTlpJiK kYXMqrgmN9enTGOfX8Yn98+w7XyU0qJ129pd0BZbpuk2+inZutY6V1p54F0n6A== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1698938225; 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=Yg+ChXjt+ioYEoIb2TDevGskNKxrIcuS+wtr6qT9AML8c9uXAdgKGGEMtDWYAo69qJtGG6 ZI4rnKVaiJjeXwmbLrt3AycQOfrXjJbh1AbVK1AZJXidOrrsHapSmu5W5jiYkY3FZpLDle bNkctDlfJqbbFl08wSALuejo4BNAuBrRtqp8VApzx7OBQm0JkBG5my1+i6SldFxIvEwkkP Ef+HfjAwERROjkVF94uEPvVhlzHM8725qkgB8wtWRKYxUwAEtER8hoASs42FJvtRj8Qtp3 9cgK8LlZUIs3WVWhRu0Wv3VWMnJOlWWsOdZyQG5iidoGc6BtsLhEg5awkip8KQ== 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" Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qyZRG-0007ep-OB; Thu, 02 Nov 2023 11:16:54 -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 1qyZQu-0007Xn-8J for guix-patches@gnu.org; Thu, 02 Nov 2023 11:16:34 -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 1qyZQs-0002OR-QN for guix-patches@gnu.org; Thu, 02 Nov 2023 11:16:31 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qyZRR-0006WC-Ox for guix-patches@gnu.org; Thu, 02 Nov 2023 11:17:05 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42338] [PATCH 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:17:05 +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.169893818124916 (code B ref 42338); Thu, 02 Nov 2023 15:17:05 +0000 Received: (at 42338) by debbugs.gnu.org; 2 Nov 2023 15:16:21 +0000 Received: from localhost ([127.0.0.1]:55749 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qyZQi-0006Tj-SA for submit@debbugs.gnu.org; Thu, 02 Nov 2023 11:16:21 -0400 Received: from 17.mo582.mail-out.ovh.net ([46.105.36.150]:59293) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qyZQe-0006Sn-2u for 42338@debbugs.gnu.org; Thu, 02 Nov 2023 11:16:17 -0400 Received: from director1.ghost.mail-out.ovh.net (unknown [10.108.20.46]) by mo582.mail-out.ovh.net (Postfix) with ESMTP id C14A128462 for <42338@debbugs.gnu.org>; Thu, 2 Nov 2023 15:15:39 +0000 (UTC) Received: from ghost-submission-6684bf9d7b-k8mr2 (unknown [10.109.138.190]) by director1.ghost.mail-out.ovh.net (Postfix) with ESMTPS id 60D351FD41; Thu, 2 Nov 2023 15:15:39 +0000 (UTC) Received: from ngraves.fr ([37.59.142.105]) by ghost-submission-6684bf9d7b-k8mr2 with ESMTPSA id HYukExu9Q2WXQgIAdDy9bg (envelope-from ); Thu, 02 Nov 2023 15:15:39 +0000 X-OVh-ClientIp: 87.88.157.103 Date: Thu, 2 Nov 2023 16:04:28 +0100 Message-ID: <20231102151523.30581-9-ngraves@ngraves.fr> X-Mailer: git-send-email 2.41.0 In-Reply-To: <20231102151523.30581-1-ngraves@ngraves.fr> References: <20231102151523.30581-1-ngraves@ngraves.fr> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Ovh-Tracer-Id: 13626485098148848354 X-VR-SPAMSTATE: OK X-VR-SPAMSCORE: 0 X-VR-SPAMCAUSE: gggruggvucftvghtrhhoucdtuddrgedvkedruddtiedgjeegucetufdoteggodetrfdotffvucfrrhhofhhilhgvmecuqfggjfdpvefjgfevmfevgfenuceurghilhhouhhtmecuhedttdenucenucfjughrpefhvfevufffkffojghfggfgsedtkeertdertddtnecuhfhrohhmpefpihgtohhlrghsucfirhgrvhgvshcuoehnghhrrghvvghssehnghhrrghvvghsrdhfrheqnecuggftrfgrthhtvghrnhepgffgfeevhfegueetgeektdeiueejieelteffudeugfefffelffegveeffeetffdtnecuffhomhgrihhnpehprggtkhgrghhishhtrdhorhhgnecukfhppeduvdejrddtrddtrddupdekjedrkeekrdduheejrddutdefpdefjedrheelrddugedvrddutdehnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehinhgvthepuddvjedrtddrtddruddpmhgrihhlfhhrohhmpeeonhhgrhgrvhgvshesnhhgrhgrvhgvshdrfhhrqedpnhgspghrtghpthhtohepuddprhgtphhtthhopeegvdeffeekseguvggssghughhsrdhgnhhurdhorhhgpdfovfetjfhoshhtpehmohehkedvpdhmohguvgepshhmthhpohhuth 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-Scanner: mx11.migadu.com X-Spam-Score: -6.11 X-Migadu-Queue-Id: BF9BE138B1 X-Migadu-Spam-Score: -6.11 X-TUID: XfFGgcrj7QYB 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