From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id 6IozE77mY191JAAA0tVLHw (envelope-from ) for ; Thu, 17 Sep 2020 22:44:14 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id UHcGD77mY1+mDgAAbx9fmQ (envelope-from ) for ; Thu, 17 Sep 2020 22:44:14 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 978C3940365 for ; Thu, 17 Sep 2020 22:44:13 +0000 (UTC) Received: from localhost ([::1]:34884 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kJ2dQ-0005JN-Dh for larch@yhetil.org; Thu, 17 Sep 2020 18:44:12 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:57118) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kJ2dG-0005Hi-Dn for guix-patches@gnu.org; Thu, 17 Sep 2020 18:44:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:56659) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kJ2dG-0006kk-4K for guix-patches@gnu.org; Thu, 17 Sep 2020 18:44:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kJ2dG-0002p7-6W for guix-patches@gnu.org; Thu, 17 Sep 2020 18:44:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42338] [PATCH 01/34] guix: import: Add composer importer. Resent-From: Julien Lepiller Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 17 Sep 2020 22:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42338 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 42338@debbugs.gnu.org Received: via spool by 42338-submit@debbugs.gnu.org id=B42338.160038263410832 (code B ref 42338); Thu, 17 Sep 2020 22:44:02 +0000 Received: (at 42338) by debbugs.gnu.org; 17 Sep 2020 22:43:54 +0000 Received: from localhost ([127.0.0.1]:39972 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kJ2d3-0002oa-6B for submit@debbugs.gnu.org; Thu, 17 Sep 2020 18:43:54 -0400 Received: from lepiller.eu ([89.234.186.109]:60156) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kJ2d0-0002oQ-Sy for 42338@debbugs.gnu.org; Thu, 17 Sep 2020 18:43:48 -0400 Received: from lepiller.eu (localhost [127.0.0.1]) by lepiller.eu (OpenSMTPD) with ESMTP id 3fb8f51c; Thu, 17 Sep 2020 22:43:44 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed; d=lepiller.eu; h=date:from :to:cc:subject:message-id:in-reply-to:references:mime-version :content-type; s=dkim; bh=wNZQ0+XdWWGsaMA+RR2MlZ8/1Eyqs1IH5r7qqU g8Tjc=; b=ghNrXtkCyHBi+b7eAobLTKJtqOQ+VS7Ejz66Et+eg+P+G74HO/oVzV hGjbZhDtv29nwf6cPLiNv3J6RTCjC1bkJrcrgdho/xlp+dPzBdN+8ZagoXBm8Xx8 dxVMWbVAFDp6wInInmqtlQqtfD8Nwki1GcuXqzP9sBwE/mFppMkio56DCbwa5T2C wvk/k1DEY1occWDzqnvrGdrtyQEafTaemPc4uNIjswYmTN4MATypQaaJFRxJ+7Up /hCGmhnhZqjXVoBkcUsUHWbaxQkNqmkLKcuMwP+ulEBMUhgJLCDHwz1IGW//tbCj zJeTQULxwXotTj01CyPyGuuYR84WbdKQ== Received: by lepiller.eu (OpenSMTPD) with ESMTPSA id 8e35d7f8 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO); Thu, 17 Sep 2020 22:43:44 +0000 (UTC) Date: Fri, 18 Sep 2020 00:43:33 +0200 From: Julien Lepiller Message-ID: <20200918004333.127aa5da@tachikoma.lepiller.eu> In-Reply-To: <87mu21heay.fsf@gnu.org> References: <20200713002055.1553f136@tachikoma.lepiller.eu> <20200712222538.18092-1-julien@lepiller.eu> <87mu21heay.fsf@gnu.org> X-Mailer: Claws Mail 3.17.6 (GTK+ 2.24.32; x86_64-unknown-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/Nb0qTNLZeDOi6GOcim.fLs2" X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -1.0 (-) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=fail (rsa verify failed) header.d=lepiller.eu header.s=dkim header.b=ghNrXtkC; dmarc=fail reason="SPF not aligned (relaxed)" header.from=lepiller.eu (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: 0.09 X-TUID: 3/g+OTLRCGG2 --MP_/Nb0qTNLZeDOi6GOcim.fLs2 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Le Mon, 07 Sep 2020 16:06:13 +0200, Ludovic Court=C3=A8s a =C3=A9crit : > Hi Julien, >=20 > There=E2=80=99s a lot of interesting work in here! I=E2=80=99m not famil= iar with PHP; > I=E2=80=99ll just make a bird=E2=80=99s eye review. >=20 > Julien Lepiller skribis: >=20 > > * guix/import/composer.scm: New file. > > * guix/scripts/import/composer.scm: New file. > > * Makefile.am: Add them. > > * guix/scripts/import.scm: Add composer importer. =20 >=20 > Please add tests and a mention in =E2=80=9CInvoking guix import=E2=80=9D = in the > manual. >=20 > For tests, a strategy that I think works well is that used in > tests/cpan.scm, where we spawn an HTTP server to mock the real one. >=20 > > +(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 "https://repo.packagist.org/p/" > > name ".json")))) > > + (if package > > + (let* ((packages (assoc-ref package "packages")) > > + (package (assoc-ref packages name)) > > + (versions (filter > > + (lambda (version) > > + (and (not (string-contains version > > "dev")) > > + (not (string-contains version > > "beta")))) > > + (map car package))) > > + (versions (map > > + (lambda (version) > > + (cons (fix-version version) version)) > > + versions)) > > + (version (or (if (null? version) #f version) > > + (latest-version (map car versions))))) > > + (assoc-ref package (assoc-ref versions version))) > > + #f))) =20 >=20 > I recommend using =E2=80=98define-json-mapping=E2=80=99 instead of browsi= ng alists: > it=E2=80=99s less error-prone, hides the JSON details away, and leads to = more > readable code. The pypi, crates, cpan importers use it. >=20 > Thanks! >=20 > Ludo=E2=80=99. Thanks, here's a new version --MP_/Nb0qTNLZeDOi6GOcim.fLs2 Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=0001-guix-import-Add-composer-importer.patch =46rom 6d521ca9f066f82488abefd5d3630e38305c0fd1 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Tue, 29 Oct 2019 08:07:38 +0100 Subject: [PATCH 01/34] guix: import: Add composer importer. * 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 | 6 + guix/import/composer.scm | 257 +++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/composer.scm | 107 +++++++++++++ tests/composer.scm | 92 +++++++++++ 6 files changed, 466 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 8e91e1e558..6ce1430ea6 100644 --- a/Makefile.am +++ b/Makefile.am @@ -223,6 +223,7 @@ MODULES =3D \ 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 \ @@ -269,6 +270,7 @@ MODULES =3D \ guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ + guix/scripts/import/composer.scm \ guix/scripts/import/crate.scm \ guix/scripts/import/cran.scm \ guix/scripts/import/elpa.scm \ @@ -402,6 +404,7 @@ SCM_TESTS =3D \ 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 88128a4b3a..ca4eb347c7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10164,6 +10164,12 @@ in Guix. @cindex OCaml Import metadata from the @uref{https://opam.ocaml.org/, OPAM} package repository used by the OCaml community. + +@item composer +@cindex COMPOSER +@cindex PHP +Import metadat from the @uref{https://getcomposer.org/, Composer} package +archive used by the PHP community. @end table =20 The structure of the @command{guix import} code is modular. It would be diff --git a/guix/import/composer.scm b/guix/import/composer.scm new file mode 100644 index 0000000000..db8075edb2 --- /dev/null +++ b/guix/import/composer.scm @@ -0,0 +1,257 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2019 Julien Lepiller +;;; +;;; 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 . + +(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) + #: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=3D? (basename file) ".git")) + (else + #f))) + +(define (latest-version versions) + (fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions)) + +(define (fix-version version) + "Return a fixed version from a version string. For instance, v10.1 -> 1= 0.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* (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 (assoc-ref packages name)) + (versions (filter + (lambda (version) + (and (not (string-contains version "dev")) + (not (string-contains version "beta")))) + (map car package))) + (versions (map + (lambda (version) + (cons (fix-version version) version)) + versions)) + (version (or (if (null? version) #f version) + (latest-version (map car versions))))) + (assoc-ref package (assoc-ref versions 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 name version home-page description dependencies + dev-dependencies licenses source) + "Return the `package' s-expression for a PHP package with the given NAME, +VERSION, HOME-PAGE, DESCRIPTION, DEPENDENCIES, LICENSES and SOURCE." + (let ((git? (equal? (assoc-ref source "type") "git"))) + ((if git? call-with-temporary-directory call-with-temporary-output-fil= e) + (lambda* (temp #:optional port) + (and (if git? + (begin + (mkdir-p temp) + (git-fetch (assoc-ref source "url") + (assoc-ref source "reference") + temp)) + (url-fetch (assoc-ref source "url") temp)) + `(package + (name ,(php-package-name name)) + (version ,version) + (source (origin + ,@(if git? + `((method git-fetch) + (uri (git-reference + (url ,(assoc-ref source "url")) + (commit ,(assoc-ref source "refere= nce")))) + (file-name (git-file-name name version)) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (file-hash temp (negate vcs-file?) = #t))))) + `((method url-fetch) + (uri ,(assoc-ref source "url")) + (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 ,description) + (home-page ,home-page) + (license ,(match licenses + (() #f) + ((license) (license->symbol license)) + (_ `(list ,@(map license->symbol licenses))))))= ))))) + +(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* ((name (assoc-ref package "name")) + (version (fix-version (assoc-ref package "version"))) + (description (beautify-description + (assoc-ref package "description"))) + (home-page (assoc-ref package "homepage")) + (dependencies-names (filter + (lambda (dep) + (string-contains dep "/")) + (map car (assoc-ref package "require= ")))) + (dependencies (map php-package-name dependencies-names)) + (require-dev (assoc-ref package "require-dev")) + (dev-dependencies-names + (if require-dev + (filter + (lambda (dep) + (string-contains dep "/")) + (map car require-dev)) + '())) + (dev-dependencies (map php-package-name dev-dependencies-n= ames)) + (licenses (map string->license + (vector->list + (assoc-ref package "license"))))) + (values (make-php-sexp name version home-page description depen= dencies + dev-dependencies licenses (assoc-ref pac= kage "source")) + (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 for the latest release of PACKAGE." + (let* ((php-name (guix-package->composer-name package)) + (metadata (composer-fetch php-name)) + (version (fix-version (assoc-ref metadata "version"))) + (url (assoc-ref (assoc-ref metadata "source") "url"))) + (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?) + (latest 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 0a3863f965..23da295e48 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -77,7 +77,7 @@ rather than \\n." ;;; =20 (define importers '("gnu" "nix" "pypi" "cpan" "hackage" "stackage" "elpa" = "gem" - "cran" "crate" "texlive" "json" "opam")) + "cran" "crate" "texlive" "json" "opam" "composer")) =20 (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/composer.scm b/guix/scripts/import/compose= r.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 =C2=A9 2015 David Thompson +;;; Copyright =C2=A9 2018 Oleg Pykhalov +;;; +;;; 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 . + +(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)) + +=0C +;;; +;;; 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 pac= kages\ + 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)) + +=0C +;;; +;;; 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 =C2=A9 2020 Julien Lepiller +;;; +;;; 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 . + +(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=3D? (bytevector->nix-base32-string + (call-with-input-string test-source port-sha256)) + hash)) + (x + (pk 'fail x #f)))))) + +(test-end "composer") --=20 2.28.0 --MP_/Nb0qTNLZeDOi6GOcim.fLs2--