diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | guix/hash.scm | 5 | ||||
| -rw-r--r-- | guix/import/gnu.scm | 5 | ||||
| -rw-r--r-- | guix/import/json.scm | 32 | ||||
| -rw-r--r-- | guix/import/pypi.scm | 47 | ||||
| -rw-r--r-- | guix/import/utils.scm | 48 | ||||
| -rw-r--r-- | tests/pypi.scm | 2 |
7 files changed, 88 insertions, 52 deletions
diff --git a/Makefile.am b/Makefile.am index bc0b95232e..c2bb1762ff 100644 --- a/Makefile.am +++ b/Makefile.am @@ -174,6 +174,7 @@ SCM_TESTS = \ if HAVE_GUILE_JSON MODULES += \ + guix/import/json.scm \ guix/import/pypi.scm \ guix/scripts/import/pypi.scm diff --git a/guix/hash.scm b/guix/hash.scm index fb85f47586..593c2e1aee 100644 --- a/guix/hash.scm +++ b/guix/hash.scm @@ -26,6 +26,7 @@ #:export (sha256 open-sha256-port port-sha256 + file-sha256 open-sha256-input-port)) ;;; Commentary: @@ -129,6 +130,10 @@ output port." (close-port out) (get))) +(define (file-sha256 file) + "Return the SHA256 hash (a bytevector) of FILE." + (call-with-input-file file port-sha256)) + (define (open-sha256-input-port port) "Return an input port that wraps PORT and a thunk to get the hash of all the data read from PORT. The thunk always returns the same value." diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm index b5f67bd2d4..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) 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))) diff --git a/tests/pypi.scm b/tests/pypi.scm index 124c512d54..53c34d9e93 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -60,7 +60,7 @@ (test-assert "pypi->guix-package" ;; Replace network resources with sample data. - (mock ((guix import pypi) url-fetch + (mock ((guix import utils) url-fetch (lambda (url file-name) (with-output-to-file file-name (lambda () |