Package: guix-patches;
Reported by: Julien Lepiller <julien <at> lepiller.eu>
Date: Sun, 12 Jul 2020 22:22:02 UTC
Severity: normal
Tags: patch
Done: Steve George <steve <at> futurile.net>
Bug is archived. No further changes may be made.
Message #263 received at 42338 <at> debbugs.gnu.org (full text, mbox):
From: Nicolas Graves <ngraves <at> ngraves.fr> To: 42338 <at> debbugs.gnu.org Cc: ngraves <at> ngraves.fr Subject: [PATCH v5 8/9] guix: import: composer: Full rewrite composer-fetch. Date: Thu, 2 Nov 2023 16:16:55 +0100
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 <composer-package> 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 <upstream-source> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.