summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
authorTobias Geerinckx-Rice <me@tobias.gr>2021-10-08 23:26:24 +0200
committerTobias Geerinckx-Rice <me@tobias.gr>2021-10-08 23:31:34 +0200
commita1679b74c9aa20bb51bc4add82ebb7ba78926b9c (patch)
tree40457ca25c4bf06e203b2b261b15977d2ee36891 /guix/import
parentea3d456a5a4ec1bc4cf9a60f04c2ed49881f2b67 (diff)
Revert the #51061 patch series for now.
This reverts commits f63c79bf7674df012517f8e9148f94c611e35f32 ..f86f7e24b39928247729020df0134e2e1c4cde62 for more chillax reviewing. See <https://issues.guix.gnu.org/51061#32>.
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/hexpm.scm290
-rw-r--r--guix/import/utils.scm1
2 files changed, 0 insertions, 291 deletions
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 <tipecaml@gmail.com>
-;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
-;;; Copyright © 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.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 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 <hexpm-release> below.
-(define-json-mapping <hexpm-pkgdef> 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 <hexpm-version>
- (lambda (vector)
- (map json->hexpm-version
- (vector->list vector)))))
-
-;; Hexpm meta.
-(define-json-mapping <hexpm-meta> 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 <hexpm-version> 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 <hexpm>
-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 <hexpm-release> 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 <hexpm-dependency>
-;; 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 <hexpm-dependency> 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 <hexpm-release>."
- (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
-<hexpm-release> 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 <upstream-source> 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 <origin> 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))))))