From a1679b74c9aa20bb51bc4add82ebb7ba78926b9c Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Fri, 8 Oct 2021 23:26:24 +0200 Subject: Revert the #51061 patch series for now. This reverts commits f63c79bf7674df012517f8e9148f94c611e35f32 ..f86f7e24b39928247729020df0134e2e1c4cde62 for more chillax reviewing. See . --- guix/build-system/rebar3.scm | 143 ------------------ guix/build/rebar3-build-system.scm | 150 ------------------- guix/hexpm-download.scm | 76 ---------- guix/import/hexpm.scm | 290 ------------------------------------- guix/import/utils.scm | 1 - guix/scripts/import.scm | 2 +- guix/scripts/import/hexpm.scm | 114 --------------- guix/upstream.scm | 20 +-- 8 files changed, 2 insertions(+), 794 deletions(-) delete mode 100644 guix/build-system/rebar3.scm delete mode 100644 guix/build/rebar3-build-system.scm delete mode 100644 guix/hexpm-download.scm delete mode 100644 guix/import/hexpm.scm delete mode 100644 guix/scripts/import/hexpm.scm (limited to 'guix') diff --git a/guix/build-system/rebar3.scm b/guix/build-system/rebar3.scm deleted file mode 100644 index af0d0edc59..0000000000 --- a/guix/build-system/rebar3.scm +++ /dev/null @@ -1,143 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ricardo Wurmus -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix build-system rebar3) - #:use-module (guix store) - #:use-module (guix utils) - #:use-module (guix packages) - #:use-module (guix derivations) - #:use-module (guix search-paths) - #:use-module (guix build-system) - #:use-module (guix build-system gnu) - #:use-module (ice-9 match) - #:use-module (srfi srfi-26) - #:export (%rebar3-build-system-modules - rebar3-build - rebar3-build-system)) - -;; -;; Standard build procedure for Erlang packages using Rebar3. -;; - -(define %rebar3-build-system-modules - ;; Build-side modules imported by default. - `((guix build rebar3-build-system) - ,@%gnu-build-system-modules)) - -(define (default-rebar3) - "Return the default Rebar3 package." - ;; Lazily resolve the binding to avoid a circular dependency. - (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) - (module-ref erlang-mod 'rebar3))) - -(define (default-erlang) - "Return the default Erlang package." - ;; Lazily resolve the binding to avoid a circular dependency. - (let ((erlang-mod (resolve-interface '(gnu packages erlang)))) - (module-ref erlang-mod 'erlang))) - -(define* (lower name - #:key source inputs native-inputs outputs system target - (rebar (default-rebar3)) - (erlang (default-erlang)) - #:allow-other-keys - #:rest arguments) - "Return a bag for NAME." - (define private-keywords - '(#:source #:target #:rebar #:inputs #:native-inputs)) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs)) - (build-inputs `(("rebar" ,rebar) - ("erlang" ,erlang) ;; for escriptize - ,@native-inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (outputs outputs) - (build rebar3-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) - -(define* (rebar3-build store name inputs - #:key - (tests? #t) - (test-target "eunit") - (configure-flags ''()) - (make-flags ''("skip_deps=true" "-vv")) - (build-target "compile") - ;; TODO: pkg-name - (phases '(@ (guix build rebar3-build-system) - %standard-phases)) - (outputs '("out")) - (search-paths '()) - (system (%current-system)) - (guile #f) - (imported-modules %rebar3-build-system-modules) - (modules '((guix build rebar3-build-system) - (guix build utils)))) - "Build SOURCE with INPUTS." - (define builder - `(begin - (use-modules ,@modules) - (rebar3-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) - source) - (source - source)) - #:make-flags ,make-flags - #:configure-flags ,configure-flags - #:system ,system - #:tests? ,tests? - #:test-target ,test-target - #:build-target ,build-target - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) - - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system #:graft? #f)) - (#f ; the default - (let* ((distro (resolve-interface '(gnu packages commencement))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system #:graft? #f))))) - - (build-expression->derivation store name builder - #:inputs inputs - #:system system - #:modules imported-modules - #:outputs outputs - #:guile-for-build guile-for-build)) - -(define rebar3-build-system - (build-system - (name 'rebar3) - (description "The standard Rebar3 build system") - (lower lower))) diff --git a/guix/build/rebar3-build-system.scm b/guix/build/rebar3-build-system.scm deleted file mode 100644 index d503fc9944..0000000000 --- a/guix/build/rebar3-build-system.scm +++ /dev/null @@ -1,150 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2018 Ricardo Wurmus -;;; Copyright © 2019 Björn Höfling -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix build rebar3-build-system) - #:use-module ((guix build gnu-build-system) #:prefix gnu:) - #:use-module ((guix build utils) #:hide (delete)) - #:use-module (ice-9 match) - #:use-module (ice-9 ftw) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:export (%standard-phases - rebar3-build)) - -;; -;; Builder-side code of the standard build procedure for Erlang packages using -;; rebar3. -;; -;; TODO: Think about whether bindir ("ebin"), libdir ("priv") and includedir -;; "(include") need to be configurable - -(define %erlang-libdir "/lib/erlang/lib") - -(define* (erlang-depends #:key inputs #:allow-other-keys) - (define input-directories - (match inputs - (((_ . dir) ...) - dir))) - (mkdir-p "_checkouts") - - (for-each - (lambda (input-dir) - (let ((elibdir (string-append input-dir %erlang-libdir))) - (when (directory-exists? elibdir) - (for-each - (lambda (dirname) - (symlink (string-append elibdir "/" dirname) - (string-append "_checkouts/" dirname))) - (list-directories elibdir))))) - input-directories) - #t) - -(define* (unpack #:key source #: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." - ;; archives from hexpm typicalls do not contain a directory level - ;; TODO: Check if archive contains a directory level - (mkdir "source") - (chdir "source") - (if (file-is-directory? source) - (begin - ;; Preserve timestamps (set to the Epoch) on the copied tree so that - ;; things work deterministically. - (copy-recursively source "." - #:keep-mtime? #t)) - (begin - (if (string-suffix? ".zip" source) - (invoke "unzip" source) - (invoke "tar" "xvf" source)))) - #t) - -(define* (build #:key (make-flags '()) (build-target "compile") - #:allow-other-keys) - (apply invoke `("rebar3" ,build-target ,@make-flags))) - -(define* (check #:key target (make-flags '()) (tests? (not target)) - (test-target "eunit") - #:allow-other-keys) - (if tests? - (apply invoke `("rebar3" ,test-target ,@make-flags)) - (format #t "test suite not run~%")) - #t) - -(define (erlang-package? name) - "Check if NAME correspond to the name of an Erlang package." - (string-prefix? "erlang-" name)) - -(define (package-name-version->erlang-name name+ver) - "Convert the Guix package NAME-VER to the corresponding Erlang name-version -format. Essentially drop the prefix used in Guix and replace dashes by -underscores." - (let* ((name- (package-name->name+version name+ver))) - (string-join - (string-split - (if (erlang-package? name-) ; checks for "erlang-" prefix - (string-drop name- (string-length "erlang-")) - name-) - #\-) - "_"))) - -(define (list-directories directory) - "Return file names of the sub-directory of DIRECTORY." - (scandir directory - (lambda (file) - (and (not (member file '("." ".."))) - (file-is-directory? (string-append directory "/" file)))))) - -(define* (install #:key name outputs - (pkg-name (package-name-version->erlang-name name)) - #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (build-dir "_build/default/lib") - (pkg-dir (string-append out %erlang-libdir "/" pkg-name))) - (for-each - (lambda (pkg) - (for-each - (lambda (dirname) - (let ((src-dir (string-append build-dir "/" pkg "/" dirname)) - (dst-dir (string-append pkg-dir "/" dirname))) - (when (file-exists? src-dir) - (copy-recursively src-dir dst-dir #:follow-symlinks? #t)) - (false-if-exception - (delete-file (string-append dst-dir "/.gitignore"))))) - '("ebin" "include" "priv"))) - (list-directories build-dir)) - (false-if-exception - (delete-file (string-append pkg-dir "/priv/Run-eunit-loop.expect"))) - #t)) - -(define %standard-phases - (modify-phases gnu:%standard-phases - (replace 'unpack unpack) - (delete 'bootstrap) - (delete 'configure) - (add-before 'build 'erlang-depends erlang-depends) - (replace 'build build) - (replace 'check check) - (replace 'install install))) - -(define* (rebar3-build #:key inputs (phases %standard-phases) - #:allow-other-keys #:rest args) - "Build the given Erlang package, applying all of PHASES in order." - (apply gnu:gnu-build #:inputs inputs #:phases phases args)) diff --git a/guix/hexpm-download.scm b/guix/hexpm-download.scm deleted file mode 100644 index 25247cb79b..0000000000 --- a/guix/hexpm-download.scm +++ /dev/null @@ -1,76 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès -;;; Copyright © 2017 Mathieu Lirzin -;;; Copyright © 2017 Christopher Baines -;;; Copyright © 2020 Jakub Kądziołka -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix hexpm-download) - #:use-module (ice-9 match) - #:use-module (guix extracting-download) - #:use-module (guix packages) ;; for %current-system - #:use-module (srfi srfi-26) - #:export (hexpm-fetch - - %hexpm-repo-url - hexpm-url - hexpm-url? - hexpm-uri)) - -;;; -;;; An method that fetches a package from the hex.pm repository, -;;; unwrapping the actual content from the download tarball. -;;; - -;; URL and paths from -;; https://github.com/hexpm/specifications/blob/master/endpoints.md -(define %hexpm-repo-url - (make-parameter "https://repo.hex.pm")) -(define hexpm-url - (string-append (%hexpm-repo-url) "/tarballs/")) -(define hexpm-url? - (cut string-prefix? hexpm-url <>)) - -(define (hexpm-uri name version) - "Return a URI string for the package hosted at hex.pm corresponding to NAME -and VERSION." - (string-append hexpm-url name "-" version ".tar")) - -(define* (hexpm-fetch url hash-algo hash - #:optional name - #:key - (filename-to-extract "contents.tar.gz") - (system (%current-system)) - (guile (default-guile))) - "Return a fixed-output derivation that fetches URL and extracts -\"contents.tar.gz\". The output is expected to have hash HASH of type -HASH-ALGO (a symbol). By default, the file name is the base name of URL; -optionally, NAME can specify a different file name. By default, the file name -is the base name of URL with \".gz\" appended; optionally, NAME can specify a -different file name." - (define file-name - (match url - ((head _ ...) - (basename head)) - (_ - (basename url)))) - - (http-fetch/extract url "contents.tar.gz" hash-algo hash - ;; urls typically end with .tar, but contents is .tar.gz - (or name (string-append file-name ".gz")) - #:system system #:guile guile)) diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm deleted file mode 100644 index 018732d8c1..0000000000 --- a/guix/import/hexpm.scm +++ /dev/null @@ -1,290 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Cyril Roelandt -;;; Copyright © 2016 David Craven -;;; Copyright © 2017, 2019, 2020 Ludovic Courtès -;;; Copyright © 2019 Martin Becze -;;; Copyright © 2020, 2021 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix import hexpm) - #:use-module (guix base32) - #:use-module ((guix download) #:prefix download:) - #:use-module (guix hexpm-download) - #:use-module (gcrypt hash) - #:use-module (guix http-client) - #:use-module (json) - #:use-module (guix import utils) - #:use-module ((guix import json) #:select (json-fetch)) - #:use-module ((guix build utils) - #:select ((package-name->name+version - . hyphen-package-name->name+version) - dump-port)) - #:use-module ((guix licenses) #:prefix license:) - #:use-module (guix monads) - #:use-module (guix packages) - #:use-module (guix upstream) - #:use-module (guix utils) - #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 popen) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-2) - #:use-module (srfi srfi-26) - #:export (hexpm->guix-package - guix-package->hexpm-name - strings->licenses - hexpm-recursive-import - %hexpm-updater)) - - -;;; -;;; Interface to https://hex.pm/api, version 2. -;;; https://github.com/hexpm/specifications/blob/master/apiary.apib -;;; https://github.com/hexpm/specifications/blob/master/endpoints.md -;;; - -(define %hexpm-api-url - (make-parameter "https://hex.pm/api")) - -(define (package-url name) - (string-append (%hexpm-api-url) "/packages/" name)) - -;; Hexpm Package. /api/packages/${name} -;; It can have several "releases", each of which has its own set of -;; requirements, buildtool, etc. - see below. -(define-json-mapping make-hexpm-pkgdef hexpm-pkgdef? - json->hexpm - (name hexpm-name) ;string - (html-url hexpm-html-url "html_url") ;string - (docs-html-url hexpm-docs-html-url "docs_html_url") ;string | #nil - (meta hexpm-meta "meta" json->hexpm-meta) - (versions hexpm-versions "releases" ;list of - (lambda (vector) - (map json->hexpm-version - (vector->list vector))))) - -;; Hexpm meta. -(define-json-mapping make-hexpm-meta hexpm-meta? - json->hexpm-meta - (description hexpm-meta-description) ;string - (licenses hexpm-meta-licenses "licenses" ;list of strings - (lambda (vector) - (or (and vector (vector->list vector)) - #f)))) - -;; Hexpm version. -(define-json-mapping make-hexpm-version hexpm-version? - json->hexpm-version - (number hexpm-version-number "version") ;string - (url hexpm-version-url)) ;string - - -(define (lookup-hexpm name) - "Look up NAME on https://hex.pm and return the corresopnding -record or #f if it was not found." - (let ((json (json-fetch (package-url name)))) - (and json - (json->hexpm json)))) - -;; Hexpm release. /api/packages/${name}/releases/${version} -(define-json-mapping make-hexpm-release hexpm-release? - json->hexpm-release - (number hexpm-release-number "version") ;string - (url hexpm-release-url) ;string - (requirements hexpm-requirements "requirements")) ;list of -;; meta:build_tools -> alist - -;; Hexpm dependency. Each dependency (each edge in the graph) is annotated as -;; being a "normal" dependency or a development dependency. There also -;; information about the minimum required version, such as "^0.0.41". -(define-json-mapping make-hexpm-dependency - hexpm-dependency? - json->hexpm-dependency - (app hexpm-dependency-app "app") ;string - (optional hexpm-dependency-optional) ;bool - (requirement hexpm-dependency-requirement)) ;string - -(define (hexpm-release-dependencies release) - "Return the list of dependency names of RELEASE, a ." - (let ((reqs (or (hexpm-requirements release) '#()))) - (map first reqs))) ;; TODO: also return required version - - -(define (lookup-hexpm-release version*) - "Look up RELEASE on hexpm-version-url and return the corresopnding - record or #f if it was not found." - (let* ((url (hexpm-version-url version*)) - (json (json-fetch url))) - (json->hexpm-release json))) - - -;;; -;;; Converting hex.pm packages to Guix packages. -;;; - -(define* (make-hexpm-sexp #:key name version tarball-url - home-page synopsis description license - #:allow-other-keys) - "Return the `package' s-expression for a rust package with the given NAME, -VERSION, tarball-url, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." - (call-with-temporary-directory - (lambda (directory) - (let ((port (http-fetch tarball-url)) - (tar (open-pipe* OPEN_WRITE "tar" "-C" directory - "-xf" "-" "contents.tar.gz"))) - (dump-port port tar) - (close-port port) - - (let ((status (close-pipe tar))) - (unless (zero? status) - (error "tar extraction failure" status)))) - - (let ((guix-name (hexpm-name->package-name name)) - (sha256 (bytevector->nix-base32-string - (call-with-input-file - (string-append directory "/contents.tar.gz") - port-sha256)))) - - `(package - (name ,guix-name) - (version ,version) - (source (origin - (method hexpm-fetch) - (uri (hexpm-uri ,name version)) - (sha256 (base32 ,sha256)))) - (build-system ,'rebar3-build-system) - (home-page ,(match home-page - (() "") - (_ home-page))) - (synopsis ,synopsis) - (description ,(beautify-description description)) - (license ,(match license - (() #f) - ((license) license) - (_ `(list ,@license))))))))) - -(define (strings->licenses strings) - (filter-map (lambda (license) - (and (not (string-null? license)) - (not (any (lambda (elem) (string=? elem license)) - '("AND" "OR" "WITH"))) - (or (spdx-string->license license) - license))) - strings)) - -(define (hexpm-latest-version package) - (let ((versions (map hexpm-version-number (hexpm-versions package)))) - (fold (lambda (a b) - (if (version>? a b) a b)) (car versions) versions))) - -(define* (hexpm->guix-package package-name #:key repo version) - "Fetch the metadata for PACKAGE-NAME from hexpms.io, and return the -`package' s-expression corresponding to that package, or #f on failure. -When VERSION is specified, attempt to fetch that version; otherwise fetch the -latest version of PACKAGE-NAME." - - (define package - (lookup-hexpm package-name)) - - (define version-number - (and package - (or version - (hexpm-latest-version package)))) - - (define version* - (and package - (find (lambda (version) - (string=? (hexpm-version-number version) - version-number)) - (hexpm-versions package)))) - - (define release - (and package version* - (lookup-hexpm-release version*))) - - (and package version* - (let ((dependencies (hexpm-release-dependencies release)) - (pkg-meta (hexpm-meta package))) - (values - (make-hexpm-sexp - #:name package-name - #:version version-number - #:home-page (or (hexpm-docs-html-url package) - ;; TODO: Homepage? - (hexpm-html-url package)) - #:synopsis (hexpm-meta-description pkg-meta) - #:description (hexpm-meta-description pkg-meta) - #:license (or (and=> (hexpm-meta-licenses pkg-meta) - strings->licenses)) - #:tarball-url (hexpm-uri package-name version-number)) - dependencies)))) - -(define* (hexpm-recursive-import pkg-name #:optional version) - (recursive-import pkg-name - #:version version - #:repo->guix-package hexpm->guix-package - #:guix-name hexpm-name->package-name)) - -(define (guix-package->hexpm-name package) - "Return the hex.pm name of PACKAGE." - (define (url->hexpm-name url) - (hyphen-package-name->name+version - (basename (file-sans-extension url)))) - - (match (and=> (package-source package) origin-uri) - ((? string? url) - (url->hexpm-name url)) - ((lst ...) - (any url->hexpm-name lst)) - (#f #f))) - -(define (hexpm-name->package-name name) - (string-append "erlang-" (string-join (string-split name #\_) "-"))) - - -;;; -;;; Updater -;;; - -(define (hexpm-package? package) - "Return true if PACKAGE is a package from hex.pm." - (let ((source-url (and=> (package-source package) origin-uri)) - (fetch-method (and=> (package-source package) origin-method))) - (and (eq? fetch-method hexpm-fetch) - (match source-url - ((? string?) - (hexpm-url? source-url)) - ((source-url ...) - (any hexpm-url? source-url)))))) - -(define (latest-release package) - "Return an for the latest release of PACKAGE." - (let* ((hexpm-name (guix-package->hexpm-name package)) - (hexpm (lookup-hexpm hexpm-name)) - (version (hexpm-latest-version hexpm)) - (url (hexpm-uri hexpm-name version))) - (upstream-source - (package (package-name package)) - (version version) - (urls (list url))))) - -(define %hexpm-updater - (upstream-updater - (name 'hexpm) - (description "Updater for hex.pm packages") - (pred hexpm-package?) - (latest latest-release))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index aaad247c63..a180742ca3 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -359,7 +359,6 @@ the expected fields of an object." ("git-fetch" (@ (guix git-download) git-fetch)) ("svn-fetch" (@ (guix svn-download) svn-fetch)) ("hg-fetch" (@ (guix hg-download) hg-fetch)) - ("hexpm-fetch" (@ (guix hexpm-download) hexpm-fetch)) (_ #f))) (uri (assoc-ref orig "uri")) (sha256 sha)))))) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index aaadad4adf..40fa6759ae 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -79,7 +79,7 @@ rather than \\n." ;;; (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" - "gem" "go" "cran" "crate" "texlive" "json" "opam" "hexpm" + "gem" "go" "cran" "crate" "texlive" "json" "opam" "minetest")) (define (resolve-importer name) diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm deleted file mode 100644 index 95a291f1a8..0000000000 --- a/guix/scripts/import/hexpm.scm +++ /dev/null @@ -1,114 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 David Thompson -;;; Copyright © 2016 David Craven -;;; Copyright © 2019 Martin Becze -;;; Copyright © 2020 Hartmut Goebel -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix scripts import hexpm) - #:use-module (guix ui) - #:use-module (guix utils) - #:use-module (guix scripts) - #:use-module (guix import hexpm) - #:use-module (guix scripts import) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-37) - #:use-module (ice-9 match) - #:use-module (ice-9 format) - #:export (guix-import-hexpm)) - - -;;; -;;; Command-line options. -;;; - -(define %default-options - '()) - -(define (show-help) - (display (G_ "Usage: guix import hexpm PACKAGE-NAME -Import and convert the hex.pm package for PACKAGE-NAME.\n")) - (display (G_ " - -r, --recursive import packages recursively")) - (newline) - (display (G_ " - -h, --help display this help and exit")) - (display (G_ " - -V, --version display version information and exit")) - (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 hexpm"))) - (option '(#\r "recursive") #f #f - (lambda (opt name arg result) - (alist-cons 'recursive #t result))) - %standard-import-options)) - - -;;; -;;; Entry point. -;;; - -(define (guix-import-hexpm . 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 - ((spec) - (define-values (name version) - (package-name->name+version spec)) - - (if (assoc-ref opts 'recursive) - (map (match-lambda - ((and ('package ('name name) . rest) pkg) - `(define-public ,(string->symbol name) - ,pkg)) - (_ #f)) - (hexpm-recursive-import name version)) - (let ((sexp (hexpm->guix-package name #:version version))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - (if version - (string-append name "@" version) - name))) - sexp))) - (() - (leave (G_ "too few arguments~%"))) - ((many ...) - (leave (G_ "too many arguments~%")))))) diff --git a/guix/upstream.scm b/guix/upstream.scm index f1fb84eb45..632e9ebc4f 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,10 +24,6 @@ #:use-module (guix discovery) #:use-module ((guix download) #:select (download-to-store url-fetch)) - #:use-module ((guix hexpm-download) - #:select (hexpm-fetch)) - #:use-module ((guix extracting-download) - #:select (download-to-store/extract)) #:use-module (guix gnupg) #:use-module (guix packages) #:use-module (guix diagnostics) @@ -434,23 +430,9 @@ SOURCE, an ." #:key-download key-download))) (values version tarball source)))))) -(define* (package-update/hexpm-fetch store package source - #:key key-download) - "Return the version, tarball, and SOURCE, to update PACKAGE to -SOURCE, an ." - (match source - (($ _ version urls signature-urls) - (let* ((url (first urls)) - (name (or (origin-file-name (package-source package)) - (string-append (basename url) ".gz"))) - (tarball (download-to-store/extract - store url "contents.tar.gz" name))) - (values version tarball source))))) - (define %method-updates ;; Mapping of origin methods to source update procedures. - `((,url-fetch . ,package-update/url-fetch) - (,hexpm-fetch . ,package-update/hexpm-fetch))) + `((,url-fetch . ,package-update/url-fetch))) (define* (package-update store package #:optional (updaters (force %updaters)) -- cgit v1.2.3