[bug#42338,v3,1/7] guix: import: Add composer importer.
Commit Message
* 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
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
Comments
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’.
@@ -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 \
@@ -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
new file mode 100644
@@ -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))
@@ -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
new file mode 100644
@@ -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~%"))))))
new file mode 100644
@@ -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")