From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id eAabHWnEXWEBiAAAgWs5BA (envelope-from ) for ; Wed, 06 Oct 2021 17:44:41 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id X5k8GWnEXWGIBgAAB5/wlQ (envelope-from ) for ; Wed, 06 Oct 2021 15:44:41 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id BC6AFCA8C for ; Wed, 6 Oct 2021 17:44:40 +0200 (CEST) Received: from localhost ([::1]:58760 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mY95z-0002gG-TL for larch@yhetil.org; Wed, 06 Oct 2021 11:44:39 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:47418) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mY8j9-0002fm-BN for guix-patches@gnu.org; Wed, 06 Oct 2021 11:21:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:33629) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mY8j9-0008AF-4I for guix-patches@gnu.org; Wed, 06 Oct 2021 11:21:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mY8j8-000525-W6 for guix-patches@gnu.org; Wed, 06 Oct 2021 11:21:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#42180] [PATCH v2 02/23] guix: Add importer for hex.pm. Resent-From: Hartmut Goebel Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 06 Oct 2021 15:21:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 42180 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 42180@debbugs.gnu.org X-Debbugs-Original-To: 42180@debbugs.gnu.org, guix-patches@gnu.org Received: via spool by 42180-submit@debbugs.gnu.org id=B42180.163353364119158 (code B ref 42180); Wed, 06 Oct 2021 15:21:02 +0000 Received: (at 42180) by debbugs.gnu.org; 6 Oct 2021 15:20:41 +0000 Received: from localhost ([127.0.0.1]:45144 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mY8ig-0004yd-LX for submit@debbugs.gnu.org; Wed, 06 Oct 2021 11:20:40 -0400 Received: from mail-out.m-online.net ([212.18.0.10]:38563) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mY8id-0004yS-Ap for 42180@debbugs.gnu.org; Wed, 06 Oct 2021 11:20:32 -0400 Received: from frontend02.mail.m-online.net (unknown [192.168.8.183]) by mail-out.m-online.net (Postfix) with ESMTP id 4HPdSG5LpBz1sCwl; Wed, 6 Oct 2021 17:20:30 +0200 (CEST) Received: from localhost (dynscan2.mnet-online.de [192.168.6.68]) by mail.m-online.net (Postfix) with ESMTP id 4HPdSG35rLz1qqkD; Wed, 6 Oct 2021 17:20:30 +0200 (CEST) X-Virus-Scanned: amavisd-new at mnet-online.de Received: from mail.mnet-online.de ([192.168.8.182]) by localhost (dynscan2.mail.m-online.net [192.168.6.68]) (amavisd-new, port 10024) with ESMTP id 5-lFBYTCYAis; Wed, 6 Oct 2021 17:20:27 +0200 (CEST) Received: from hermia.goebel-consult.de (ppp-188-174-52-121.dynamic.mnet-online.de [188.174.52.121]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by mail.mnet-online.de (Postfix) with ESMTPS; Wed, 6 Oct 2021 17:20:27 +0200 (CEST) Received: from thisbe.goebel-consult.de (hermia.goebel-consult.de [192.168.110.7]) by hermia.goebel-consult.de (Postfix) with ESMTP id 76467601C7; Wed, 6 Oct 2021 17:20:33 +0200 (CEST) From: Hartmut Goebel Date: Wed, 6 Oct 2021 17:20:00 +0200 Message-Id: <38e8edec6dab357b89821822d646708b802a665b.1633533541.git.h.goebel@crazy-compilers.com> X-Mailer: git-send-email 2.30.2 In-Reply-To: <626e4718c45c95a7278460f132bd38e08835e9f4.1633533541.git.h.goebel@crazy-compilers.com> References: <626e4718c45c95a7278460f132bd38e08835e9f4.1633533541.git.h.goebel@crazy-compilers.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1633535081; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=BV4V0u1jIkhX0y8kksjRGoZbwni4kW01l3AwR8E084c=; b=IOpV1XGq99uJmnz3ebuRLHB32uMltncyQ5mYOmzzwE7mTjYLdD3B0h9yD9o+6aMVMdQG46 c5ko/x80JeAm98x6k4vpCczlOK6Wz3XwOs3YhVY/CiBL89qP3qu4a8spgop6QQc1nWLP52 +x6oRoxd2zjlA8joKcqhYHvfQbGEt7nsPTJRXcpC5wCcWEM0VrZJYUPfD0wHclGZCwbg1h N1njueMD2VFtk1jVySk0CX9dg6V3ou3nQzgGUNsY5q9gBFQsD6vWaifGyeMLLmqkGxjc/E YyDSe69rN/Yeg5axwobFzrPfUyxCr/ljAYSfR7djqaCCsWsywXcvvW01ybP6kg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1633535081; a=rsa-sha256; cv=none; b=ucBjugVbhwCUjx2yj/CMFyRiYD3c8iwqF+J5RgfV6UZmi9LvDgEcXTIE+j1mU8YCx3am1s mHPzhESdc2D8oOamooeddgtgo5TQX20fxP0wBfI1jVmiBW9zq/Ek1TjxjVDqZrUPaEmE6I A2oieSERZ9TfmKMVvWWiTrRJ/g8uHa+VMo8sZNXEtLKwjdaZ2PuwrRIUBSONgRroGJ+uW/ gQ1PmtyVh0Ls8BQtaRS530z3PRjesni7mJkW07fgObESnSbQ+urY7ip2RrZk356Mmrgl/D bAfbiLv/79Mzri1+/aEGYa1Mt0jh007DAeC37vmCAkgsBqog9QK+AicApEvRTQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: -1.92 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: BC6AFCA8C X-Spam-Score: -1.92 X-Migadu-Scanner: scn1.migadu.com X-TUID: tAG6suBxB5jU * guix/scripts/import.scm (importers): Add "hexpm". * guix/scripts/import/hexpm.scm, guix/import/hexpm.scm, guix/hexpm-download.scm: New files. * guix/import/utils.scm (source-spec->object): Add "hexpm-fetch" to list of fetch methods. * guix/upstream.scm (package-update/hexpm-fetch): New function. (%method-updates) Add it. * Makefile.am: Add them. --- Makefile.am | 3 + guix/hexpm-download.scm | 74 +++++++++ guix/import/hexpm.scm | 294 ++++++++++++++++++++++++++++++++++ guix/import/utils.scm | 1 + guix/scripts/import.scm | 2 +- guix/scripts/import/hexpm.scm | 114 +++++++++++++ guix/upstream.scm | 20 ++- 7 files changed, 506 insertions(+), 2 deletions(-) create mode 100644 guix/hexpm-download.scm create mode 100644 guix/import/hexpm.scm create mode 100644 guix/scripts/import/hexpm.scm diff --git a/Makefile.am b/Makefile.am index f2b6c8e8da..ce79d4bc04 100644 --- a/Makefile.am +++ b/Makefile.am @@ -99,6 +99,7 @@ MODULES = \ guix/extracting-download.scm \ guix/git-download.scm \ guix/hg-download.scm \ + guix/hexpm-download.scm \ guix/swh.scm \ guix/monads.scm \ guix/monad-repl.scm \ @@ -262,6 +263,7 @@ MODULES = \ guix/import/gnu.scm \ guix/import/go.scm \ guix/import/hackage.scm \ + guix/import/hexpm.scm \ guix/import/json.scm \ guix/import/kde.scm \ guix/import/launchpad.scm \ @@ -309,6 +311,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/go.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/hexpm.scm \ guix/scripts/import/json.scm \ guix/scripts/import/minetest.scm \ guix/scripts/import/opam.scm \ diff --git a/guix/hexpm-download.scm b/guix/hexpm-download.scm new file mode 100644 index 0000000000..dd1d039d73 --- /dev/null +++ b/guix/hexpm-download.scm @@ -0,0 +1,74 @@ +;;; 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. +;;; + +(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 new file mode 100644 index 0000000000..b47806fb81 --- /dev/null +++ b/guix/import/hexpm.scm @@ -0,0 +1,294 @@ +;;; 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 (json) + #: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 #:optional 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 #f + #:repo->guix-package + (lambda (name repo) + (let ((version (and (string=? name pkg-name) + version))) + (hexpm->guix-package name version))) + #: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 a180742ca3..aaad247c63 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -359,6 +359,7 @@ 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 40fa6759ae..aaadad4adf 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" + "gem" "go" "cran" "crate" "texlive" "json" "opam" "hexpm" "minetest")) (define (resolve-importer name) diff --git a/guix/scripts/import/hexpm.scm b/guix/scripts/import/hexpm.scm new file mode 100644 index 0000000000..be5625ca46 --- /dev/null +++ b/guix/scripts/import/hexpm.scm @@ -0,0 +1,114 @@ +;;; 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))) + (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 632e9ebc4f..f1fb84eb45 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,6 +24,10 @@ #: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) @@ -430,9 +434,23 @@ 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))) + `((,url-fetch . ,package-update/url-fetch) + (,hexpm-fetch . ,package-update/hexpm-fetch))) (define* (package-update store package #:optional (updaters (force %updaters)) -- 2.30.2