From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:403:478a::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms9.migadu.com with LMTPS id KFsfHHmzEmXQLQEA9RJhRA:P1 (envelope-from ) for ; Tue, 26 Sep 2023 12:33:29 +0200 Received: from aspmx1.migadu.com ([2001:41d0:403:478a::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id KFsfHHmzEmXQLQEA9RJhRA (envelope-from ) for ; Tue, 26 Sep 2023 12:33:29 +0200 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 F079756263 for ; Tue, 26 Sep 2023 12:33:28 +0200 (CEST) Authentication-Results: aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1695724409; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=bPLpJo44ZG+ki4BmKWA2FSTpPdSFCsRHDjAzoIo3pdY=; b=TmKNaPbwkyMiCbDcJe0on1J8zSqcJNR10+QC6qZFOwjYSqKf16PzbA1X+qzztbX3AChYmL XxEy/wceq2nwdYTIjHIDv8HgtcbokuXmbkBlRaA4gAZEedweATkMgRsguQsfliJTvgTOn3 yrF5Wmile63NkzXrIweBCBXtyRjTDGs3ET0BjluPJdtItavIk1yQxmaAFBRp6CmFCuqd8E tcC4W8WPHOBZU4Xcybz2OQeL0cus2doiXnHu+XxGZ/nMauNd/s4yU/st03qdPJbYqZF9H/ 799avZm4rVn8kaA6kdHs0eeS96f0nt4XH4BEC5UfaJCAJzej88nQp2TGVK2bpQ== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1695724409; a=rsa-sha256; cv=none; b=CncaWj7jyxxq8zLXX57QCn8iYGHFJru5KOjy6tuBy49Lw+YVD6ZT39xeSH8dIzgXs0BTM3 euPnQyffBINIB6vrDr58rr2ou1IgkKl8pwF2L1agCxafhgeaM19X/spCBksHK2yzmD75o+ m+phsMLQVdh6Eu27pHbLm4Yqes9tfj/ZkWRh30FHijdD9y78wFNs5sz7kIOtUU49amzf4W zANoekFzmnKzKn/EEGYdXL4URJkLBcWdAJ/DF15nRmJPXe4bZpT/noeo0C501P41mlfJ7B 1OY53XYbEn7Lxroe045vqwYWr6HiCVl02vqyfBO3fQRGk93I80NXvwaxkUa8ow== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ql5N6-0002Jf-Cy; Tue, 26 Sep 2023 06:32:52 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ql5N4-0002Is-TO for guix-patches@gnu.org; Tue, 26 Sep 2023 06:32:50 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ql5N4-0000oH-LC for guix-patches@gnu.org; Tue, 26 Sep 2023 06:32:50 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ql5NH-00007I-HE for guix-patches@gnu.org; Tue, 26 Sep 2023 06:33:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42338] [PATCH v3 3/7] guix: Add composer-build-system. Resent-From: Nicolas Graves Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 26 Sep 2023 10:33:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42338 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42338@debbugs.gnu.org Cc: ngraves@ngraves.fr Received: via spool by 42338-submit@debbugs.gnu.org id=B42338.1695724348350 (code B ref 42338); Tue, 26 Sep 2023 10:33:03 +0000 Received: (at 42338) by debbugs.gnu.org; 26 Sep 2023 10:32:28 +0000 Received: from localhost ([127.0.0.1]:47355 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ql5Mg-00005L-Ls for submit@debbugs.gnu.org; Tue, 26 Sep 2023 06:32:28 -0400 Received: from 10.mo584.mail-out.ovh.net ([188.165.33.109]:38059) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ql5MX-0008W1-6o for 42338@debbugs.gnu.org; Tue, 26 Sep 2023 06:32:20 -0400 Received: from director9.ghost.mail-out.ovh.net (unknown [10.108.16.60]) by mo584.mail-out.ovh.net (Postfix) with ESMTP id 534492817C for <42338@debbugs.gnu.org>; Tue, 26 Sep 2023 10:32:02 +0000 (UTC) Received: from ghost-submission-6684bf9d7b-pzmx6 (unknown [10.110.171.34]) by director9.ghost.mail-out.ovh.net (Postfix) with ESMTPS id CAF991FEDA; Tue, 26 Sep 2023 10:32:01 +0000 (UTC) Received: from ngraves.fr ([37.59.142.107]) by ghost-submission-6684bf9d7b-pzmx6 with ESMTPSA id ZtTALiGzEmUThwAA5xzM7g (envelope-from ); Tue, 26 Sep 2023 10:32:01 +0000 X-OVh-ClientIp: 81.67.140.142 Date: Tue, 26 Sep 2023 12:31:40 +0200 Message-ID: <1b5d97a0fdbc7ee0fb031e7488f4ca6ab8c28544.1695724304.git.ngraves@ngraves.fr> X-Mailer: git-send-email 2.41.0 In-Reply-To: <6abfbb4d4d57642fea6bae5835ff0d365de7e24a.1695724304.git.ngraves@ngraves.fr> References: <6abfbb4d4d57642fea6bae5835ff0d365de7e24a.1695724304.git.ngraves@ngraves.fr> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Ovh-Tracer-Id: 12907879482410984162 X-VR-SPAMSTATE: OK X-VR-SPAMSCORE: 0 X-VR-SPAMCAUSE: gggruggvucftvghtrhhoucdtuddrgedvjedrtddtgddtudcutefuodetggdotefrodftvfcurfhrohhfihhlvgemucfqggfjpdevjffgvefmvefgnecuuegrihhlohhuthemucehtddtnecunecujfgurhephffvvefufffkofgjfhggtgfgsehtkeertdertdejnecuhfhrohhmpefpihgtohhlrghsucfirhgrvhgvshcuoehnghhrrghvvghssehnghhrrghvvghsrdhfrheqnecuggftrfgrthhtvghrnhepvdfftdevheeugfeggfefjeekkeeghfduueetudduleeiffffudelgeetvdelfeeinecuffhomhgrihhnpehgvghttghomhhpohhsvghrrdhorhhgpdguuhhnvgdrsghuihhlugdpghhithhhuhgsrdgtohhmpdhgnhhurdhorhhgnecukfhppeduvdejrddtrddtrddupdekuddrieejrddugedtrddugedvpdefjedrheelrddugedvrddutdejnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehinhgvthepuddvjedrtddrtddruddpmhgrihhlfhhrohhmpeeonhhgrhgrvhgvshesnhhgrhgrvhgvshdrfhhrqedpnhgspghrtghpthhtohepuddprhgtphhtthhopeegvdeffeekseguvggssghughhsrdhgnhhurdhorhhgpdfovfetjfhoshhtpehmohehkeegpdhmohguvgepshhmthhpohhuth X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Nicolas Graves X-ACL-Warn: , Nicolas Graves via Guix-patches From: Nicolas Graves via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Scanner: mx0.migadu.com X-Migadu-Spam-Score: -6.74 X-Spam-Score: -6.74 X-Migadu-Queue-Id: F079756263 X-TUID: ogqzMHVrAv2n * guix/build-system/composer.scm: New file. * guix/build/composer-build-system.scm: New file. * gnu/packages/aux-files/findclass.php: New file. * Makefile.am: Add them. * doc/guix.texi (Build Systems): Document it. --- Makefile.am | 3 + doc/guix.texi | 14 ++ gnu/packages/aux-files/findclass.php | 125 ++++++++++++++ guix/build-system/composer.scm | 162 ++++++++++++++++++ guix/build/composer-build-system.scm | 239 +++++++++++++++++++++++++++ 5 files changed, 543 insertions(+) create mode 100644 gnu/packages/aux-files/findclass.php create mode 100644 guix/build-system/composer.scm create mode 100644 guix/build/composer-build-system.scm diff --git a/Makefile.am b/Makefile.am index 3ce7ee832e..903fc42afa 100644 --- a/Makefile.am +++ b/Makefile.am @@ -149,6 +149,7 @@ MODULES = \ guix/build-system/chicken.scm \ guix/build-system/clojure.scm \ guix/build-system/cmake.scm \ + guix/build-system/composer.scm \ guix/build-system/dub.scm \ guix/build-system/dune.scm \ guix/build-system/elm.scm \ @@ -206,6 +207,7 @@ MODULES = \ guix/build/cargo-utils.scm \ guix/build/chicken-build-system.scm \ guix/build/cmake-build-system.scm \ + guix/build/composer-build-system.scm \ guix/build/dub-build-system.scm \ guix/build/dune-build-system.scm \ guix/build/elm-build-system.scm \ @@ -411,6 +413,7 @@ dist_noinst_DATA = \ AUX_FILES = \ gnu/packages/aux-files/chromium/master-preferences.json \ gnu/packages/aux-files/emacs/guix-emacs.el \ + gnu/packages/aux-files/findclass.php \ gnu/packages/aux-files/guix.vim \ gnu/packages/aux-files/linux-libre/6.4-arm.conf \ gnu/packages/aux-files/linux-libre/6.4-arm64.conf \ diff --git a/doc/guix.texi b/doc/guix.texi index 4d2fc11cd7..d133e43773 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9545,6 +9545,20 @@ Build Systems @code{-O2 -g}, as is the case for Autoconf-based packages by default. @end defvar +@defvar {Scheme Variable} composer-build-system +This variable is exported by @code{(guix build-system composer)}. It +implements the build procedure for packages using +@url{https://getcomposer.org/, Composer}, the PHP package manager. + +It automatically adds the @code{php} package to the set of inputs. Which +package is used can be specified with the @code{#:php} parameter. + +The @code{#:test-target} parameter is used to control which script is run +for the tests. By default, the @code{test} script is run if it exists. If +the script does not exist, the build system will run @code{phpunit} from the +source directory, assuming there is a @file{phpunit.xml} file. +@end defvar + @defvar dune-build-system This variable is exported by @code{(guix build-system dune)}. It supports builds of packages using @uref{https://dune.build/, Dune}, a build diff --git a/gnu/packages/aux-files/findclass.php b/gnu/packages/aux-files/findclass.php new file mode 100644 index 0000000000..d0b250c8e1 --- /dev/null +++ b/gnu/packages/aux-files/findclass.php @@ -0,0 +1,125 @@ + + * Jordi Boggiano + * + * For the full copyright and license information, please view the LICENSE + * file that was distributed with this source code. + * + * This file is copied from the Symfony package. + * + * (c) Fabien Potencier + * + * To the extent to wich it makes sense, as the author of the extract: + * Copyright © 2020 Julien Lepiller + */ + +/** + * Extract the classes in the given file + * + * @param string $path The file to check + * @throws \RuntimeException + * @return array The found classes + */ +function findClasses($path) +{ + $extraTypes = PHP_VERSION_ID < 50400 ? '' : '|trait'; + if (defined('HHVM_VERSION') && version_compare(HHVM_VERSION, '3.3', '>=')) { + $extraTypes .= '|enum'; + } + // Use @ here instead of Silencer to actively suppress 'unhelpful' output + // @link https://github.com/composer/composer/pull/4886 + $contents = @php_strip_whitespace($path); + if (!$contents) { + if (!file_exists($path)) { + $message = 'File at "%s" does not exist, check your classmap definitions'; + } elseif (!is_readable($path)) { + $message = 'File at "%s" is not readable, check its permissions'; + } elseif ('' === trim(file_get_contents($path))) { + // The input file was really empty and thus contains no classes + return array(); + } else { + $message = 'File at "%s" could not be parsed as PHP, it may be binary or corrupted'; + } + $error = error_get_last(); + if (isset($error['message'])) { + $message .= PHP_EOL . 'The following message may be helpful:' . PHP_EOL . $error['message']; + } + throw new \RuntimeException(sprintf($message, $path)); + } + // return early if there is no chance of matching anything in this file + if (!preg_match('{\b(?:class|interface'.$extraTypes.')\s}i', $contents)) { + return array(); + } + // strip heredocs/nowdocs + $contents = preg_replace('{<<<[ \t]*([\'"]?)(\w+)\\1(?:\r\n|\n|\r)(?:.*?)(?:\r\n|\n|\r)(?:\s*)\\2(?=\s+|[;,.)])}s', 'null', $contents); + // strip strings + $contents = preg_replace('{"[^"\\\\]*+(\\\\.[^"\\\\]*+)*+"|\'[^\'\\\\]*+(\\\\.[^\'\\\\]*+)*+\'}s', 'null', $contents); + // strip leading non-php code if needed + if (substr($contents, 0, 2) !== '(?:[^<]++|<(?!\?))*+<\?}s', '?>'); + if (false !== $pos && false === strpos(substr($contents, $pos), '])(?Pclass|interface'.$extraTypes.') \s++ (?P[a-zA-Z_\x7f-\xff:][a-zA-Z0-9_\x7f-\xff:\-]*+) + | \b(?])(?Pnamespace) (?P\s++[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*+(?:\s*+\\\\\s*+[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*+)*+)? \s*+ [\{;] + ) + }ix', $contents, $matches); + $classes = array(); + $namespace = ''; + for ($i = 0, $len = count($matches['type']); $i < $len; $i++) { + if (!empty($matches['ns'][$i])) { + $namespace = str_replace(array(' ', "\t", "\r", "\n"), '', $matches['nsname'][$i]) . '\\'; + } else { + $name = $matches['name'][$i]; + // skip anon classes extending/implementing + if ($name === 'extends' || $name === 'implements') { + continue; + } + if ($name[0] === ':') { + // This is an XHP class, https://github.com/facebook/xhp + $name = 'xhp'.substr(str_replace(array('-', ':'), array('_', '__'), $name), 1); + } elseif ($matches['type'][$i] === 'enum') { + // In Hack, something like: + // enum Foo: int { HERP = '123'; } + // The regex above captures the colon, which isn't part of + // the class name. + $name = rtrim($name, ':'); + } + $classes[] = ltrim($namespace . $name, '\\'); + } + } + return $classes; +} + +$options = getopt('i:f:', []); +$file = $options["f"]; +$input = $options["i"]; + +$classes = findClasses($file); +foreach($classes as $class) { + echo '$classmap[\''.$class.'\'] = \''.$input.'/'.$file.'\';'; + echo "\n"; +} diff --git a/guix/build-system/composer.scm b/guix/build-system/composer.scm new file mode 100644 index 0000000000..8bf99ff9c5 --- /dev/null +++ b/guix/build-system/composer.scm @@ -0,0 +1,162 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 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 build-system composer) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (%composer-build-system-modules + lower + composer-build + composer-build-system)) + +;; Commentary: +;; +;; Standard build procedure for PHP packages using Composer. This is implemented +;; as an extension of `gnu-build-system'. +;; +;; Code: + +(define (default-php) + "Return the default PHP package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages php)))) + (module-ref module 'php))) + +(define (default-findclass) + "Return the default findclass script." + (search-auxiliary-file "findclass.php")) + +(define (default-composer-classloader) + "Return the default composer-classloader package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages php-xyz)))) + (module-ref module 'composer-classloader))) + +(define %composer-build-system-modules + ;; Build-side modules imported by default. + `((guix build composer-build-system) + (guix build union) + (json) + (json builder) + (json parser) + (json record) + ,@%gnu-build-system-modules)) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (php (default-php)) + (composer-classloader (default-composer-classloader)) + (findclass (default-findclass)) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:target #:php #:composer-classloader #:findclass #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (build-inputs `(("php" ,php) + ("findclass.php" ,findclass) + ("composer-classloader" ,composer-classloader) + ,@native-inputs)) + (outputs outputs) + (build composer-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (composer-build name inputs + #:key + guile source + (outputs '("out")) + (configure-flags ''()) + (search-paths '()) + (out-of-source? #t) + (composer-file "composer.json") + (tests? #t) + (test-target "test") + (install-target "install") + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags #~'("--strip-debug")) + (strip-directories #~'("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build composer-build-system) + %standard-phases)) + (system (%current-system)) + (imported-modules %composer-build-system-modules) + (modules '((guix build composer-build-system) + (guix build utils)))) + "Build SOURCE using PHP, and with INPUTS. This assumes that SOURCE provides +a 'composer.json' file as its build system." + (define builder + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(composer-build + #:source #$source + #:system #$system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths '#$(map search-path-specification->sexp + search-paths) + #:phases #$phases + #:out-of-source? #$out-of-source? + #:composer-file #$composer-file + #:tests? #$tests? + #:test-target #$test-target + #:install-target #$install-target + #:validate-runpath? #$validate-runpath? + #:patch-shebangs? #$patch-shebangs? + #:strip-binaries? #$strip-binaries? + #:strip-flags #$strip-flags + #:strip-directories #$strip-directories))))) + + (gexp->derivation name builder + #:system system + #:target #f + #:graft? #f + #:guile-for-build guile)) + +(define composer-build-system + (build-system + (name 'composer) + (description "The standard Composer build system") + (lower lower))) + +;;; composer.scm ends here diff --git a/guix/build/composer-build-system.scm b/guix/build/composer-build-system.scm new file mode 100644 index 0000000000..7df2b7c400 --- /dev/null +++ b/guix/build/composer-build-system.scm @@ -0,0 +1,239 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 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 build composer-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (json) + #:use-module (srfi srfi-26) + #:export (%standard-phases + composer-build)) + +;; Commentary: +;; +;; Builder-side code of the standard composer build procedure. +;; +;; Code: + +(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 make-composer-autoload composer-autoload? + json->composer-autoload + (psr-4 composer-autoload-psr-4 "psr-4" + (match-lambda + (#f '()) + (psr-4 psr-4))) + (classmap composer-autoload-classmap "classmap" + (match-lambda + (#f '()) + (#(lst ...) lst)))) + +(define-json-mapping make-composer-package composer-package? + json->composer-package + (name composer-package-name) + (autoload composer-package-autoload "autoload" json->composer-autoload) + (autoload-dev composer-package-autoload-dev "autoload-dev" json->composer-autoload) + (require composer-package-require "require" json->require) + (dev-require composer-package-dev-require "require-dev" json->require) + (scripts composer-package-scripts "scripts" + (match-lambda + (#f '()) + ((scripts ...) scripts))) + (binaries composer-package-binaries "bin" + (match-lambda + (#f '()) + (#(lst ...) lst)))) + +(define* (read-package-data #:key (filename "composer.json")) + (call-with-input-file filename + (lambda (port) + (json->composer-package (json->scm port))))) + +(define* (check #:key composer-file inputs outputs tests? test-target #:allow-other-keys) + "Test the given package." + (when tests? + (mkdir-p "vendor") + (create-autoload (string-append (getcwd) "/vendor") composer-file + (append inputs outputs) #:dev-dependencies? #t) + (let* ((package-data (read-package-data #:filename composer-file)) + (scripts (composer-package-scripts package-data)) + (test-script (assoc-ref scripts test-target)) + (dependencies (composer-package-require package-data)) + (dependencies-dev (composer-package-dev-require package-data)) + (name (composer-package-name package-data))) + (for-each + (match-lambda + ((_ . input) + (let ((bin (find-php-bin input))) + (when bin + (copy-recursively bin "vendor/bin"))))) + inputs) + (match test-script + ((? string? command) + (unless (zero? (system command)) + (throw 'failed-command command))) + (('@ (? string? command) ...) + (for-each + (lambda (c) + (unless (zero? (system c)) + (throw 'failed-command c))) + command)) + (#f (invoke "vendor/bin/phpunit")))))) + +(define (find-php-bin input) + (let* ((web-dir (string-append input "/share/web")) + (vendors (if (file-exists? web-dir) + (find-files web-dir "^vendor$" #:directories? #t) + #f))) + (match vendors + ((vendor) + (let ((bin (string-append vendor "/bin"))) + (and (file-exists? bin) bin))) + (_ #f)))) + +(define (find-php-dep inputs dependency) + (let loop ((inputs inputs)) + (match inputs + (() (throw 'unsatisfied-dependency "Unsatisfied dependency: required " + dependency)) + (((_ . input) inputs ...) + (let ((autoload (string-append input "/share/web/" dependency + "/vendor/autoload_conf.php"))) + (if (file-exists? autoload) + autoload + (loop inputs))))))) + +(define* (create-autoload vendor composer-file inputs #:key dev-dependencies?) + "creates an autoload.php file that sets up the class locations for this package, +so it can be autoloaded by PHP when the package classes are required." + (with-output-to-file (string-append vendor "/autoload.php") + (lambda _ + (display (string-append + " $path) { + $loader->set($namespace, $path); +} +foreach ($psr4map as $namespace => $path) { + $loader->setPsr4($namespace, $path); +} +$loader->addClassMap($classmap); +$loader->register(); +")))) + ;; Now, create autoload_conf.php that contains the actual data, as a set + ;; of arrays + (let* ((package-data (read-package-data #:filename composer-file)) + (autoload (composer-package-autoload package-data)) + (autoload-dev (composer-package-autoload-dev package-data)) + (dependencies (composer-package-require package-data)) + (dependencies-dev (composer-package-dev-require package-data))) + (with-output-to-file (string-append vendor "/autoload_conf.php") + (lambda _ + (format #t "