[bug#42338] [PATCH] Add composer build system (PHP)

[Adam Faiz via Guix-patches via <guix-patches@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1849 bytes --]

Hi,

I'm interested in this composer build system so that I can start packaging the NextCloud server and its dependencies.
I've rebased the patches and modified them a bit:

1. The composer importer now uses the new inputs style for importing
2. The composer build system uses gexps

However, there are a few bugs that I don't know how to fix.

The --recursive option of the importer doesn't work:

===
In guix/scripts/import.scm:
     89:11  4 (guix-import . _)
In guix/scripts/import/composer.scm:ice-9/boot-9.scm:1685:16: In procedure raise-exception:
Throw to key `match-error' with args `("match" "no matching pattern" #<unspecified>)'.

     98:17  3 (guix-import-composer . _)
In guix/import/utils.scm:
    638:27  2 (recursive-import "psr/http-client" # _ #:guix-name _ . #)
    630:33  1 (lookup-node "psr/http-client" #f)
In ice-9/eval.scm:
    423:17  0 (_ . _)

ice-9/eval.scm:423:17: In procedure eval: Wrong number of arguments
===


I think there's something wrong with (define-json-mapping <composer-autoload>:

===
error: in phase 'install': uncaught exception:
match-error "match" "no matching pattern" #<unspecified>

In guix/build/gnu-build-system.scm:
    927:23  6 (_)
In guix/build/composer-build-system.scm:
    200:23  5 (install #:inputs _ #:outputs _ #:composer-file _)
In ice-9/ports.scm:
    433:17  4 (call-with-input-file _ _ #:binary _ #:encoding _ # _)
In guix/build/composer-build-system.scm:
      56:0  3 (json->composer-package (("config" ("allow-plug…" …)) …))
     52:12  2 (json->composer-autoload (("psr-4" ("Doctrine\\…" . #))))
In ice-9/boot-9.scm:
   1685:16  1 (raise-exception _ #:continuable? _)
   1685:16  0 (raise-exception _ #:continuable? _)

ice-9/boot-9.scm:1685:16: In procedure raise-exception:
Throw to key `match-error' with args `("match" "no matching pattern" #<unspecified>)'.
===

[-- Attachment #2: 0001-guix-import-Add-composer-importer.patch --]
[-- Type: text/x-patch, Size: 21171 bytes --]

From 0d44f8f1e66c4141d0c97aa2b633091a0bb753e5 Mon Sep 17 00:00:00 2001
Message-Id: <0d44f8f1e66c4141d0c97aa2b633091a0bb753e5.1682034340.git.adam.faiz@disroot.org>
From: Julien Lepiller <julien@lepiller.eu>
Date: Thu, 20 Apr 2023 07:18:18 +0800
Subject: [PATCH 1/3] 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                    |  12 ++
 guix/import/composer.scm         | 248 +++++++++++++++++++++++++++++++
 guix/scripts/import.scm          |   2 +-
 guix/scripts/import/composer.scm | 107 +++++++++++++
 tests/composer.scm               |  92 ++++++++++++
 6 files changed, 463 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 23b939b674..f9de4a967a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -270,6 +270,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				\
@@ -327,6 +328,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/cran.scm			\
   guix/scripts/import/egg.scm   		\
@@ -492,6 +494,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 adb1975935..9c9e567120 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14009,6 +14009,18 @@ Invoking guix import
 
 @end table
 
+@item composer
+@cindex Composer
+@cindex PHP
+Import metadata 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
+
+@end table
+
 @item go
 @cindex go
 Import metadata for a Go module using
diff --git a/guix/import/composer.scm b/guix/import/composer.scm
new file mode 100644
index 0000000000..75c79209ee
--- /dev/null
+++ b/guix/import/composer.scm
@@ -0,0 +1,248 @@
+;;; 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)
+  #:export (composer->guix-package
+            %composer-updater
+            composer-recursive-import))
+
+;; 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 (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 -> 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* (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)))
+
+(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-file)
+     (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 "reference"))))
+                                 (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
+                        (,'list
+                         ,@(map (lambda (name)
+                                 `,(string->symbol name))
+                               dependencies)))))
+               ,@(if (null? dev-dependencies)
+                     '()
+                     `((native-inputs
+                        (,'list
+                         ,@(map (lambda (name)
+                                 `,(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-names))
+                (licenses     (map string->license
+                                   (vector->list
+                                    (assoc-ref package "license")))))
+           (values (make-php-sexp name version home-page description dependencies
+                                  dev-dependencies licenses (assoc-ref package "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 <upstream-source> 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?)
+   (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 f84a964a53..fa1f96df9c 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))
+
+\f
+;;;
+;;; 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))
+
+\f
+;;;
+;;; 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: a9f4b6ecd00112ae4fb04dfbe0f9cc86b042dbc5
-- 
2.39.2


[-- Attachment #3: 0002-gnu-Add-composer-classloader.patch --]
[-- Type: text/x-patch, Size: 3922 bytes --]

From d8814cc803f26c63c1c1ac55c45132324b1446a4 Mon Sep 17 00:00:00 2001
Message-Id: <d8814cc803f26c63c1c1ac55c45132324b1446a4.1682034341.git.adam.faiz@disroot.org>
In-Reply-To: <0d44f8f1e66c4141d0c97aa2b633091a0bb753e5.1682034340.git.adam.faiz@disroot.org>
References: <0d44f8f1e66c4141d0c97aa2b633091a0bb753e5.1682034340.git.adam.faiz@disroot.org>
From: Julien Lepiller <julien@lepiller.eu>
Date: Thu, 20 Apr 2023 07:22:37 +0800
Subject: [PATCH 2/3] gnu: Add composer-classloader.

* gnu/packages/php-xyz.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/local.mk             |  1 +
 gnu/packages/php-xyz.scm | 61 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 62 insertions(+)
 create mode 100644 gnu/packages/php-xyz.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 7f6ea08b93..025fd5e09b 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -495,6 +495,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/photo.scm			\
   %D%/packages/phabricator.scm 			\
   %D%/packages/php.scm				\
+  %D%/packages/php-xyz.scm			\
   %D%/packages/piet.scm			\
   %D%/packages/pikchr.scm			\
   %D%/packages/pkg-config.scm			\
diff --git a/gnu/packages/php-xyz.scm b/gnu/packages/php-xyz.scm
new file mode 100644
index 0000000000..dab660f84f
--- /dev/null
+++ b/gnu/packages/php-xyz.scm
@@ -0,0 +1,61 @@
+;;; 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 (gnu packages php-xyz)
+  #:use-module (gnu packages)
+  #:use-module (gnu packages php)
+  #:use-module (guix packages)
+  #:use-module (guix download)
+  #:use-module (guix git-download)
+  #:use-module (guix build-system composer)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix utils)
+  #:use-module ((guix licenses) #:prefix license:))
+
+(define-public composer-classloader
+  (package
+    (name "composer-classloader")
+    (version "1.9.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                     (url "https://github.com/composer/composer.git")
+                     (commit version)))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0127zmmg3yx84ljngfs86q7kjhyypybkf4d1ihfrfnzgynzxfxdf"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         (delete 'configure)
+         (delete 'build)
+         (delete 'check)
+         (replace 'install
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (install (string-append out "/share/web/composer/ClassLoader.php")))
+               (mkdir-p (dirname install))
+               (copy-file "src/Composer/Autoload/ClassLoader.php" install)))))))
+    (home-page "https://getcomposer.org")
+    (synopsis "PHP class loader extracted from the composer package")
+    (description "This package contains the class loader class used by Composer to
+build its autoloading feature.  This package is used by the composer-build-system
+to build its own store-aware autoloading feature.")
+    (license license:expat)))
-- 
2.39.2


[-- Attachment #4: 0003-guix-Add-composer-build-system.patch --]
[-- Type: text/x-patch, Size: 25235 bytes --]

From 575967e5a34b397495e8e18fee8ba322cb62321a Mon Sep 17 00:00:00 2001
Message-Id: <575967e5a34b397495e8e18fee8ba322cb62321a.1682034341.git.adam.faiz@disroot.org>
In-Reply-To: <0d44f8f1e66c4141d0c97aa2b633091a0bb753e5.1682034340.git.adam.faiz@disroot.org>
References: <0d44f8f1e66c4141d0c97aa2b633091a0bb753e5.1682034340.git.adam.faiz@disroot.org>
From: Julien Lepiller <julien@lepiller.eu>
Date: Thu, 20 Apr 2023 07:32:48 +0800
Subject: [PATCH 3/3] guix: Add composer-build-system.

* 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                          |   6 +-
 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, 545 insertions(+), 1 deletion(-)
 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 f9de4a967a..dbf2336025 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -147,6 +147,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			\
@@ -202,6 +203,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		\
@@ -438,7 +440,9 @@ AUX_FILES =						\
   gnu/packages/aux-files/python/sanity-check-next.py	\
   gnu/packages/aux-files/python/sitecustomize.py	\
   gnu/packages/aux-files/renpy/renpy.in	\
-  gnu/packages/aux-files/run-in-namespace.c
+  gnu/packages/aux-files/run-in-namespace.c	\
+  gnu/packages/aux-files/findclass.php
+
 
 # Templates, examples.
 EXAMPLES =					\
diff --git a/doc/guix.texi b/doc/guix.texi
index 9c9e567120..13f4f7401c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9173,6 +9173,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 @@
+<?php
+/**
+ * The content of this file is copied from composer's src/Composer/Autoload/ClassMapGenerator.php
+ * the findClasses method was extracted, to prevent using any dependency.
+ *
+ * Composer (and thus this file) is distributed under the expat license, and
+ * ClassMapGenerator.php also contains this notice:
+ *
+ *   This file is part of Composer.
+ *
+ *   (c) Nils Adermann <naderman@naderman.de>
+ *       Jordi Boggiano <j.boggiano@seld.be>
+ *
+ *   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 <fabien@symfony.com>
+ * 
+ * To the extent to wich it makes sense, as the author of the extract:
+ * Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
+ */
+
+/**
+ * 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) !== '<?') {
+        $contents = preg_replace('{^.+?<\?}s', '<?', $contents, 1, $replacements);
+        if ($replacements === 0) {
+            return array();
+        }
+    }
+    // strip non-php blocks in the file
+    $contents = preg_replace('{\?>(?:[^<]++|<(?!\?))*+<\?}s', '?><?', $contents);
+    // strip trailing non-php code if needed
+    $pos = strrpos($contents, '?>');
+    if (false !== $pos && false === strpos(substr($contents, $pos), '<?')) {
+        $contents = substr($contents, 0, $pos);
+    }
+    // strip comments if short open tags are in the file
+    if (preg_match('{(<\?)(?!(php|hh))}i', $contents)) {
+        $contents = preg_replace('{//.* | /\*(?:[^*]++|\*(?!/))*\*/}x', '', $contents);
+    }
+    preg_match_all('{
+        (?:
+             \b(?<![\$:>])(?P<type>class|interface'.$extraTypes.') \s++ (?P<name>[a-zA-Z_\x7f-\xff:][a-zA-Z0-9_\x7f-\xff:\-]*+)
+           | \b(?<![\$:>])(?P<ns>namespace) (?P<nsname>\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 <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 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 <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 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 <composer-autoload> 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 <composer-package> 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
+                 "<?php
+// autoload.php @generated by Guix
+$map = $psr4map = $classmap = array();
+require_once '" vendor "/autoload_conf.php'
+require_once '" (assoc-ref inputs "composer-classloader") "/share/web/composer/ClassLoader.php'
+$loader = new \\Composer\\Autoload\\ClassLoader();
+foreach ($map as $namespace => $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 "<?php~%")
+        (format #t "// autoload_conf.php @generated by Guix~%")
+        (force-output)
+        (for-each
+          (lambda (psr4)
+            (match psr4
+              ((key . value)
+               (format #t "$psr4map['~a'] = '~a/../~a';~%"
+                       (string-join (string-split key #\\) "\\\\")
+                       vendor value))))
+          (append
+            (composer-autoload-psr-4 autoload)
+            (if dev-dependencies?
+                (composer-autoload-psr-4 autoload-dev)
+                '())))
+        (for-each
+          (lambda (classmap)
+            (for-each
+              (lambda (file)
+                (invoke "php" (assoc-ref inputs "findclass.php")
+                        "-i" (string-append vendor "/..") "-f" file))
+              (find-files classmap ".(php|hh|inc)$")))
+          (append
+            (composer-autoload-classmap autoload)
+            (if dev-dependencies?
+                (composer-autoload-classmap autoload-dev)
+                '())))
+        (for-each
+          (lambda (dep)
+            (format #t "require_once '~a';~%" (find-php-dep inputs dep)))
+          (append
+            dependencies
+            (if dev-dependencies?
+                dependencies-dev
+                '())))))))
+
+(define* (install #:key inputs outputs composer-file #:allow-other-keys)
+  "Install the given package."
+  (let* ((out (assoc-ref outputs "out"))
+         (package-data (read-package-data #:filename composer-file))
+         (name (composer-package-name package-data))
+         (php-dir (string-append out "/share/web/" name))
+         (bin-dir (string-append php-dir "/vendor/bin"))
+         (bin (string-append out "/bin"))
+         (binaries (composer-package-binaries package-data)))
+      (mkdir-p php-dir)
+      (copy-recursively "." php-dir)
+      (mkdir-p (string-append php-dir "/vendor"))
+      (when binaries
+        (mkdir-p bin-dir)
+        (mkdir-p bin)
+        (for-each
+          (lambda (file)
+            (let ((installed-file (string-append bin-dir "/" (basename file)))
+                  (bin-file (string-append bin "/" (basename file)))
+                  (original-file (string-append php-dir "/" file)))
+              (symlink original-file installed-file)
+              (symlink original-file bin-file)))
+          binaries))
+      (create-autoload (string-append php-dir "/vendor")
+                       composer-file inputs)))
+
+(define %standard-phases
+  ;; Everything is as with the GNU Build System except for the `configure'
+  ;; , `build', `check' and `install' phases.
+  (modify-phases gnu:%standard-phases
+    (delete 'bootstrap)
+    (delete 'configure)
+    (delete 'build)
+    (delete 'check)
+    (replace 'install install)
+    (add-after 'install 'check check)))
+
+(define* (composer-build #:key inputs (phases %standard-phases)
+                         #:allow-other-keys #:rest args)
+  "Build the given package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
+
+;;; composer-build-system.scm ends here
-- 
2.39.2