From 1ff2619bc114aface6b7b9d818f7208f9af677df Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 8 Jan 2015 14:38:54 -0600 Subject: import: Factorize utility functions. * guix/import/pypi.scm (hash-table->alist, flatten, assoc-ref*, url-fetch, json-fetch): Pull procedures from here into... * guix/import/utils.scm: Here and... * guix/import/json.scm: Here. New file. * Makefile.am (MODULE)[HAVE_GUILE_JSON]: Add it. * guix/import/gnu.scm (file-sha256): Move from here to... * guix/hash.scm: Here. * tests/pypi.scm (pypi->guix-package): Update mock module reference. --- guix/import/gnu.scm | 5 +---- guix/import/json.scm | 32 ++++++++++++++++++++++++++++++++ guix/import/pypi.scm | 47 +---------------------------------------------- guix/import/utils.scm | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 81 insertions(+), 51 deletions(-) create mode 100644 guix/import/json.scm (limited to 'guix/import') 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 @@ (define-module (guix import gnu) ;;; ;;; 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 +;;; Copyright © 2015 Eric Bavier +;;; +;;; 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 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 @@ (define-module (guix import pypi) #: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 @@ (define (join lst delimiter) ((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 @@ (define string->license ("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 @@ (define-module (guix import utils) #: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 @@ (define (factorize-uri uri 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))) -- cgit v1.2.3