| Message ID | 6abfbb4d4d57642fea6bae5835ff0d365de7e24a.1695724304.git.ngraves@ngraves.fr |
|---|---|
| State | New |
| Headers | show |
| Series | [bug#42338,v3,1/7] guix: import: Add composer importer. | expand |
I've just added some modernizations and fixes ontop of the : - first patch which is the latest provided in the discussion between Ludo' and Julien, with minimal fixes. - second and third patch which are the versions from Adam Faiz. The recursive import should work with these patches but often fails, probably because it loops and we eventually get a gnu-tls error probably from when github refuses to serve, because it doesn't stop on a specific package. This probably will stop looping so much one phpunit is added, with the later patches from Julien adding phpunit. In any case, it's definitely a more robust recursive import, and the error Adam experienced has been solved in the fifth patch. The sixth patch also avoids some licensing-related failures. On 2023-09-26 12:31, Nicolas Graves wrote: > * guix/import/composer.scm: New file. > * guix/scripts/import/composer.scm: New file. > * guix/tests/composer.scm: New file. > * Makefile.am: Add them. > * guix/scripts/import.scm: Add composer importer. > * doc/guix.texi (Invoking guix import): Mention it. > --- > Makefile.am | 3 + > doc/guix.texi | 20 +++ > guix/import/composer.scm | 270 +++++++++++++++++++++++++++++++ > guix/scripts/import.scm | 2 +- > guix/scripts/import/composer.scm | 107 ++++++++++++ > tests/composer.scm | 92 +++++++++++ > 6 files changed, 493 insertions(+), 1 deletion(-) > create mode 100644 guix/import/composer.scm > create mode 100644 guix/scripts/import/composer.scm > create mode 100644 tests/composer.scm > > diff --git a/Makefile.am b/Makefile.am > index 8924974e8a..3ce7ee832e 100644 > --- a/Makefile.am > +++ b/Makefile.am > @@ -274,6 +274,7 @@ MODULES = \ > guix/search-paths.scm \ > guix/packages.scm \ > guix/import/cabal.scm \ > + guix/import/composer.scm \ > guix/import/cpan.scm \ > guix/import/cran.scm \ > guix/import/crate.scm \ > @@ -332,6 +333,7 @@ MODULES = \ > guix/scripts/home/import.scm \ > guix/scripts/lint.scm \ > guix/scripts/challenge.scm \ > + guix/scripts/import/composer.scm \ > guix/scripts/import/crate.scm \ > guix/scripts/import/cpan.scm \ > guix/scripts/import/cran.scm \ > @@ -500,6 +502,7 @@ SCM_TESTS = \ > tests/challenge.scm \ > tests/channels.scm \ > tests/combinators.scm \ > + tests/composer.scm \ > tests/containers.scm \ > tests/cpan.scm \ > tests/cpio.scm \ > diff --git a/doc/guix.texi b/doc/guix.texi > index 46591b2f64..4d2fc11cd7 100644 > --- a/doc/guix.texi > +++ b/doc/guix.texi > @@ -14530,6 +14530,26 @@ Invoking guix import > > Additional options include: > > +@table @code > +@item --recursive > +@itemx -r > +Traverse the dependency graph of the given upstream package recursively > +and generate package expressions for all those packages that are not yet > +in Guix. > +@end table > + > +@item composer > +@cindex Composer > +@cindex PHP > +Import metadat from the @uref{https://getcomposer.org/, Composer} package > +archive used by the PHP community, as in this example: > + > +@example > +guix import composer phpunit/phpunit > +@end example > + > +Additional options include: > + > @table @code > @item --recursive > @itemx -r > diff --git a/guix/import/composer.scm b/guix/import/composer.scm > new file mode 100644 > index 0000000000..c152f402bb > --- /dev/null > +++ b/guix/import/composer.scm > @@ -0,0 +1,270 @@ > +;;; GNU Guix --- Functional package management for GNU > +;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> > +;;; > +;;; This file is part of GNU Guix. > +;;; > +;;; GNU Guix is free software; you can redistribute it and/or modify it > +;;; under the terms of the GNU General Public License as published by > +;;; the Free Software Foundation; either version 3 of the License, or (at > +;;; your option) any later version. > +;;; > +;;; GNU Guix is distributed in the hope that it will be useful, but > +;;; WITHOUT ANY WARRANTY; without even the implied warranty of > +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the > +;;; GNU General Public License for more details. > +;;; > +;;; You should have received a copy of the GNU General Public License > +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. > + > +(define-module (guix import composer) > + #:use-module (ice-9 match) > + #:use-module (json) > + #:use-module (gcrypt hash) > + #:use-module (guix base32) > + #:use-module (guix build git) > + #:use-module (guix build utils) > + #:use-module (guix build-system) > + #:use-module (guix import json) > + #:use-module (guix import utils) > + #:use-module ((guix licenses) #:prefix license:) > + #:use-module (guix packages) > + #:use-module (guix serialization) > + #:use-module (guix upstream) > + #:use-module (guix utils) > + #:use-module (srfi srfi-1) > + #:use-module (srfi srfi-11) > + #:use-module (srfi srfi-26) > + #:export (composer->guix-package > + %composer-updater > + composer-recursive-import > + > + %composer-base-url)) > + > +(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 > + ((string-prefix? "version" version) > + (if (char-set-contains? char-set:digit (string-ref version 7)) > + (substring version 7) > + (substring version 8))) > + ((string-prefix? "v" version) > + (substring version 1)) > + (else version))) > + > +(define (latest-version versions) > + (fold (lambda (a b) (if (version>? (fix-version a) (fix-version b)) a b)) > + (car versions) versions)) > + > +(define (json->require dict) > + (if dict > + (let loop ((result '()) (require dict)) > + (match require > + (() result) > + ((((? (cut string-contains <> "/") name) . _) > + require ...) > + (loop (cons name result) require)) > + ((_ require ...) (loop result require)))) > + '())) > + > +(define-json-mapping <composer-source> make-composer-source composer-source? > + json->composer-source > + (type composer-source-type) > + (url composer-source-url) > + (reference composer-source-reference)) > + > +(define-json-mapping <composer-package> make-composer-package composer-package? > + json->composer-package > + (description composer-package-description) > + (homepage composer-package-homepage) > + (source composer-package-source "source" json->composer-source) > + (name composer-package-name "name" php-package-name) > + (version composer-package-version "version" fix-version) > + (require composer-package-require "require" json->require) > + (dev-require composer-package-dev-require "require-dev" json->require) > + (license composer-package-license "license" > + (lambda (vector) > + (map string->license (vector->list vector))))) > + > +(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)) > + #f))) > + > +(define (php-package-name name) > + "Given the NAME of a package on Packagist, return a Guix-compliant name for > +the package." > + (let ((name (string-join (string-split name #\/) "-"))) > + (if (string-prefix? "php-" name) > + (snake-case name) > + (string-append "php-" (snake-case name))))) > + > +(define (make-php-sexp composer-package) > + "Return the `package' s-expression for a PHP package for the given > +COMPOSER-PACKAGE." > + (let* ((source (composer-package-source composer-package)) > + (dependencies (map php-package-name > + (composer-package-require composer-package))) > + (dev-dependencies (map php-package-name > + (composer-package-dev-require composer-package))) > + (git? (equal? (composer-source-type source) "git"))) > + ((if git? call-with-temporary-directory call-with-temporary-output-file) > + (lambda* (temp #:optional port) > + (and (if git? > + (begin > + (mkdir-p temp) > + (git-fetch (composer-source-url source) > + (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 > + (,'quasiquote > + ,(map (lambda (name) > + `(,name > + (,'unquote > + ,(string->symbol name)))) > + dependencies))))) > + ,@(if (null? dev-dependencies) > + '() > + `((native-inputs > + (,'quasiquote > + ,(map (lambda (name) > + `(,name > + (,'unquote > + ,(string->symbol name)))) > + dev-dependencies))))) > + (synopsis "") > + (description ,(composer-package-description composer-package)) > + (home-page ,(composer-package-homepage composer-package)) > + (license ,(match (composer-package-license composer-package) > + (() #f) > + ((license) license) > + (_ license))))))))) > + > +(define* (composer->guix-package package-name #:optional version) > + "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))) > + (and package > + (let* ((package (json->composer-package package)) > + (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)))))) > + > +(define (guix-name->composer-name name) > + "Given a guix package name, return the name of the package in Packagist." > + (if (string-prefix? "php-" name) > + (let ((components (string-split (substring name 4) #\-))) > + (match components > + ((namespace name ...) > + (string-append namespace "/" (string-join name "-"))))) > + name)) > + > +(define (guix-package->composer-name package) > + "Given a Composer PACKAGE built from Packagist, return the name of the > +package in Packagist." > + (let ((upstream-name (assoc-ref > + (package-properties package) > + 'upstream-name)) > + (name (package-name package))) > + (if upstream-name > + upstream-name > + (guix-name->composer-name name)))) > + > +(define (string->license str) > + "Convert the string STR into a license object." > + (match str > + ("GNU LGPL" 'license:lgpl2.0) > + ("GPL" 'license:gpl3) > + ((or "BSD" "BSD License" "BSD-3-Clause") 'license:bsd-3) > + ((or "MIT" "MIT license" "Expat license") 'license:expat) > + ("Public domain" 'license:public-domain) > + ((or "Apache License, Version 2.0" "Apache 2.0") 'license:asl2.0) > + (_ #f))) > + > +(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)))) > + > +(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)) > + (version (composer-package-version package)) > + (url (composer-source-url (composer-package-source package)))) > + (upstream-source > + (package (package-name package)) > + (version version) > + (urls (list url))))) > + > +(define %composer-updater > + (upstream-updater > + (name 'composer) > + (description "Updater for Composer packages") > + (pred php-package?) > + (import latest-release))) > + > +(define* (composer-recursive-import package-name #:optional version) > + (recursive-import package-name '() > + #:repo->guix-package composer->guix-package > + #:guix-name php-package-name)) > diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm > index 4ddd8d46a1..8c58dd35e2 100644 > --- a/guix/scripts/import.scm > +++ b/guix/scripts/import.scm > @@ -47,7 +47,7 @@ (define %standard-import-options '()) > > (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" > "gem" "go" "cran" "crate" "texlive" "json" "opam" > - "minetest" "elm" "hexpm")) > + "minetest" "elm" "hexpm" "composer")) > > (define (resolve-importer name) > (let ((module (resolve-interface > diff --git a/guix/scripts/import/composer.scm b/guix/scripts/import/composer.scm > new file mode 100644 > index 0000000000..412bae6318 > --- /dev/null > +++ b/guix/scripts/import/composer.scm > @@ -0,0 +1,107 @@ > +;;; GNU Guix --- Functional package management for GNU > +;;; Copyright © 2015 David Thompson <davet@gnu.org> > +;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> > +;;; > +;;; This file is part of GNU Guix. > +;;; > +;;; GNU Guix is free software; you can redistribute it and/or modify it > +;;; under the terms of the GNU General Public License as published by > +;;; the Free Software Foundation; either version 3 of the License, or (at > +;;; your option) any later version. > +;;; > +;;; GNU Guix is distributed in the hope that it will be useful, but > +;;; WITHOUT ANY WARRANTY; without even the implied warranty of > +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the > +;;; GNU General Public License for more details. > +;;; > +;;; You should have received a copy of the GNU General Public License > +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. > + > +(define-module (guix scripts import composer) > + #:use-module (guix ui) > + #:use-module (guix utils) > + #:use-module (guix scripts) > + #:use-module (guix import composer) > + #:use-module (guix scripts import) > + #:use-module (srfi srfi-1) > + #:use-module (srfi srfi-11) > + #:use-module (srfi srfi-37) > + #:use-module (srfi srfi-41) > + #:use-module (ice-9 match) > + #:use-module (ice-9 format) > + #:export (guix-import-composer)) > + > + > +;;; > +;;; Command-line options. > +;;; > + > +(define %default-options > + '()) > + > +(define (show-help) > + (display (G_ "Usage: guix import composer PACKAGE-NAME > +Import and convert the Composer package for PACKAGE-NAME.\n")) > + (display (G_ " > + -h, --help display this help and exit")) > + (display (G_ " > + -V, --version display version information and exit")) > + (display (G_ " > + -r, --recursive generate package expressions for all Composer packages\ > + that are not yet in Guix")) > + (newline) > + (show-bug-report-information)) > + > +(define %options > + ;; Specification of the command-line options. > + (cons* (option '(#\h "help") #f #f > + (lambda args > + (show-help) > + (exit 0))) > + (option '(#\V "version") #f #f > + (lambda args > + (show-version-and-exit "guix import composer"))) > + (option '(#\r "recursive") #f #f > + (lambda (opt name arg result) > + (alist-cons 'recursive #t result))) > + %standard-import-options)) > + > + > +;;; > +;;; Entry point. > +;;; > + > +(define (guix-import-composer . args) > + (define (parse-options) > + ;; Return the alist of option values. > + (args-fold* args %options > + (lambda (opt name arg result) > + (leave (G_ "~A: unrecognized option~%") name)) > + (lambda (arg result) > + (alist-cons 'argument arg result)) > + %default-options)) > + > + (let* ((opts (parse-options)) > + (args (filter-map (match-lambda > + (('argument . value) > + value) > + (_ #f)) > + (reverse opts)))) > + (match args > + ((package-name) > + (if (assoc-ref opts 'recursive) > + (map (match-lambda > + ((and ('package ('name name) . rest) pkg) > + `(define-public ,(string->symbol name) > + ,pkg)) > + (_ #f)) > + (composer-recursive-import package-name)) > + (let ((sexp (composer->guix-package package-name))) > + (unless sexp > + (leave (G_ "failed to download meta-data for package '~a'~%") > + package-name)) > + sexp))) > + (() > + (leave (G_ "too few arguments~%"))) > + ((many ...) > + (leave (G_ "too many arguments~%")))))) > diff --git a/tests/composer.scm b/tests/composer.scm > new file mode 100644 > index 0000000000..cefaf9f434 > --- /dev/null > +++ b/tests/composer.scm > @@ -0,0 +1,92 @@ > +;;; GNU Guix --- Functional package management for GNU > +;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> > +;;; > +;;; This file is part of GNU Guix. > +;;; > +;;; GNU Guix is free software; you can redistribute it and/or modify it > +;;; under the terms of the GNU General Public License as published by > +;;; the Free Software Foundation; either version 3 of the License, or (at > +;;; your option) any later version. > +;;; > +;;; GNU Guix is distributed in the hope that it will be useful, but > +;;; WITHOUT ANY WARRANTY; without even the implied warranty of > +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the > +;;; GNU General Public License for more details. > +;;; > +;;; You should have received a copy of the GNU General Public License > +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. > + > +(define-module (test-composer) > + #:use-module (guix import composer) > + #:use-module (guix base32) > + #:use-module (gcrypt hash) > + #:use-module (guix tests http) > + #:use-module (guix grafts) > + #:use-module (srfi srfi-64) > + #:use-module (web client) > + #:use-module (ice-9 match)) > + > +;; Globally disable grafts because they can trigger early builds. > +(%graft? #f) > + > +(define test-json > + "{ > + \"packages\": { > + \"foo/bar\": { > + \"0.1\": { > + \"name\": \"foo/bar\", > + \"description\": \"description\", > + \"keywords\": [\"testing\"], > + \"homepage\": \"http://example.com\", > + \"version\": \"0.1\", > + \"license\": [\"BSD-3-Clause\"], > + \"source\": { > + \"type\": \"url\", > + \"url\": \"http://example.com/Bar-0.1.tar.gz\" > + }, > + \"require\": {}, > + \"require-dev\": {\"phpunit/phpunit\": \"1.0.0\"} > + } > + } > + } > +}") > + > +(define test-source > + "foobar") > + > +;; Avoid collisions with other tests. > +(%http-server-port 10450) > + > +(test-begin "composer") > + > +(test-assert "composer->guix-package" > + ;; Replace network resources with sample data. > + (with-http-server `((200 ,test-json) > + (200 ,test-source)) > + (parameterize ((%composer-base-url (%local-url)) > + (current-http-proxy (%local-url))) > + (match (composer->guix-package "foo/bar") > + (('package > + ('name "php-foo-bar") > + ('version "0.1") > + ('source ('origin > + ('method 'url-fetch) > + ('uri "http://example.com/Bar-0.1.tar.gz") > + ('sha256 > + ('base32 > + (? string? hash))))) > + ('build-system 'composer-build-system) > + ('native-inputs > + ('quasiquote > + (("php-phpunit-phpunit" ('unquote 'php-phpunit-phpunit))))) > + ('synopsis "") > + ('description "description") > + ('home-page "http://example.com") > + ('license 'license:bsd-3)) > + (string=? (bytevector->nix-base32-string > + (call-with-input-string test-source port-sha256)) > + hash)) > + (x > + (pk 'fail x #f)))))) > + > +(test-end "composer") > > base-commit: fafd3caef0d51811a5da81d6061789e2908b0dac > prerequisite-patch-id: eb618ab7b10483d917c308a38792af98baa517e2 > prerequisite-patch-id: c12968d02d99c253f858586a86b16fa32d41f1c1 > prerequisite-patch-id: 09d995d48139f8e61183d5634cda13a01cdb50f7 > prerequisite-patch-id: 86baa45ec2aad977c8c8135f7613aa391155de6d > prerequisite-patch-id: 3425fbbff6a603d60b4e143ea2141aabf4ddc92c > prerequisite-patch-id: c373c01aab5dcba3503a97d51c62a595147a041c > prerequisite-patch-id: cda857c790b88c681c4e713c5f71e40291970daf > prerequisite-patch-id: 8e234d0f4d93d2aad499eec8842be3d28da98707 > prerequisite-patch-id: 5f664cb2fd995a53765c5ffc19a708ac795cc0c4 > prerequisite-patch-id: ed447cba9cf9b7e1a1b47aa27acb14f8f2da0a8e > prerequisite-patch-id: 9f80c5bbbfb8cd3347951c4d57634e93ffa79924 > prerequisite-patch-id: 1aaa9f0d466e2d6837f75844df48a98beb70ff24 > prerequisite-patch-id: 34502820d8c0355b3ed2638c457084edeaba029d > prerequisite-patch-id: a96258da9e78cfb9ac9893cdcdeb38b69b75f134 > prerequisite-patch-id: 4a2da4ee89dbbdb2244845149ce6da967ddd5268 > prerequisite-patch-id: 9f9c4205781d1f0e2bb7af2d21875de08ee3ecd5 > prerequisite-patch-id: 9697db9b50cab8f7974c32383e0a9a786ecbd8f9 > prerequisite-patch-id: ebbd089a3313232347273c723d3deb1bf8c9bf81 > prerequisite-patch-id: e93360d66936b9efd70a6ffd41f6ecda177ad7b8 > prerequisite-patch-id: 19d76f45db1c59bd9ccd2e4e1125ffd698e9d6ce > prerequisite-patch-id: 929b39ded7ad095e9f768f7d484bbd3b7a486a3c > prerequisite-patch-id: 5e1262f77d55c91eadca113223faa84935bffd60 > prerequisite-patch-id: ad370d41983418fa704215aa3458f97c75d5d128 > prerequisite-patch-id: f179c922613390d249a365625c2ee545a908029d > prerequisite-patch-id: 03b0aaa382ddda0819ddb62479cd1885c930ddea > prerequisite-patch-id: 83b8b3a072520705dcba4b67712a29553bea1548 > prerequisite-patch-id: 9308fa06526d9bacdbcdd347cc225f6f3f87811a > prerequisite-patch-id: a017243a1a4b406caed9cec048d194cdc33d1a25 > prerequisite-patch-id: e8d5b2e787904b0dd1a650d7a0012b91a430cb03 > prerequisite-patch-id: 1cc872245864ace22db43cf2d268a87190b333b6 > prerequisite-patch-id: c277dcca77f3acde51bdffe932b9250e454086ad > prerequisite-patch-id: ea926073e68d5af7f6c76a6333520cc5f42c9789 > prerequisite-patch-id: 10008b9b34ccc8f87f2fcd8391075fe57244ac72 > prerequisite-patch-id: 443d7e3eb85f36848c2120979f9f1d3a78f8bf38 > prerequisite-patch-id: 6414c2d65c1806942d7f834e9300a8ecf8fd743f > prerequisite-patch-id: 8c6dec06b716c39ca7fada0f2872078612917779 > prerequisite-patch-id: 62e28252e9b7ab11edb03609b68369feb499f883 > prerequisite-patch-id: 84c9361c4c6d7662cfb3235cc4a6640a53e00622 > prerequisite-patch-id: 0f27045bc50089a9a88da7818448a50cd28dd295 > prerequisite-patch-id: 500413da3a81e75c5fbca62a21d9457d7b1ad8a8 > prerequisite-patch-id: 6f48169f4d69da277bcdecb8f40d2f608941d9f9 > prerequisite-patch-id: fc8b43573cc6b90033769de63ca235b16159190d > prerequisite-patch-id: ae749fc3fa0ab1768841ffb4633847b5b2233881 > prerequisite-patch-id: 46b8490d2b338229a2f3c5e39427275cf46982ba > prerequisite-patch-id: b1bb7dfb35069a2b30f5b2714bc19a249be3e1b5 > prerequisite-patch-id: 94848222eb08beb53530ba6ce626e9d8bcffecd4 > prerequisite-patch-id: f8181365677e68d8628013c7636e9ff56214ac9e > prerequisite-patch-id: aebc0f8156c409599cc7aced4b708bb5ea08a2b2 > prerequisite-patch-id: 4ce416249f6d3176a51d7e4cbbd2c6bf2982bab6 > prerequisite-patch-id: 5e14463dcc090e497bb1d29c1b4c822b43d5fdca > prerequisite-patch-id: 89306b41386cb29db7c147e8c4468a3b4d8d292d > prerequisite-patch-id: 29e414b1ede9108047ff224e1e24a3adb2c44c52 > prerequisite-patch-id: 7e15edfd04cd291f54284d13dcdbebcfb456b752 > prerequisite-patch-id: b8c18091929e58b49847ab510d3d75a8a934cad0 > prerequisite-patch-id: 7a607a1659b22afb0c21dec3d8eb1e2ed51e47a9 > prerequisite-patch-id: 89fbd04f11e5bef5703ba7ea4c2064d5ba63c4d4 > prerequisite-patch-id: b421048677352ea536dd93a61d6de987fb95d60b > prerequisite-patch-id: 25a03298bdfd6a691bb8cf68690009f8e46447e0 > prerequisite-patch-id: 3924163576eafdac47ac06de311ac317730e6631 > prerequisite-patch-id: 69b1d81677b507242f556c3e2fcf5290aeca445c > prerequisite-patch-id: a378fa79002001da51ae91eb026769eddb8a593b > prerequisite-patch-id: 86bb35c89ec3cc1b6ec47f238c84a154d5e9a1aa > prerequisite-patch-id: f8d0709d94ed99b1530bad1908ca27b1b56ea84e > prerequisite-patch-id: dcb65983aa914b8f1d1a8fbdfba34714ddb7f6fa > prerequisite-patch-id: 89752146a063d0706885819e244b4179196538b8 > prerequisite-patch-id: 1f9e7627d0b23302159cdab3d939fcec52f7ca70 > prerequisite-patch-id: f706bfa95ba0e5e72c206537ed207feb95daa888 > prerequisite-patch-id: 9b60c519b0df65eeacd5779808e0d75b011ebf7f > prerequisite-patch-id: cd6cd74eca502ebce581c223cd0d2ac4278912e8 > prerequisite-patch-id: b86e08404ef83877dfa3b76a80a12b02c61b1326 > prerequisite-patch-id: 9417f8d92995cf417bb3c4afa0786b05a756d48a > prerequisite-patch-id: 59dda13243375b013396981a4f9e17abd694d734 > prerequisite-patch-id: 89be058d0605cb8278d5d3384bb44911b188dd90 > prerequisite-patch-id: 70c26fde2fde34c031a95ef74a3321710dc4961e > prerequisite-patch-id: 38a27cdf8cbe03fdf5f9bafa5ba53f3ba644a5ad > prerequisite-patch-id: 40a6d2e51dff2531c40a38087a8aea1be7108792 > prerequisite-patch-id: 024d1bba9bcd449d2b8196b2f1a64a197cafaed8 > prerequisite-patch-id: e83d54aa767ebab267530fca74d60366160a5253 > prerequisite-patch-id: c34734661161c27224316dc519609db5c6d87a1e > prerequisite-patch-id: a58d739146fe46f6c7f203e5d2e0f114bd3f7834 > prerequisite-patch-id: 1ff8499f5ec69b737d77053e6809ec3a0b599ebc > prerequisite-patch-id: 498e5608bca9b5ebcb3592a556e75f5dcc2b7076 > prerequisite-patch-id: df6dfdea7c3d9db4649d857ce55fbeb99d4febca > prerequisite-patch-id: 453b66b1faaaebaa1666954185de327298aa0578 > prerequisite-patch-id: f98da1de781c203a53cae73c5bb707240d21cb0a > prerequisite-patch-id: 14b1718dbc4fb9cd94e1094a4d44ebfcfe6ad869 > prerequisite-patch-id: 3b68944fa8fb2fab0c21d6ff73f649f53dd6f551 > prerequisite-patch-id: 82d1e6bcd221f982b6ab1ed0e9a90d46a39562c4 > prerequisite-patch-id: c9cce20b146f955b715d15c0c384c9acc6176493 > prerequisite-patch-id: c204491c1db4f5056711768265f101e881e4e415 > prerequisite-patch-id: e66e13fbde027e99552fc6d80ff8d48c110a18f2 > prerequisite-patch-id: 3c313f0a20730c653c8f5ec4f318e2485a8ef60f > prerequisite-patch-id: 925c466172c01c4b5976ac019961cbe240f0cddd > prerequisite-patch-id: e81e0aded80adf18c861f67624a179a15ef68906 > prerequisite-patch-id: 001675f7da57d25731c7c71f6f2dcaa7409e5664 > prerequisite-patch-id: d65bf6ef5f51da0acba72d332d60167b34e193e1 > prerequisite-patch-id: fc7c9a5024037363319b58520480a6c4a8a5dcff > prerequisite-patch-id: 5aae8c77d028459d944021f4943558411deb0662 > prerequisite-patch-id: 71fa80813ad36528e8a737249424d90827933c16 > prerequisite-patch-id: 65dc75b8e1ddb45542480a8867ecd7a63ab3112e > prerequisite-patch-id: 8619aa1dec17409d9b5ecb6ed0a2cc7d1563c174 > prerequisite-patch-id: 6473142746dc5b448ec9698d577f47b4da6cd1d5 > prerequisite-patch-id: eb6689695d5d1b6c650de0c86a805a45b80ab88d > prerequisite-patch-id: 7d50679dad38c9f859ec231da2db78919818b40e > prerequisite-patch-id: faeb97c5f9c07754bd0bf0be59254091470978c2 > prerequisite-patch-id: 56e31c3ab9ed9ff19aca25d5ffb9655c6515b692 > prerequisite-patch-id: 8d7418e017eec3c6e56b55f9ff6181cc3dcc1a17 > prerequisite-patch-id: 84f58e5a274c980ae6905e764d479e1c960149ca > prerequisite-patch-id: ada6a2d9427bff9dd7fd115a91300a1f7379995c > prerequisite-patch-id: 108161d5500b39b3ac55d202b5b9af817d829724 > prerequisite-patch-id: c89b0fc7dadc53facc45ccf9991503430b7e7799 > prerequisite-patch-id: d62e2be8f9fd6a1d9ac8dfa2cdc4db6d4a4327ac > prerequisite-patch-id: f8f4375b2b16ffae596d416607c00b374f485299 > prerequisite-patch-id: 36b1a9c3e0e9f91b7172e1211231759a6cb81473 > prerequisite-patch-id: 8cb6ac6a5188c817bb3a6a86920001de75bb7225 > prerequisite-patch-id: 17ef87336a8c664e0109a7466c9f7d37f5901167
Hi Nicolas, Nicolas Graves <ngraves@ngraves.fr> skribis: > * guix/import/composer.scm: New file. > * guix/scripts/import/composer.scm: New file. > * guix/tests/composer.scm: New file. > * Makefile.am: Add them. > * guix/scripts/import.scm: Add composer importer. > * doc/guix.texi (Invoking guix import): Mention it. I’m a bit at loss with this patch series because there are two v3 threads, one v4 thread that contains a single patch, and the original versions contained many more patches. I think it’s OK to separate out the “gnu: Add php-*” patches, it’s probably clearer. However, could you come up with a v5 that includes all the ‘guix import composer’ changes that we would need to apply? How does that sound? I have a couple of comments: > +@item composer > +@cindex Composer > +@cindex PHP > +Import metadat from the @uref{https://getcomposer.org/, Composer} package ^ Typo. > +++ b/guix/import/composer.scm > @@ -0,0 +1,270 @@ > +;;; GNU Guix --- Functional package management for GNU > +;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> Maybe add yourself too? > +;; 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) These two procedures are now exported from (guix hash), so you can remove them and #:use-module (guix hash) instead. > +(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)) Instead of returning an alist, directly return a <composer-package> record. > +(define (php-package? package) > + "Return true if PACKAGE is a PHP package from Packagist." > + (and > + (eq? (build-system-name (package-build-system package)) 'composer) Rather: (eq? (package-build-system package) composer-build-system). (The ‘name’ field is for debugging purposes only.) > +(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)) > + (version (composer-package-version package)) > + (url (composer-source-url (composer-package-source package)))) > + (upstream-source > + (package (package-name package)) > + (version version) > + (urls (list url))))) Maybe we can do that later, but note that <upstream-source> has an ‘inputs’ field nowadays; if you feel it in, ‘guix refresh -u’ is able to update dependencies in addition to version/hash. (If you leave it for later, please add a TODO.) > +;; Avoid collisions with other tests. > +(%http-server-port 10450) This is now unnecessary: by default a random unused port is chosen and everything’s fine. > +(test-begin "composer") > + > +(test-assert "composer->guix-package" > + ;; Replace network resources with sample data. > + (with-http-server `((200 ,test-json) > + (200 ,test-source)) > + (parameterize ((%composer-base-url (%local-url)) > + (current-http-proxy (%local-url))) > + (match (composer->guix-package "foo/bar") > + (('package > + ('name "php-foo-bar") > + ('version "0.1") For clarity, you can write: (match … (`(package (name "php-foo-bar") (version "0.1") …) …)) See commit 654fcf9971bb01389d577be07c6ec0f68940c743. > + ('native-inputs > + ('quasiquote > + (("php-phpunit-phpunit" ('unquote 'php-phpunit-phpunit))))) Please change the importer so that it emits inputs without labels: (native-inputs (list php-phpunit-phpunit)) One last thing: consider adding an ‘etc/news.scm’ entry so people can learn about the new importer. Thanks in advance! Ludo’.
diff --git a/Makefile.am b/Makefile.am index 8924974e8a..3ce7ee832e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -274,6 +274,7 @@ MODULES = \ guix/search-paths.scm \ guix/packages.scm \ guix/import/cabal.scm \ + guix/import/composer.scm \ guix/import/cpan.scm \ guix/import/cran.scm \ guix/import/crate.scm \ @@ -332,6 +333,7 @@ MODULES = \ guix/scripts/home/import.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ + guix/scripts/import/composer.scm \ guix/scripts/import/crate.scm \ guix/scripts/import/cpan.scm \ guix/scripts/import/cran.scm \ @@ -500,6 +502,7 @@ SCM_TESTS = \ tests/challenge.scm \ tests/channels.scm \ tests/combinators.scm \ + tests/composer.scm \ tests/containers.scm \ tests/cpan.scm \ tests/cpio.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 46591b2f64..4d2fc11cd7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14530,6 +14530,26 @@ Invoking guix import Additional options include: +@table @code +@item --recursive +@itemx -r +Traverse the dependency graph of the given upstream package recursively +and generate package expressions for all those packages that are not yet +in Guix. +@end table + +@item composer +@cindex Composer +@cindex PHP +Import metadat from the @uref{https://getcomposer.org/, Composer} package +archive used by the PHP community, as in this example: + +@example +guix import composer phpunit/phpunit +@end example + +Additional options include: + @table @code @item --recursive @itemx -r diff --git a/guix/import/composer.scm b/guix/import/composer.scm new file mode 100644 index 0000000000..c152f402bb --- /dev/null +++ b/guix/import/composer.scm @@ -0,0 +1,270 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix import composer) + #:use-module (ice-9 match) + #:use-module (json) + #:use-module (gcrypt hash) + #:use-module (guix base32) + #:use-module (guix build git) + #:use-module (guix build utils) + #:use-module (guix build-system) + #:use-module (guix import json) + #:use-module (guix import utils) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (guix serialization) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:export (composer->guix-package + %composer-updater + composer-recursive-import + + %composer-base-url)) + +(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 + ((string-prefix? "version" version) + (if (char-set-contains? char-set:digit (string-ref version 7)) + (substring version 7) + (substring version 8))) + ((string-prefix? "v" version) + (substring version 1)) + (else version))) + +(define (latest-version versions) + (fold (lambda (a b) (if (version>? (fix-version a) (fix-version b)) a b)) + (car versions) versions)) + +(define (json->require dict) + (if dict + (let loop ((result '()) (require dict)) + (match require + (() result) + ((((? (cut string-contains <> "/") name) . _) + require ...) + (loop (cons name result) require)) + ((_ require ...) (loop result require)))) + '())) + +(define-json-mapping <composer-source> make-composer-source composer-source? + json->composer-source + (type composer-source-type) + (url composer-source-url) + (reference composer-source-reference)) + +(define-json-mapping <composer-package> make-composer-package composer-package? + json->composer-package + (description composer-package-description) + (homepage composer-package-homepage) + (source composer-package-source "source" json->composer-source) + (name composer-package-name "name" php-package-name) + (version composer-package-version "version" fix-version) + (require composer-package-require "require" json->require) + (dev-require composer-package-dev-require "require-dev" json->require) + (license composer-package-license "license" + (lambda (vector) + (map string->license (vector->list vector))))) + +(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)) + #f))) + +(define (php-package-name name) + "Given the NAME of a package on Packagist, return a Guix-compliant name for +the package." + (let ((name (string-join (string-split name #\/) "-"))) + (if (string-prefix? "php-" name) + (snake-case name) + (string-append "php-" (snake-case name))))) + +(define (make-php-sexp composer-package) + "Return the `package' s-expression for a PHP package for the given +COMPOSER-PACKAGE." + (let* ((source (composer-package-source composer-package)) + (dependencies (map php-package-name + (composer-package-require composer-package))) + (dev-dependencies (map php-package-name + (composer-package-dev-require composer-package))) + (git? (equal? (composer-source-type source) "git"))) + ((if git? call-with-temporary-directory call-with-temporary-output-file) + (lambda* (temp #:optional port) + (and (if git? + (begin + (mkdir-p temp) + (git-fetch (composer-source-url source) + (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 + (,'quasiquote + ,(map (lambda (name) + `(,name + (,'unquote + ,(string->symbol name)))) + dependencies))))) + ,@(if (null? dev-dependencies) + '() + `((native-inputs + (,'quasiquote + ,(map (lambda (name) + `(,name + (,'unquote + ,(string->symbol name)))) + dev-dependencies))))) + (synopsis "") + (description ,(composer-package-description composer-package)) + (home-page ,(composer-package-homepage composer-package)) + (license ,(match (composer-package-license composer-package) + (() #f) + ((license) license) + (_ license))))))))) + +(define* (composer->guix-package package-name #:optional version) + "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))) + (and package + (let* ((package (json->composer-package package)) + (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)))))) + +(define (guix-name->composer-name name) + "Given a guix package name, return the name of the package in Packagist." + (if (string-prefix? "php-" name) + (let ((components (string-split (substring name 4) #\-))) + (match components + ((namespace name ...) + (string-append namespace "/" (string-join name "-"))))) + name)) + +(define (guix-package->composer-name package) + "Given a Composer PACKAGE built from Packagist, return the name of the +package in Packagist." + (let ((upstream-name (assoc-ref + (package-properties package) + 'upstream-name)) + (name (package-name package))) + (if upstream-name + upstream-name + (guix-name->composer-name name)))) + +(define (string->license str) + "Convert the string STR into a license object." + (match str + ("GNU LGPL" 'license:lgpl2.0) + ("GPL" 'license:gpl3) + ((or "BSD" "BSD License" "BSD-3-Clause") 'license:bsd-3) + ((or "MIT" "MIT license" "Expat license") 'license:expat) + ("Public domain" 'license:public-domain) + ((or "Apache License, Version 2.0" "Apache 2.0") 'license:asl2.0) + (_ #f))) + +(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)))) + +(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)) + (version (composer-package-version package)) + (url (composer-source-url (composer-package-source package)))) + (upstream-source + (package (package-name package)) + (version version) + (urls (list url))))) + +(define %composer-updater + (upstream-updater + (name 'composer) + (description "Updater for Composer packages") + (pred php-package?) + (import latest-release))) + +(define* (composer-recursive-import package-name #:optional version) + (recursive-import package-name '() + #:repo->guix-package composer->guix-package + #:guix-name php-package-name)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 4ddd8d46a1..8c58dd35e2 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -47,7 +47,7 @@ (define %standard-import-options '()) (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" "gem" "go" "cran" "crate" "texlive" "json" "opam" - "minetest" "elm" "hexpm")) + "minetest" "elm" "hexpm" "composer")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/composer.scm b/guix/scripts/import/composer.scm new file mode 100644 index 0000000000..412bae6318 --- /dev/null +++ b/guix/scripts/import/composer.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import composer) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import composer) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-composer)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import composer PACKAGE-NAME +Import and convert the Composer package for PACKAGE-NAME.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (display (G_ " + -r, --recursive generate package expressions for all Composer packages\ + that are not yet in Guix")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import composer"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-composer . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (if (assoc-ref opts 'recursive) + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (composer-recursive-import package-name)) + (let ((sexp (composer->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/tests/composer.scm b/tests/composer.scm new file mode 100644 index 0000000000..cefaf9f434 --- /dev/null +++ b/tests/composer.scm @@ -0,0 +1,92 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-composer) + #:use-module (guix import composer) + #:use-module (guix base32) + #:use-module (gcrypt hash) + #:use-module (guix tests http) + #:use-module (guix grafts) + #:use-module (srfi srfi-64) + #:use-module (web client) + #:use-module (ice-9 match)) + +;; Globally disable grafts because they can trigger early builds. +(%graft? #f) + +(define test-json + "{ + \"packages\": { + \"foo/bar\": { + \"0.1\": { + \"name\": \"foo/bar\", + \"description\": \"description\", + \"keywords\": [\"testing\"], + \"homepage\": \"http://example.com\", + \"version\": \"0.1\", + \"license\": [\"BSD-3-Clause\"], + \"source\": { + \"type\": \"url\", + \"url\": \"http://example.com/Bar-0.1.tar.gz\" + }, + \"require\": {}, + \"require-dev\": {\"phpunit/phpunit\": \"1.0.0\"} + } + } + } +}") + +(define test-source + "foobar") + +;; Avoid collisions with other tests. +(%http-server-port 10450) + +(test-begin "composer") + +(test-assert "composer->guix-package" + ;; Replace network resources with sample data. + (with-http-server `((200 ,test-json) + (200 ,test-source)) + (parameterize ((%composer-base-url (%local-url)) + (current-http-proxy (%local-url))) + (match (composer->guix-package "foo/bar") + (('package + ('name "php-foo-bar") + ('version "0.1") + ('source ('origin + ('method 'url-fetch) + ('uri "http://example.com/Bar-0.1.tar.gz") + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'composer-build-system) + ('native-inputs + ('quasiquote + (("php-phpunit-phpunit" ('unquote 'php-phpunit-phpunit))))) + ('synopsis "") + ('description "description") + ('home-page "http://example.com") + ('license 'license:bsd-3)) + (string=? (bytevector->nix-base32-string + (call-with-input-string test-source port-sha256)) + hash)) + (x + (pk 'fail x #f)))))) + +(test-end "composer")