diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/composer.scm | 166 | ||||
| -rw-r--r-- | guix/build-system/mix.scm | 186 | ||||
| -rw-r--r-- | guix/build/composer-build-system.scm | 301 | ||||
| -rw-r--r-- | guix/build/mix-build-system.scm | 161 | ||||
| -rw-r--r-- | guix/import/composer.scm | 268 | ||||
| -rw-r--r-- | guix/import/cran.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/import/composer.scm | 107 |
8 files changed, 1194 insertions, 1 deletions
diff --git a/guix/build-system/composer.scm b/guix/build-system/composer.scm new file mode 100644 index 0000000000..2ad7bbb36a --- /dev/null +++ b/guix/build-system/composer.scm @@ -0,0 +1,166 @@ +;;; 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) + ,@%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") + (test-flags ''()) + (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 guile-json + (module-ref (resolve-interface '(gnu packages guile)) + 'guile-json-4)) + + (define builder + (with-extensions (list guile-json) + (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 + #:test-flags #$test-flags + #: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-system/mix.scm b/guix/build-system/mix.scm new file mode 100644 index 0000000000..1b04053d70 --- /dev/null +++ b/guix/build-system/mix.scm @@ -0,0 +1,186 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Pierre-Henry Fröhring <contact@phfrohring.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/>. + +;; Commentary: +;; +;; Standard build procedure for Elixir packages using 'mix'. This is +;; implemented as an extension of 'gnu-build-system'. +;; +;; Code: + +(define-module (guix build-system mix) + #:use-module (guix build mix-build-system) + #:use-module (guix build-system gnu) + #:use-module (guix build-system) + #:use-module (guix gexp) + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (guix search-paths) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (mix-build-system hexpm-uri)) + +;; Lazily resolve bindings to avoid circular dependencies. +(define (default-glibc-utf8-locales) + (let* ((base (resolve-interface '(gnu packages base)))) + (module-ref base 'glibc-utf8-locales))) + +(define (default-elixir-hex) + (let ((elixir (resolve-interface '(gnu packages elixir)))) + (module-ref elixir 'elixir-hex))) + +(define (default-rebar3) + (let ((erlang (resolve-interface '(gnu packages erlang)))) + (module-ref erlang 'rebar3))) + +(define (default-elixir) + (let ((elixir (resolve-interface '(gnu packages elixir)))) + (module-ref elixir 'elixir))) + +(define* (strip-prefix name #:optional (prefix "elixir-")) + "Return NAME without the prefix PREFIX." + (if (string-prefix? prefix name) + (string-drop name (string-length prefix)) + name)) + +(define (hexpm-uri name version) + "Return the URI where to fetch the sources of a Hex package NAME at VERSION. +NAME is the name of the package which should look like: elixir-pkg-name-X.Y.Z +See: https://github.com/hexpm/specifications/blob/main/endpoints.md" + ((compose + (cute string-append "https://repo.hex.pm/tarballs/" <> "-" version ".tar") + (cute string-replace-substring <> "-" "_") + strip-prefix) + name)) + +;; A number of environment variables specific to the Mix build system are +;; reflected here. They are documented at +;; https://hexdocs.pm/mix/1.15.7/Mix.html#module-environment-variables. Other +;; parameters located in mix.exs are defined at +;; https://hexdocs.pm/mix/1.15.7/Mix.Project.html#module-configuration +(define* (mix-build name + inputs + #:key + source + (tests? #t) + (mix-path #f) ;See MIX_PATH. + (mix-exs "mix.exs") ;See MIX_EXS. + (build-per-environment #t) ;See :build_per_environment. + (phases '%standard-phases) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules `((guix build mix-build-system) + ,@%gnu-build-system-modules)) + (modules '((guix build mix-build-system) + (guix build utils)))) + "Build SOURCE using Elixir, and with INPUTS." + + ;; Check the documentation of :build_per_environment here: + ;; https://hexdocs.pm/mix/1.15.7/Mix.Project.html#module-configuration And + ;; "Environments" here: + ;; https://hexdocs.pm/mix/1.15.7/Mix.html#module-environments + (define mix-environments + (if build-per-environment + `("prod" ,@(if tests? '("test") '())) + '("shared"))) + + (define builder + (with-imported-modules imported-modules + #~(begin + + (use-modules #$@(sexp->gexp modules)) + + #$(with-build-variables inputs outputs + #~(mix-build #:name #$name + #:source #+source + #:system #$system + #:tests? #$tests? + #:mix-path #$mix-path + #:mix-exs #$mix-exs + #:mix-environments '#$mix-environments + #:build-per-environment #$build-per-environment + #:phases #$(if (pair? phases) + (sexp->gexp phases) + phases) + #:outputs %outputs + #:search-paths '#$(sexp->gexp + (map + search-path-specification->sexp + search-paths)) + #:inputs + %build-inputs))))) + + (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) + system + #:graft? #f))) + (gexp->derivation name + builder + #:system system + #:graft? #f ;consistent with 'gnu-build' + #:target #f + #:guile-for-build guile))) + +(define* (lower name + #:key + (elixir (default-elixir)) + (elixir-hex (default-elixir-hex)) + (glibc-utf8-locales (default-glibc-utf8-locales)) + (inputs '()) + (native-inputs '()) + (propagated-inputs '()) + (rebar3 (default-rebar3)) + (tests? #t) + outputs + source + system + target + #:allow-other-keys #:rest arguments) + "Return a bag for NAME." + (let ((private-keywords + '(#:inputs #:native-inputs + #:outputs #:system #:target + #:elixir #:elixir-hex #:glibc-utf8-locales + #:rebar3 #:erlang)) + (build-inputs + `(,@(standard-packages) + ("glibc-utf8-locales" ,glibc-utf8-locales) + ("erlang" ,(lookup-package-input elixir "erlang")) + ("rebar3" ,rebar3) + ("elixir" ,elixir) + ("elixir-hex" ,elixir-hex) + ,@inputs + ,@native-inputs))) + (bag (name name) + (system system) + (build-inputs build-inputs) + (host-inputs (if target inputs '())) + (outputs outputs) + (build mix-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define mix-build-system + (build-system (name 'mix) + (description "The standard Mix build system") + (lower lower))) + +;;; mix.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..8896384e0a --- /dev/null +++ b/guix/build/composer-build-system.scm @@ -0,0 +1,301 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr> +;;; +;;; 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-1) + #: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)) + (_ result))) + '())) + +(define (if-specified-to-list fn) + (match-lambda + ((? unspecified?) '()) + (arg (fn arg)) + (_ '()))) + +(define-json-mapping <composer-autoload> make-composer-autoload + composer-autoload? + json->composer-autoload + (psr-4 composer-autoload-psr-4 "psr-4" + (match-lambda + ((? unspecified?) '()) + ((? (lambda (al) + (and (list? al) (pair? (car al)) (vector? (cdar al)))) al) + (append-map + (lambda (vect-el) + (list (cons (caar al) vect-el))) + (vector->list (cdar al)))) + ((? list? l) l) + (_ '()))) + (psr-0 composer-autoload-psr-0 "psr-0" (if-specified-to-list identity)) + (classmap composer-autoload-classmap "classmap" + (if-specified-to-list vector->list)) + (files composer-autoload-files "files" + (if-specified-to-list vector->list))) + +(define-json-mapping <composer-package> make-composer-package composer-package? + json->composer-package + (name composer-package-name) + (autoload composer-package-autoload "autoload" + (if-specified-to-list json->composer-autoload)) + (autoload-dev composer-package-autoload-dev "autoload-dev" + (if-specified-to-list 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" + (if-specified-to-list identity)) + (binaries composer-package-binaries "bin" + (if-specified-to-list vector->list))) + +(define* (read-package-data #:key (filename "composer.json")) + (call-with-input-file filename + (lambda (port) + (json->composer-package (json->scm port))))) + +(define* (create-test-autoload #:key composer-file inputs outputs tests? + #:allow-other-keys) + "Create the autoload.php file for tests. This is a standalone phase so that +the autoload.php file can be edited before the check phase." + (when tests? + (mkdir-p "vendor") + (create-autoload (string-append (getcwd) "/vendor") composer-file + inputs #:dev-dependencies? #t))) + +(define (find-bin script inputs) + (search-input-file inputs + (string-append + "bin/" + (string-drop script (string-length "vendor/bin/"))))) + +(define* (check #:key composer-file inputs + tests? test-target test-flags #:allow-other-keys) + "Test the given package. +Please note that none of the PHP packages at the time of the rewrite of the +build-system did use the test-script field. This means that the @code{match +test-script} part is not tested on a real example and relies on the original +implementation." + (if tests? + (let* ((package-data (read-package-data #:filename composer-file)) + (scripts (composer-package-scripts package-data)) + (test-script (assoc-ref scripts test-target))) + (match test-script + ((? string? bin) + (let ((command (find-bin bin inputs))) + (unless (zero? (apply system command test-flags)) + (throw 'failed-command command)))) + (('@ (? string? bins) ...) + (for-each + (lambda (c) + (let ((command (find-bin c inputs))) + (unless (zero? (apply system command test-flags)) + (throw 'failed-command command)))) + bins)) + (_ (if (file-exists? "phpunit.xml.dist") + (apply invoke + (with-exception-handler + (lambda (exn) + (if (search-error? exn) + (error "\ +Missing php-phpunit-phpunit native input.~%") + (raise exn))) + (lambda () + (search-input-file (or inputs '()) "bin/phpunit"))) + test-flags)) + (format #t "No test suite found.~%")))) + (format #t "Test suite not run.~%"))) + +(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 +$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 ($psr4map as $namespace => $paths) { + foreach ($paths as $path) { + $loader->addPsr4($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 + (match-lambda + ((key . value) + (let ((vals (if (list? value) + (reverse value) + (list value)))) + (apply + format + #t + (string-append + "$psr4map['~a'][] = [" + (string-join + (make-list (length vals) "'~a/../~a'") ",") + "];~%") + (cons* (string-join (string-split key #\\) "\\\\") + (append-map (lambda (v) (list vendor v)) vals))))) + (_ (format #t ""))) + (delete-duplicates + (append + (composer-autoload-psr-4 autoload) + (if (and dev-dependencies? (not (null? autoload-dev))) + (composer-autoload-psr-4 autoload-dev) + '())) + '())) + (for-each + (lambda (psr0) + (match psr0 + ((key . value) + (format #t "$psr4map['~a'][] = ['~a/../~a/~a'];~%" + (string-join (string-split key #\\) "\\\\") + vendor + value + (string-join (string-split key #\\) "/"))) + (_ (format #t "")))) + (append + (composer-autoload-psr-0 autoload) + (if (and dev-dependencies? (not (null? autoload-dev))) + (composer-autoload-psr-0 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 (and dev-dependencies? (not (null? autoload-dev))) + (composer-autoload-classmap autoload-dev) + '()))) + (for-each + (lambda (file) + (format #t "require_once '~a/../~a';~%" vendor file)) + (append + (composer-autoload-files autoload) + (if (and dev-dependencies? (not (null? autoload-dev))) + (composer-autoload-files autoload-dev) + '()))) + (for-each + (lambda (dep) + (format + #t "require_once '~a';~%" + (search-input-file + inputs + (string-append "/share/web/" dep "/vendor/autoload_conf.php")))) + dependencies) + ;; Also add native-inputs that are not necessarily given in the + ;; composer.json. This allows to simply add a package in tests by + ;; adding it in native-inputs, without the need to patch composer.json. + (for-each + (match-lambda + ((name . loc) + (match (find-files loc "autoload_conf\\.php$") + (() #t) + (((? string? conf) . ()) + (format #t "require_once '~a';~%" conf)) + (_ #t))) + (_ #t)) + (or inputs '())))))) + +(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) + (add-after 'install 'create-test-autoload create-test-autoload))) + +(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 diff --git a/guix/build/mix-build-system.scm b/guix/build/mix-build-system.scm new file mode 100644 index 0000000000..fe2e36d184 --- /dev/null +++ b/guix/build/mix-build-system.scm @@ -0,0 +1,161 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Pierre-Henry Fröhring <contact@phfrohring.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/>. + +;; Commentary: +;; +;; Code: + +(define-module (guix build mix-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 string-fun) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) + #:export (mix-build + %standard-phases)) + +;; The Elixir version is constant as soon as it is computable from the current +;; execution. It is a X.Y string where X and Y are respectively the major and +;; minor version number of the Elixir used in the build. +(define %elixir-version (make-parameter "X.Y")) + +(define* (elixir-libdir path #:optional (version (%elixir-version))) + "Return the path where all libraries under PATH for a specified Elixir +VERSION are installed." + (string-append path "/lib/elixir/" version)) + +(define* (strip-prefix name #:optional (prefix "elixir-")) + "Return NAME without the prefix PREFIX." + (if (string-prefix? prefix name) + (string-drop name (string-length prefix)) + name)) + +(define (mix-build-dir mix-build-root mix-env) + "Return the directory where build artifacts are to be installed according to +en environment MIX-ENV in the current directory. MIX-BUILD-ROOT depends on the +package arguments. See: https://hexdocs.pm/mix/1.15/Mix.html#module-environment-variables" + (string-append mix-build-root "/" mix-env "/lib")) + +(define (elixir-version inputs) + "Return an X.Y string where X and Y are respectively the major and minor version number of PACKAGE. +Example: /gnu/store/…-elixir-1.14.0 → 1.14" + ((compose + (cute string-join <> ".") + (cute take <> 2) + (cute string-split <> #\.) + strip-prefix + strip-store-file-name) + (assoc-ref inputs "elixir"))) + +(define* (unpack #:key source mix-path #:allow-other-keys) + "Unpack SOURCE in the working directory, and change directory within the +source. When SOURCE is a directory, copy it in a sub-directory of the current +working directory." + (let ((gnu-unpack (assoc-ref gnu:%standard-phases 'unpack))) + (gnu-unpack #:source source) + (when (file-exists? "contents.tar.gz") + (invoke "tar" "xvf" "contents.tar.gz")))) + +(define (list-directories dir) + "List absolute paths of directories directly under the directory DIR." + (map (cute string-append dir "/" <>) + (scandir dir (lambda (filename) + (and (not (member filename '("." ".."))) + (directory-exists? (string-append dir "/" filename))))))) + +(define* (set-mix-env #:key inputs mix-path mix-exs #:allow-other-keys) + "Set environment variables. +See: https://hexdocs.pm/mix/1.15.7/Mix.html#module-environment-variables" + (setenv "MIX_ARCHIVES" "archives") + (setenv "MIX_BUILD_ROOT" "_build") + (setenv "MIX_DEPS_PATH" "deps") + (setenv "MIX_EXS" mix-exs) + (setenv "MIX_HOME" (getcwd)) + (setenv "MIX_PATH" (or mix-path "")) + (setenv "MIX_REBAR3" (string-append (assoc-ref inputs "rebar3") "/bin/rebar3"))) + +(define* (set-elixir-version #:key inputs #:allow-other-keys) + "Store the version number of the Elixir input in a parameter." + (%elixir-version (elixir-version inputs)) + (format #t "Elixir version: ~a~%" (%elixir-version))) + +(define* (build #:key mix-environments #:allow-other-keys) + "Builds the Mix project." + (for-each (lambda (mix-env) + (setenv "MIX_ENV" mix-env) + (invoke "mix" "compile" "--no-deps-check")) + mix-environments)) + +(define* (check #:key (tests? #t) #:allow-other-keys) + "Test the Mix project." + (if tests? + (invoke "mix" "test" "--no-deps-check") + (format #t "tests? = ~a~%" tests?))) + +(define* (remove-mix-dirs . _) + "Remove all .mix/ directories. +We do not want to copy them to the installation directory." + (for-each delete-file-recursively + (find-files "." (file-name-predicate "\\.mix$") #:directories? #t))) + +(define (package-name->elixir-name name+ver) + "Convert the Guix package NAME-VER to the corresponding Elixir name-version +format. Example: elixir-a-pkg-1.2.3 -> a_pkg" + ((compose + (cute string-join <> "_") + (cute drop-right <> 1) + (cute string-split <> #\-)) + (strip-prefix name+ver))) + +(define* (install #:key + inputs + outputs + name + build-per-environment + #:allow-other-keys) + "Install build artifacts in the store." + (let* ((lib-name (package-name->elixir-name name)) + (lib-dir (string-append (elixir-libdir (assoc-ref outputs "out")) "/" lib-name)) + (root (getenv "MIX_BUILD_ROOT")) + (env (if build-per-environment "prod" "shared"))) + (mkdir-p lib-dir) + (copy-recursively (string-append (mix-build-dir root env) "/" lib-name) lib-dir + #:follow-symlinks? #t))) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'bootstrap) + (delete 'configure) + (add-after 'install-locale 'set-mix-env set-mix-env) + (add-after 'set-mix-env 'set-elixir-version set-elixir-version) + (replace 'unpack unpack) + (replace 'build build) + (replace 'check check) + (add-before 'install 'remove-mix-dirs remove-mix-dirs) + (replace 'install install))) + +(define* (mix-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Mix package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; mix-build-system.scm ends here diff --git a/guix/import/composer.scm b/guix/import/composer.scm new file mode 100644 index 0000000000..1ad608964b --- /dev/null +++ b/guix/import/composer.scm @@ -0,0 +1,268 @@ +;;; 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 (guix hash) + #:use-module (guix base32) + #:use-module (guix build git) + #:use-module (guix build utils) + #:use-module (guix build-system) + #:use-module (guix build-system composer) + #:use-module (guix import json) + #:use-module (guix import utils) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix memoization) + #:use-module (guix packages) + #:use-module (guix serialization) + #:use-module (guix upstream) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:export (composer->guix-package + %composer-updater + composer-recursive-import + + %composer-base-url)) + +(define %composer-base-url + (make-parameter "https://repo.packagist.org")) + +(define (fix-version version) + "Return a fixed version from a version string. For instance, v10.1 -> 10.1" + (cond + ((string-prefix? "version" version) + (if (char-set-contains? char-set:digit (string-ref version 7)) + (substring version 7) + (substring version 8))) + ((string-prefix? "v" version) + (substring version 1)) + (else version))) + +(define (latest-version versions) + (fold (lambda (a b) (if (version>? (fix-version a) (fix-version b)) a b)) + (car versions) versions)) + +(define (json->require dict) + (if dict + (let loop ((result '()) (require dict)) + (match require + (() result) + ((((? (cut string-contains <> "/") name) . _) + require ...) + (loop (cons name result) require)) + ((_ require ...) (loop result require)) + (_ result))) + '())) + +(define-json-mapping <composer-source> make-composer-source composer-source? + json->composer-source + (type composer-source-type) + (url composer-source-url) + (reference composer-source-reference)) + +(define-json-mapping <composer-package> make-composer-package composer-package? + json->composer-package + (description composer-package-description) + (homepage composer-package-homepage) + (source composer-package-source "source" json->composer-source) + (name composer-package-name "name" php-package-name) + (version composer-package-version "version" fix-version) + (require composer-package-require "require" json->require) + (dev-require composer-package-dev-require "require-dev" json->require) + (license composer-package-license "license" + (lambda (vector) + (let ((l (map string->license (vector->list vector)))) + (if (eq? (length l) 1) + (car l) + `(list ,@l)))))) + +(define (valid-version? v) + (let ((d (string-downcase v))) + (and (not (string-contains d "dev")) + (not (string-contains d "beta")) + (not (string-contains d "rc"))))) + +(define* (composer-fetch name #:key (version #f)) + "Return a composer-package representation of the Composer metadata for the +package NAME with optional VERSION, or #f on failure." + (let* ((url (string-append (%composer-base-url) "/p/" name ".json")) + (packages (and=> (json-fetch url) + (lambda (pkg) + (let ((pkgs (assoc-ref pkg "packages"))) + (or (assoc-ref pkgs name) pkg)))))) + (if packages + (json->composer-package + (if version + (assoc-ref packages version) + (cdr + (reduce + (lambda (new cur-max) + (match new + (((? valid-version? version) . tail) + (if (version>? (fix-version version) + (fix-version (car cur-max))) + (cons* version tail) + cur-max)) + (_ cur-max))) + (cons* "0.0.0" #f) + packages)))) + #f))) + +(define (php-package-name name) + "Given the NAME of a package on Packagist, return a Guix-compliant name for +the package." + (let ((name (string-join (string-split name #\/) "-"))) + (if (string-prefix? "php-" name) + (snake-case name) + (string-append "php-" (snake-case name))))) + +(define (make-php-sexp composer-package) + "Return the `package' s-expression for a PHP package for the given +COMPOSER-PACKAGE." + (let* ((source (composer-package-source composer-package)) + (dependencies (map php-package-name + (composer-package-require composer-package))) + (dev-dependencies (map php-package-name + (composer-package-dev-require composer-package))) + (git? (equal? (composer-source-type source) "git"))) + ((if git? call-with-temporary-directory call-with-temporary-output-file) + (lambda* (temp #:optional port) + (and (if git? + (begin + (mkdir-p temp) + (git-fetch (composer-source-url source) + (composer-source-reference source) + temp)) + (url-fetch (composer-source-url source) temp)) + `(package + (name ,(composer-package-name composer-package)) + (version ,(composer-package-version composer-package)) + (source + (origin + ,@(if git? + `((method git-fetch) + (uri (git-reference + (url ,(if (string-suffix? + ".git" + (composer-source-url source)) + (string-drop-right + (composer-source-url source) + (string-length ".git")) + (composer-source-url source))) + (commit ,(composer-source-reference source)))) + (file-name (git-file-name name version)) + (sha256 + (base32 + ,(bytevector->nix-base32-string + (file-hash* temp))))) + `((method url-fetch) + (uri ,(composer-source-url source)) + (sha256 (base32 ,(guix-hash-url temp))))))) + (build-system composer-build-system) + ,@(if (null? dependencies) + '() + `((inputs + (list ,@(map string->symbol dependencies))))) + ,@(if (null? dev-dependencies) + '() + `((native-inputs + (list ,@(map string->symbol dev-dependencies))))) + (synopsis "") + (description ,(composer-package-description composer-package)) + (home-page ,(composer-package-homepage composer-package)) + (license ,(or (composer-package-license composer-package) + 'unknown-license!)))))))) + +(define composer->guix-package + (memoize + (lambda* (package-name #:key (version #f) #:allow-other-keys) + "Fetch the metadata for PACKAGE-NAME from packagist.org, and return the +`package' s-expression corresponding to that package and its list of +dependencies, or #f and the empty list on failure." + (let ((package (composer-fetch package-name #:version version))) + (if package + (let* ((dependencies-names (composer-package-require package)) + (dev-dependencies-names (composer-package-dev-require package))) + (values (make-php-sexp package) + (append dependencies-names dev-dependencies-names))) + (values #f '())))))) + +(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." + (or (spdx-string->license str) + (match str + ("GNU LGPL" 'license:lgpl2.0) + ("GPL" 'license:gpl3) + ((or "BSD" "BSD License") '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) + (_ 'unknown-license!)))) + +(define (php-package? package) + "Return true if PACKAGE is a PHP package from Packagist." + (and + (eq? (package-build-system package) composer-build-system) + (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)) + (package (composer-fetch php-name)) + (version (composer-package-version package)) + (url (composer-source-url (composer-package-source package)))) + (upstream-source + (package (package-name package)) + (version version) + (urls (list url))))) + +(define %composer-updater + (upstream-updater + (name 'composer) + (description "Updater for Composer packages") + (pred php-package?) + (import latest-release))) + +(define* (composer-recursive-import package-name #:optional version) + (recursive-import package-name + #:version version + #:repo->guix-package composer->guix-package + #:guix-name php-package-name)) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index ca984cb49c..723a770e41 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -55,6 +55,10 @@ #:use-module (guix sets) #:export (%input-style + %bioconductor-version + download + fetch-description + cran->guix-package bioconductor->guix-package cran-recursive-import diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 1e8ffd25ec..d2a1cee56e 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -47,7 +47,7 @@ (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" "gem" "go" "cran" "crate" "texlive" "json" "opam" - "minetest" "elm" "hexpm")) + "minetest" "elm" "hexpm" "composer")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/composer.scm b/guix/scripts/import/composer.scm new file mode 100644 index 0000000000..412bae6318 --- /dev/null +++ b/guix/scripts/import/composer.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import composer) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import composer) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-import-composer)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import composer PACKAGE-NAME +Import and convert the Composer package for PACKAGE-NAME.\n")) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (display (G_ " + -r, --recursive generate package expressions for all Composer packages\ + that are not yet in Guix")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import composer"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-composer . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (if (assoc-ref opts 'recursive) + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (composer-recursive-import package-name)) + (let ((sexp (composer->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) |