summaryrefslogtreecommitdiff
path: root/guix/import
diff options
context:
space:
mode:
Diffstat (limited to 'guix/import')
-rw-r--r--guix/import/cpan.scm9
-rw-r--r--guix/import/cran.scm78
-rw-r--r--guix/import/crate.scm4
-rw-r--r--guix/import/elpa.scm61
-rw-r--r--guix/import/gem.scm2
-rw-r--r--guix/import/github.scm19
-rw-r--r--guix/import/json.scm24
-rw-r--r--guix/import/pypi.scm4
-rw-r--r--guix/import/snix.scm4
-rw-r--r--guix/import/stackage.scm2
-rw-r--r--guix/import/utils.scm77
11 files changed, 154 insertions, 130 deletions
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 58c051e283..08bed8767c 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -88,9 +88,10 @@
"Return the base distribution module for a given module. E.g. the 'ok'
module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
return \"Test-Simple\""
- (assoc-ref (json-fetch (string-append "https://fastapi.metacpan.org/v1/module/"
- module
- "?fields=distribution"))
+ (assoc-ref (json-fetch-alist (string-append
+ "https://fastapi.metacpan.org/v1/module/"
+ module
+ "?fields=distribution"))
"distribution"))
(define (package->upstream-name package)
@@ -113,7 +114,7 @@ return \"Test-Simple\""
"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 "https://fastapi.metacpan.org/v1/release/" name)))
+ (json-fetch-alist (string-append "https://fastapi.metacpan.org/v1/release/" name)))
(define (cpan-home name)
(string-append "http://search.cpan.org/dist/" name "/"))
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 49e5d2d358..a5203fe78d 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -25,7 +25,6 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
- #:use-module (srfi srfi-41)
#:use-module (ice-9 receive)
#:use-module (web uri)
#:use-module (guix memoization)
@@ -43,7 +42,7 @@
#:use-module (gnu packages)
#:export (cran->guix-package
bioconductor->guix-package
- recursive-import
+ cran-recursive-import
%cran-updater
%bioconductor-updater
@@ -231,13 +230,7 @@ empty list when the FIELD cannot be found."
"translations"
"utils"))
-(define (guix-name name)
- "Return a Guix package name for a given R package name."
- (string-append "r-" (string-map (match-lambda
- (#\_ #\-)
- (#\. #\-)
- (chr (char-downcase chr)))
- name)))
+(define cran-guix-name (cut guix-name "r-" <>))
(define (needs-fortran? tarball)
"Check if the TARBALL contains Fortran source files."
@@ -318,7 +311,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(listify meta "Depends"))))))
(values
`(package
- (name ,(guix-name name))
+ (name ,(cran-guix-name name))
(version ,version)
(source (origin
(method url-fetch)
@@ -327,12 +320,12 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(base32
,(bytevector->nix-base32-string (file-sha256 tarball))))))
,@(if (not (equal? (string-append "r-" name)
- (guix-name name)))
+ (cran-guix-name name)))
`((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
'())
(build-system r-build-system)
,@(maybe-inputs sysdepends)
- ,@(maybe-inputs (map guix-name propagate) 'propagated-inputs)
+ ,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
,@(maybe-inputs
`(,@(if (needs-fortran? tarball)
'("gfortran") '())
@@ -356,63 +349,10 @@ s-expression corresponding to that package, or #f on failure."
(and=> (fetch-description repo package-name)
(cut description->package repo <>)))))
-(define* (recursive-import package-name #:optional (repo 'cran))
- "Generate a stream of package expressions for PACKAGE-NAME and all its
-dependencies."
- (receive (package . dependencies)
- (cran->guix-package package-name repo)
- (if (not package)
- stream-null
-
- ;; Generate a lazy stream of package expressions for all unknown
- ;; dependencies in the graph.
- (let* ((make-state (lambda (queue done)
- (cons queue done)))
- (next (match-lambda
- (((next . rest) . done) next)))
- (imported (match-lambda
- ((queue . done) done)))
- (done? (match-lambda
- ((queue . done)
- (zero? (length queue)))))
- (unknown? (lambda* (dependency #:optional (done '()))
- (and (not (member dependency
- done))
- (null? (find-packages-by-name
- (guix-name dependency))))))
- (update (lambda (state new-queue)
- (match state
- (((head . tail) . done)
- (make-state (lset-difference
- equal?
- (lset-union equal? new-queue tail)
- done)
- (cons head done)))))))
- (stream-cons
- package
- (stream-unfold
- ;; map: produce a stream element
- (lambda (state)
- (cran->guix-package (next state) repo))
-
- ;; predicate
- (negate done?)
-
- ;; generator: update the queue
- (lambda (state)
- (receive (package . dependencies)
- (cran->guix-package (next state) repo)
- (if package
- (update state (filter (cut unknown? <>
- (cons (next state)
- (imported state)))
- (car dependencies)))
- ;; TODO: Try the other archives before giving up
- (update state (imported state)))))
-
- ;; initial state
- (make-state (filter unknown? (car dependencies))
- (list package-name))))))))
+(define* (cran-recursive-import package-name #:optional (repo 'gnu))
+ (recursive-import package-name repo
+ #:repo->guix-package cran->guix-package
+ #:guix-name cran-guix-name))
;;;
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index a7485bb4d0..3724a457a4 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -51,7 +51,7 @@
(define (crate-kind-predicate kind)
(lambda (dep) (string=? (assoc-ref dep "kind") kind)))
- (and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
+ (and-let* ((crate-json (json-fetch-alist (string-append crate-url crate-name)))
(crate (assoc-ref crate-json "crate"))
(name (assoc-ref crate "name"))
(version (assoc-ref crate "max_version"))
@@ -63,7 +63,7 @@
string->license)
'())) ;missing license info
(path (string-append "/" version "/dependencies"))
- (deps-json (json-fetch (string-append crate-url name path)))
+ (deps-json (json-fetch-alist (string-append crate-url name path)))
(deps (assoc-ref deps-json "dependencies"))
(input-crates (filter (crate-kind-predicate "normal") deps))
(native-input-crates
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 43e9eb60c9..65e0be45ab 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,7 +38,8 @@
#:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (elpa->guix-package
- %elpa-updater))
+ %elpa-updater
+ elpa-recursive-import))
(define (elpa-dependencies->names deps)
"Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of
@@ -200,13 +202,15 @@ type '<elpa-package>'."
(define source-url (elpa-package-source-url pkg))
+ (define dependencies-names
+ (filter-dependencies (elpa-dependencies->names
+ (elpa-package-inputs pkg))))
+
(define dependencies
- (let* ((deps (elpa-package-inputs pkg))
- (names (filter-dependencies (elpa-dependencies->names deps))))
- (map (lambda (n)
- (let ((new-n (elpa-name->package-name n)))
- (list new-n (list 'unquote (string->symbol new-n)))))
- names)))
+ (map (lambda (n)
+ (let ((new-n (elpa-name->package-name n)))
+ (list new-n (list 'unquote (string->symbol new-n)))))
+ dependencies-names))
(define (maybe-inputs input-type inputs)
(match inputs
@@ -218,23 +222,25 @@ type '<elpa-package>'."
(let ((tarball (with-store store
(download-to-store store source-url))))
- `(package
- (name ,(elpa-name->package-name name))
- (version ,version)
- (source (origin
- (method url-fetch)
- (uri (string-append ,@(factorize-uri source-url version)))
- (sha256
- (base32
- ,(if tarball
- (bytevector->nix-base32-string (file-sha256 tarball))
- "failed to download package")))))
- (build-system emacs-build-system)
- ,@(maybe-inputs 'propagated-inputs dependencies)
- (home-page ,(elpa-package-home-page pkg))
- (synopsis ,(elpa-package-synopsis pkg))
- (description ,(elpa-package-description pkg))
- (license ,license))))
+ (values
+ `(package
+ (name ,(elpa-name->package-name name))
+ (version ,version)
+ (source (origin
+ (method url-fetch)
+ (uri (string-append ,@(factorize-uri source-url version)))
+ (sha256
+ (base32
+ ,(if tarball
+ (bytevector->nix-base32-string (file-sha256 tarball))
+ "failed to download package")))))
+ (build-system emacs-build-system)
+ ,@(maybe-inputs 'propagated-inputs dependencies)
+ (home-page ,(elpa-package-home-page pkg))
+ (synopsis ,(elpa-package-synopsis pkg))
+ (description ,(elpa-package-description pkg))
+ (license ,license))
+ dependencies-names)))
(define* (elpa->guix-package name #:optional (repo 'gnu))
"Fetch the package NAME from REPO and produce a Guix package S-expression."
@@ -289,4 +295,11 @@ type '<elpa-package>'."
(pred package-from-gnu.org?)
(latest latest-release)))
+(define elpa-guix-name (cut guix-name "emacs-" <>))
+
+(define* (elpa-recursive-import package-name #:optional (repo 'gnu))
+ (recursive-import package-name repo
+ #:repo->guix-package elpa->guix-package
+ #:guix-name elpa-guix-name))
+
;;; elpa.scm ends here
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index 6e914d6290..646163fb7b 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -38,7 +38,7 @@
(define (rubygems-fetch name)
"Return an alist representation of the RubyGems metadata for the package NAME,
or #f on failure."
- (json-fetch
+ (json-fetch-alist
(string-append "https://rubygems.org/api/v1/gems/" name ".json")))
(define (ruby-package-name name)
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 4b7d53c704..ef226911b9 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -22,31 +22,16 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
- #:use-module (json)
#:use-module (guix utils)
#:use-module ((guix download) #:prefix download:)
#:use-module (guix import utils)
+ #:use-module (guix import json)
#:use-module (guix packages)
#:use-module (guix upstream)
#:use-module (guix http-client)
#:use-module (web uri)
#:export (%github-updater))
-(define (json-fetch* url)
- "Return a representation of the JSON resource URL (a list or hash table), or
-#f if URL returns 403 or 404."
- (guard (c ((and (http-get-error? c)
- (let ((error (http-get-error-code c)))
- (or (= 403 error)
- (= 404 error))))
- #f)) ;; "expected" if there is an authentification error (403),
- ;; or if package is unknown (404).
- ;; Note: github.com returns 403 if we omit a 'User-Agent' header.
- (let* ((port (http-fetch url))
- (result (json->scm port)))
- (close-port port)
- result)))
-
(define (find-extension url)
"Return the extension of the archive e.g. '.tar.gz' given a URL, or
false if none is recognized"
@@ -144,7 +129,7 @@ the package e.g. 'bedtools2'. Return #f if there is no releases"
"https://api.github.com/repos/"
(github-user-slash-repository url)
"/releases"))
- (json (json-fetch*
+ (json (json-fetch
(if token
(string-append api-url "?access_token=" token)
api-url))))
diff --git a/guix/import/json.scm b/guix/import/json.scm
index c76bc9313c..3f2ab1e3ea 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -22,15 +22,25 @@
#:use-module (guix http-client)
#:use-module (guix import utils)
#:use-module (srfi srfi-34)
- #:export (json-fetch))
+ #:export (json-fetch
+ json-fetch-alist))
(define (json-fetch url)
- "Return an alist representation of the JSON resource URL, or #f on failure."
+ "Return a representation of the JSON resource URL (a list or hash table), or
+#f if URL returns 403 or 404."
(guard (c ((and (http-get-error? c)
- (= 404 (http-get-error-code c)))
- #f)) ;"expected" if package is unknown
- (let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile")
- (Accept . "application/json"))))
- (result (hash-table->alist (json->scm port))))
+ (let ((error (http-get-error-code c)))
+ (or (= 403 error)
+ (= 404 error))))
+ #f))
+ ;; Note: many websites returns 403 if we omit a 'User-Agent' header.
+ (let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile")
+ (Accept . "application/json"))))
+ (result (json->scm port)))
(close-port port)
result)))
+
+(define (json-fetch-alist url)
+ "Return an alist representation of the JSON resource URL, or #f if URL
+returns 403 or 404."
+ (hash-table->alist (json-fetch url)))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index bb0db1ba85..6beab6b010 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -51,8 +51,8 @@
(define (pypi-fetch name)
"Return an alist representation of the PyPI metadata for the package NAME,
or #f on failure."
- (json-fetch (string-append "https://pypi.python.org/pypi/"
- name "/json")))
+ (json-fetch-alist (string-append "https://pypi.python.org/pypi/"
+ name "/json")))
;; For packages found on PyPI that lack a source distribution.
(define-condition-type &missing-source-error &error
diff --git a/guix/import/snix.scm b/guix/import/snix.scm
index 778768ff2d..56934e8cf9 100644
--- a/guix/import/snix.scm
+++ b/guix/import/snix.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -283,7 +283,7 @@ ATTRIBUTE is true, only that attribute is considered."
platform = (import ~a/pkgs/top-level/platforms.nix).sheevaplug;
}" nixpkgs)))
(apply open-pipe* OPEN_READ
- %nix-instantiate "--strict" "--eval-only" "--xml"
+ "nix-instantiate" "--strict" "--eval-only" "--xml"
;; Pass a dummy `crossSystem' argument so that `buildInputs' and
;; `nativeBuildInputs' are not coalesced.
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 5b25adc674..ec93fbced6 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -60,7 +60,7 @@
(let* ((url (if (string=? "" version)
(string-append %stackage-url "/lts")
(string-append %stackage-url "/lts-" version)))
- (lts-info (json-fetch url)))
+ (lts-info (json-fetch-alist url)))
(if lts-info
(reverse lts-info)
(leave-with-message "LTS release version not found: ~a" version))))))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index efc6169077..0dc8fd5857 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,8 @@
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-41)
#:export (factorize-uri
hash-table->alist
@@ -61,7 +64,11 @@
alist->package
read-lines
- chunk-lines))
+ chunk-lines
+
+ guix-name
+
+ recursive-import))
(define (factorize-uri uri version)
"Factorize URI, a package tarball URI as a string, such that any occurrences
@@ -357,3 +364,71 @@ separated by PRED."
(if (null? after)
(reverse res)
(loop (cdr after) res))))))
+
+(define (guix-name prefix name)
+ "Return a Guix package name for a given package name."
+ (string-append prefix (string-map (match-lambda
+ (#\_ #\-)
+ (#\. #\-)
+ (chr (char-downcase chr)))
+ name)))
+
+(define* (recursive-import package-name repo
+ #:key repo->guix-package guix-name
+ #:allow-other-keys)
+ "Generate a stream of package expressions for PACKAGE-NAME and all its
+dependencies."
+ (receive (package . dependencies)
+ (repo->guix-package package-name repo)
+ (if (not package)
+ stream-null
+
+ ;; Generate a lazy stream of package expressions for all unknown
+ ;; dependencies in the graph.
+ (let* ((make-state (lambda (queue done)
+ (cons queue done)))
+ (next (match-lambda
+ (((next . rest) . done) next)))
+ (imported (match-lambda
+ ((queue . done) done)))
+ (done? (match-lambda
+ ((queue . done)
+ (zero? (length queue)))))
+ (unknown? (lambda* (dependency #:optional (done '()))
+ (and (not (member dependency
+ done))
+ (null? (find-packages-by-name
+ (guix-name dependency))))))
+ (update (lambda (state new-queue)
+ (match state
+ (((head . tail) . done)
+ (make-state (lset-difference
+ equal?
+ (lset-union equal? new-queue tail)
+ done)
+ (cons head done)))))))
+ (stream-cons
+ package
+ (stream-unfold
+ ;; map: produce a stream element
+ (lambda (state)
+ (repo->guix-package (next state) repo))
+
+ ;; predicate
+ (negate done?)
+
+ ;; generator: update the queue
+ (lambda (state)
+ (receive (package . dependencies)
+ (repo->guix-package (next state) repo)
+ (if package
+ (update state (filter (cut unknown? <>
+ (cons (next state)
+ (imported state)))
+ (car dependencies)))
+ ;; TODO: Try the other archives before giving up
+ (update state (imported state)))))
+
+ ;; initial state
+ (make-state (filter unknown? (car dependencies))
+ (list package-name))))))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-23 08:48:13 +0000