diff options
Diffstat (limited to 'guix/import')
-rw-r--r-- | guix/import/cpan.scm | 167 | ||||
-rw-r--r-- | guix/import/gnu.scm | 7 | ||||
-rw-r--r-- | guix/import/json.scm | 32 | ||||
-rw-r--r-- | guix/import/pypi.scm | 47 | ||||
-rw-r--r-- | guix/import/utils.scm | 48 |
5 files changed, 249 insertions, 52 deletions
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm new file mode 100644 index 0000000000..5f4602a8d2 --- /dev/null +++ b/guix/import/cpan.scm @@ -0,0 +1,167 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> +;;; +;;; 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 cpan) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (json) + #:use-module (guix hash) + #:use-module (guix store) + #:use-module (guix base32) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:use-module (guix import json) + #:export (cpan->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of a CPAN +;;; module, using meta-data from metacpan.org. +;;; +;;; Code: + +(define string->license + (match-lambda + ;; List of valid values from https://metacpan.org/pod/CPAN::Meta::Spec. + ;; Some licenses are excluded based on their absense from (guix licenses). + ("agpl_3" 'agpl3) + ;; apache_1_1 + ("apache_2_0" 'asl2.0) + ;; artistic_1_0 + ;; artistic_2_0 + ("bsd" 'bsd-3) + ("freebsd" 'bsd-2) + ;; gfdl_1_2 + ("gfdl_1_3" 'fdl1.3+) + ("gpl_1" 'gpl1) + ("gpl_2" 'gpl2) + ("gpl_3" 'gpl3) + ("lgpl_2_1" 'lgpl2.1) + ("lgpl_3_0" 'lgpl3) + ("mit" 'x11) + ;; mozilla_1_0 + ("mozilla_1_1" 'mpl1.1) + ("openssl" 'openssl) + ("perl_5" 'gpl1+) ;and Artistic 1 + ("qpl_1_0" 'qpl) + ;; ssleay + ;; sun + ("zlib" 'zlib) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + +(define (module->name module) + "Transform a 'module' name into a 'release' name" + (regexp-substitute/global #f "::" module 'pre "-" 'post)) + +(define (cpan-fetch module) + "Return an alist representation of the CPAN metadata for the perl module MODULE, +or #f on failure. MODULE should be e.g. \"Test::Script\"" + ;; This API always returns the latest release of the module. + (json-fetch (string-append "http://api.metacpan.org/release/" + ;; XXX: The 'release' api requires the "release" + ;; name of the package. This substitution seems + ;; reasonably consistent across packages. + (module->name module)))) + +(define (cpan-home name) + (string-append "http://search.cpan.org/dist/" name)) + +(define (cpan-module->sexp meta) + "Return the `package' s-expression for a CPAN module from the metadata in +META." + (define name + (assoc-ref meta "distribution")) + + (define (guix-name name) + (if (string-prefix? "perl-" name) + (string-downcase name) + (string-append "perl-" (string-downcase name)))) + + (define version + (assoc-ref meta "version")) + + (define (convert-inputs phases) + ;; Convert phase dependencies into a list of name/variable pairs. + (match (flatten + (map (lambda (ph) + (filter-map (lambda (t) + (assoc-ref* meta "metadata" "prereqs" ph t)) + '("requires" "recommends" "suggests"))) + phases)) + (#f + '()) + ((inputs ...) + (delete-duplicates + ;; Listed dependencies may include core modules. Filter those out. + (filter-map (match-lambda + ((or (module . "0") ("perl" . _)) + ;; TODO: A stronger test might to run MODULE through + ;; `corelist' from our perl package. This current test + ;; seems to be only a loose convention. + #f) + ((module . _) + (let ((name (guix-name (module->name module)))) + (list name + (list 'unquote (string->symbol name)))))) + inputs))))) + + (define (maybe-inputs guix-name inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list guix-name + (list 'quasiquote inputs)))))) + + (define source-url + (assoc-ref meta "download_url")) + + (let ((tarball (with-store store + (download-to-store store source-url)))) + `(package + (name ,(guix-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(bytevector->nix-base32-string (file-sha256 tarball)))))) + (build-system perl-build-system) + ,@(maybe-inputs 'native-inputs + ;; "runtime" and "test" may also be needed here. See + ;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases, + ;; which says they are required during building. We + ;; have not yet had a need for cross-compiled perl + ;; modules, however, so we leave them out. + (convert-inputs '("configure" "build"))) + ,@(maybe-inputs 'inputs + (convert-inputs '("runtime"))) + (home-page ,(string-append "http://search.cpan.org/dist/" name)) + (synopsis ,(assoc-ref meta "abstract")) + (description fill-in-yourself!) + (license ,(string->license (assoc-ref meta "license")))))) + +(define (cpan->guix-package module-name) + "Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the +`package' s-expression corresponding to that package, or #f on failure." + (let ((module-meta (cpan-fetch module-name))) + (and=> module-meta cpan-module->sexp))) diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm index 1947f489fb..7160fcf7ba 100644 --- a/guix/import/gnu.scm +++ b/guix/import/gnu.scm @@ -18,6 +18,7 @@ (define-module (guix import gnu) #:use-module (guix gnu-maintenance) + #:use-module (guix import utils) #:use-module (guix utils) #:use-module (guix store) #:use-module (guix hash) @@ -38,10 +39,6 @@ ;;; ;;; Code: -(define (file-sha256 file) - "Return the SHA256 hash of FILE as a bytevector." - (call-with-input-file file port-sha256)) - (define (qualified-url url) "Return a fully-qualified URL based on URL." (if (string-prefix? "/" url) @@ -102,7 +99,7 @@ details.)" (let ((version (gnu-release-version release))) (match (find-packages (regexp-quote name)) ((info . _) - (gnu-package->sexp info release)) + (gnu-package->sexp info release #:key-download key-download)) (() (raise (condition (&message diff --git a/guix/import/json.scm b/guix/import/json.scm new file mode 100644 index 0000000000..c3092a5a9d --- /dev/null +++ b/guix/import/json.scm @@ -0,0 +1,32 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 David Thompson <davet@gnu.org> +;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> +;;; +;;; 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 json) + #:use-module (json) + #:use-module (guix utils) + #:use-module (guix import utils) + #:export (json-fetch)) + +(define (json-fetch url) + "Return an alist representation of the JSON resource URL, or #f on failure." + (call-with-temporary-output-file + (lambda (temp port) + (and (url-fetch url temp) + (hash-table->alist + (call-with-input-file temp json->scm)))))) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 88f4a8e896..8567cad79c 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -27,40 +27,15 @@ #:use-module (web uri) #:use-module (guix utils) #:use-module (guix import utils) + #:use-module (guix import json) #:use-module (guix base32) #:use-module (guix hash) #:use-module (guix packages) #:use-module (guix licenses) #:use-module (guix build-system python) - #:use-module ((guix build download) #:prefix build:) #:use-module (gnu packages python) #:export (pypi->guix-package)) -(define (hash-table->alist table) - "Return an alist represenation of TABLE." - (map (match-lambda - ((key . (lst ...)) - (cons key - (map (lambda (x) - (if (hash-table? x) - (hash-table->alist x) - x)) - lst))) - ((key . (? hash-table? table)) - (cons key (hash-table->alist table))) - (pair pair)) - (hash-map->list cons table))) - -(define (flatten lst) - "Return a list that recursively concatenates all sub-lists of LIST." - (fold-right - (match-lambda* - (((sub-list ...) memo) - (append (flatten sub-list) memo)) - ((elem memo) - (cons elem memo))) - '() lst)) - (define (join lst delimiter) "Return a list that contains the elements of LST, each separated by DELIMETER." @@ -71,13 +46,6 @@ DELIMETER." ((elem . rest) (cons* elem delimiter (join rest delimiter))))) -(define (assoc-ref* alist key . rest) - "Return the value for KEY from ALIST. For each additional key specified, -recursively apply the procedure to the sub-list." - (if (null? rest) - (assoc-ref alist key) - (apply assoc-ref* (assoc-ref alist key) rest))) - (define string->license (match-lambda ("GNU LGPL" lgpl2.0) @@ -88,19 +56,6 @@ recursively apply the procedure to the sub-list." ("Apache License, Version 2.0" asl2.0) (_ #f))) -(define (url-fetch url file-name) - "Save the contents of URL to FILE-NAME. Return #f on failure." - (parameterize ((current-output-port (current-error-port))) - (build:url-fetch url file-name))) - -(define (json-fetch url) - "Return an alist representation of the JSON resource URL, or #f on failure." - (call-with-temporary-output-file - (lambda (temp port) - (and (url-fetch url temp) - (hash-table->alist - (call-with-input-file temp json->scm)))))) - (define (pypi-fetch name) "Return an alist representation of the PyPI metadata for the package NAME, or #f on failure." diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 062cfc54f3..969491d28d 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -20,7 +20,16 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) - #:export (factorize-uri)) + #:use-module (guix hash) + #:use-module (guix utils) + #:use-module ((guix build download) #:prefix build:) + #:export (factorize-uri + + hash-table->alist + flatten + assoc-ref* + + url-fetch)) (define (factorize-uri uri version) "Factorize URI, a package tarball URI as a string, such that any occurrences @@ -49,3 +58,40 @@ of the string VERSION is replaced by the symbol 'version." result)))) '() indices)))))) + +(define (hash-table->alist table) + "Return an alist represenation of TABLE." + (map (match-lambda + ((key . (lst ...)) + (cons key + (map (lambda (x) + (if (hash-table? x) + (hash-table->alist x) + x)) + lst))) + ((key . (? hash-table? table)) + (cons key (hash-table->alist table))) + (pair pair)) + (hash-map->list cons table))) + +(define (flatten lst) + "Return a list that recursively concatenates all sub-lists of LST." + (fold-right + (match-lambda* + (((sub-list ...) memo) + (append (flatten sub-list) memo)) + ((elem memo) + (cons elem memo))) + '() lst)) + +(define (assoc-ref* alist key . rest) + "Return the value for KEY from ALIST. For each additional key specified, +recursively apply the procedure to the sub-list." + (if (null? rest) + (assoc-ref alist key) + (apply assoc-ref* (assoc-ref alist key) rest))) + +(define (url-fetch url file-name) + "Save the contents of URL to FILE-NAME. Return #f on failure." + (parameterize ((current-output-port (current-error-port))) + (build:url-fetch url file-name))) |