me
/
guix
Archived
1
0
Fork 0

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.
master
Eric Bavier 2015-01-08 14:38:54 -06:00
parent c6cb82f5d5
commit 1ff2619bc1
7 changed files with 88 additions and 52 deletions

View File

@ -174,6 +174,7 @@ SCM_TESTS = \
if HAVE_GUILE_JSON if HAVE_GUILE_JSON
MODULES += \ MODULES += \
guix/import/json.scm \
guix/import/pypi.scm \ guix/import/pypi.scm \
guix/scripts/import/pypi.scm guix/scripts/import/pypi.scm

View File

@ -26,6 +26,7 @@
#:export (sha256 #:export (sha256
open-sha256-port open-sha256-port
port-sha256 port-sha256
file-sha256
open-sha256-input-port)) open-sha256-input-port))
;;; Commentary: ;;; Commentary:
@ -129,6 +130,10 @@ output port."
(close-port out) (close-port out)
(get))) (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) (define (open-sha256-input-port port)
"Return an input port that wraps PORT and a thunk to get the hash of all the "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." data read from PORT. The thunk always returns the same value."

View File

@ -18,6 +18,7 @@
(define-module (guix import gnu) (define-module (guix import gnu)
#:use-module (guix gnu-maintenance) #:use-module (guix gnu-maintenance)
#:use-module (guix import utils)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix hash) #:use-module (guix hash)
@ -38,10 +39,6 @@
;;; ;;;
;;; Code: ;;; 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) (define (qualified-url url)
"Return a fully-qualified URL based on URL." "Return a fully-qualified URL based on URL."
(if (string-prefix? "/" url) (if (string-prefix? "/" url)

View File

@ -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))))))

View File

@ -27,40 +27,15 @@
#:use-module (web uri) #:use-module (web uri)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix licenses) #:use-module (guix licenses)
#:use-module (guix build-system python) #:use-module (guix build-system python)
#:use-module ((guix build download) #:prefix build:)
#:use-module (gnu packages python) #:use-module (gnu packages python)
#:export (pypi->guix-package)) #: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) (define (join lst delimiter)
"Return a list that contains the elements of LST, each separated by "Return a list that contains the elements of LST, each separated by
DELIMETER." DELIMETER."
@ -71,13 +46,6 @@ DELIMETER."
((elem . rest) ((elem . rest)
(cons* elem delimiter (join rest delimiter))))) (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 (define string->license
(match-lambda (match-lambda
("GNU LGPL" lgpl2.0) ("GNU LGPL" lgpl2.0)
@ -88,19 +56,6 @@ recursively apply the procedure to the sub-list."
("Apache License, Version 2.0" asl2.0) ("Apache License, Version 2.0" asl2.0)
(_ #f))) (_ #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) (define (pypi-fetch name)
"Return an alist representation of the PyPI metadata for the package NAME, "Return an alist representation of the PyPI metadata for the package NAME,
or #f on failure." or #f on failure."

View File

@ -20,7 +20,16 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (srfi srfi-1) #: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) (define (factorize-uri uri version)
"Factorize URI, a package tarball URI as a string, such that any occurrences "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)))) result))))
'() '()
indices)))))) 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)))

View File

@ -60,7 +60,7 @@
(test-assert "pypi->guix-package" (test-assert "pypi->guix-package"
;; Replace network resources with sample data. ;; Replace network resources with sample data.
(mock ((guix import pypi) url-fetch (mock ((guix import utils) url-fetch
(lambda (url file-name) (lambda (url file-name)
(with-output-to-file file-name (with-output-to-file file-name
(lambda () (lambda ()