diff options
| author | Marius Bakke | 2018-12-03 19:15:17 +0100 |
|---|---|---|
| committer | Marius Bakke | 2018-12-03 19:15:17 +0100 |
| commit | 99f63f011df2aab38e98d7ee4608a8c70bf74c4d (patch) | |
| tree | 3f224028f30c60f2ed7b9846365ad926192fc7e9 /guix/import | |
| parent | e9a8b603337802a77ff2d68f0d30dc0e67721e3a (diff) | |
| parent | 4f03aa23e805bd653de774e1d74ed2f50826899b (diff) | |
Merge branch 'master' into staging
Diffstat (limited to 'guix/import')
| -rw-r--r-- | guix/import/cpan.scm | 2 | ||||
| -rw-r--r-- | guix/import/cran.scm | 6 | ||||
| -rw-r--r-- | guix/import/crate.scm | 2 | ||||
| -rw-r--r-- | guix/import/elpa.scm | 2 | ||||
| -rw-r--r-- | guix/import/gnu.scm | 2 | ||||
| -rw-r--r-- | guix/import/hackage.scm | 24 | ||||
| -rw-r--r-- | guix/import/json.scm | 3 | ||||
| -rw-r--r-- | guix/import/pypi.scm | 175 | ||||
| -rw-r--r-- | guix/import/stackage.scm | 50 | ||||
| -rw-r--r-- | guix/import/texlive.scm | 2 | ||||
| -rw-r--r-- | guix/import/utils.scm | 2 |
11 files changed, 154 insertions, 116 deletions
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index d0ff64ed0..d4bea8435 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -27,7 +27,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (json) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix base32) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index a5203fe78..8f2c10258 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -29,7 +29,7 @@ #:use-module (web uri) #:use-module (guix memoization) #:use-module (guix http-client) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix store) #:use-module (guix base32) #:use-module ((guix download) #:select (download-to-store)) @@ -127,9 +127,9 @@ package definition." (define %cran-url "http://cran.r-project.org/web/packages/") (define %bioconductor-url "https://bioconductor.org/packages/") -;; The latest Bioconductor release is 3.7. Bioconductor packages should be +;; The latest Bioconductor release is 3.8. Bioconductor packages should be ;; updated together. -(define %bioconductor-version "3.7") +(define %bioconductor-version "3.8") (define %bioconductor-packages-list-url (string-append "https://bioconductor.org/packages/" diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 3724a457a..e0b400d05 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -20,7 +20,7 @@ #:use-module (guix base32) #:use-module (guix build-system cargo) #:use-module ((guix download) #:prefix download:) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix http-client) #:use-module (guix import json) #:use-module (guix import utils) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index c37afaf8e..83354d3f0 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -32,7 +32,7 @@ #:use-module (guix http-client) #:use-module (guix store) #:use-module (guix ui) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm index bbb17047f..29324d755 100644 --- a/guix/import/gnu.scm +++ b/guix/import/gnu.scm @@ -21,7 +21,7 @@ #:use-module (guix import utils) #:use-module (guix utils) #:use-module (guix store) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix base32) #:use-module (guix upstream) #:use-module (srfi srfi-1) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 3c00f680b..48db764b3 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -33,7 +33,7 @@ #:use-module ((guix import utils) #:select (factorize-uri recursive-import)) #:use-module (guix import cabal) #:use-module (guix store) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix base32) #:use-module (guix memoization) #:use-module (guix upstream) @@ -44,6 +44,7 @@ %hackage-updater guix-package->hackage-name + hackage-name->package-name hackage-fetch hackage-source-url hackage-cabal-url @@ -214,15 +215,18 @@ representation of a Cabal file as produced by 'read-cabal'." cabal)) (define hackage-native-dependencies - ((compose (cut filter-dependencies <> - (cabal-package-name cabal)) - ;; FIXME: Check include-test-dependencies? - (lambda (cabal) - (append (if include-test-dependencies? - (cabal-test-dependencies->names cabal) - '()) - (cabal-custom-setup-dependencies->names cabal)))) - cabal)) + (lset-difference + equal? + ((compose (cut filter-dependencies <> + (cabal-package-name cabal)) + ;; FIXME: Check include-test-dependencies? + (lambda (cabal) + (append (if include-test-dependencies? + (cabal-test-dependencies->names cabal) + '()) + (cabal-custom-setup-dependencies->names cabal)))) + cabal) + hackage-dependencies)) (define dependencies (map (lambda (name) diff --git a/guix/import/json.scm b/guix/import/json.scm index 4f96a513d..81ea5e7b3 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -47,4 +47,5 @@ the query." (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))) + (and=> (json-fetch url) + hash-table->alist)) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 25560bac4..3a20fc4b9 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) #:use-module (ice-9 regex) + #:use-module (ice-9 receive) #:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -36,7 +38,8 @@ #:use-module (guix utils) #:use-module ((guix build utils) #:select ((package-name->name+version - . hyphen-package-name->name+version))) + . hyphen-package-name->name+version) + find-files)) #:use-module (guix import utils) #:use-module ((guix download) #:prefix download:) #:use-module (guix import json) @@ -45,6 +48,7 @@ #:use-module ((guix licenses) #:prefix license:) #:use-module (guix build-system python) #:export (guix-package->pypi-name + pypi-recursive-import pypi->guix-package %pypi-updater)) @@ -114,9 +118,9 @@ package definition." `((propagated-inputs (,'quasiquote ,package-inputs)))))) (define (guess-requirements source-url wheel-url tarball) - "Given SOURCE-URL, WHEEL-URL and a TARBALL of the package, return a list of -the required packages specified in the requirements.txt file. TARBALL will be -extracted in the current directory, and will be deleted." + "Given SOURCE-URL, WHEEL-URL and a TARBALL of the package, return a list +of the required packages specified in the requirements.txt file. TARBALL will +be extracted in a temporary directory." (define (tarball-directory url) ;; Given the URL of the package's tarball, return the name of the directory @@ -140,8 +144,8 @@ cannot determine package dependencies")) ;; file, remove everything other than the actual name of the required ;; package, and return it. (string-take s - (or (string-index s #\space) - (string-length s)))) + (or (string-index s (lambda (chr) (member chr '(#\space #\> #\= #\<)))) + (string-length s)))) (define (comment? line) ;; Return #t if the given LINE is a comment, #f otherwise. @@ -160,7 +164,7 @@ cannot determine package dependencies")) ((or (string-null? line) (comment? line)) (loop result)) (else - (loop (cons (python->package-name (clean-requirement line)) + (loop (cons (clean-requirement line) result)))))))))) (define (read-wheel-metadata wheel-archive) @@ -180,9 +184,7 @@ cannot determine package dependencies")) (hash-ref (list-ref run_requires 0) "requires") '()))) - (map (lambda (r) - (python->package-name (clean-requirement r))) - requirements))))) + (map clean-requirement requirements))))) (lambda () (delete-file json-file) (rmdir dirname)))))) @@ -197,31 +199,37 @@ cannot determine package dependencies")) (read-wheel-metadata temp)) #f)))) - (define (guess-requirements-from-source) ;; Return the package's requirements by guessing them from the source. (let ((dirname (tarball-directory source-url))) (if (string? dirname) - (let* ((req-file (string-append dirname "/requirements.txt")) - (exit-code (system* "tar" "xf" tarball req-file))) - ;; TODO: support more formats. - (if (zero? exit-code) - (dynamic-wind - (const #t) - (lambda () - (read-requirements req-file)) - (lambda () - (delete-file req-file) - (rmdir dirname))) - (begin - (warning (G_ "'tar xf' failed with exit code ~a\n") - exit-code) - '()))) + (call-with-temporary-directory + (lambda (dir) + (let* ((pypi-name (string-take dirname (string-rindex dirname #\-))) + (req-files (list (string-append dirname "/requirements.txt") + (string-append dirname "/" pypi-name ".egg-info" + "/requires.txt"))) + (exit-codes (map (lambda (file-name) + (parameterize ((current-error-port (%make-void-port "rw+")) + (current-output-port (%make-void-port "rw+"))) + (system* "tar" "xf" tarball "-C" dir file-name))) + req-files))) + ;; Only one of these files needs to exist. + (if (any zero? exit-codes) + (match (find-files dir) + ((file . _) + (read-requirements file)) + (() + (warning (G_ "No requirements file found.\n")))) + (begin + (warning (G_ "Failed to extract requirements files\n")) + '()))))) '()))) ;; First, try to compute the requirements using the wheel, since that is the ;; most reliable option. If a wheel is not provided for this package, try - ;; getting them by reading the "requirements.txt" file from the source. Note + ;; getting them by reading either the "requirements.txt" file or the + ;; "requires.txt" from the egg-info directory from the source tarball. Note ;; that "requirements.txt" is not mandatory, so this is likely to fail. (or (guess-requirements-from-wheel) (guess-requirements-from-source))) @@ -229,16 +237,21 @@ cannot determine package dependencies")) (define (compute-inputs source-url wheel-url tarball) "Given the SOURCE-URL of an already downloaded TARBALL, return a list of -name/variable pairs describing the required inputs of this package." - (sort - (map (lambda (input) - (list input (list 'unquote (string->symbol input)))) - (remove (cut string=? "python-argparse" <>) - (guess-requirements source-url wheel-url tarball))) - (lambda args - (match args - (((a _ ...) (b _ ...)) - (string-ci<? a b)))))) +name/variable pairs describing the required inputs of this package. Also +return the unaltered list of upstream dependency names." + (let ((dependencies + (remove (cut string=? "argparse" <>) + (guess-requirements source-url wheel-url tarball)))) + (values (sort + (map (lambda (input) + (let ((guix-name (python->package-name input))) + (list guix-name (list 'unquote (string->symbol guix-name))))) + dependencies) + (lambda args + (match args + (((a _ ...) (b _ ...)) + (string-ci<? a b))))) + dependencies))) (define (make-pypi-sexp name version source-url wheel-url home-page synopsis description license) @@ -247,46 +260,58 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (call-with-temporary-output-file (lambda (temp port) (and (url-fetch source-url temp) - `(package - (name ,(python->package-name name)) - (version ,version) - (source (origin - (method url-fetch) + (receive (input-package-names upstream-dependency-names) + (compute-inputs source-url wheel-url temp) + (values + `(package + (name ,(python->package-name name)) + (version ,version) + (source (origin + (method url-fetch) - ;; Sometimes 'pypi-uri' doesn't quite work due to mixed - ;; cases in NAME, for instance, as is the case with - ;; "uwsgi". In that case, fall back to a full URL. - (uri (pypi-uri ,(string-downcase name) version)) - (sha256 - (base32 - ,(guix-hash-url temp))))) - (build-system python-build-system) - ,@(maybe-inputs (compute-inputs source-url wheel-url temp)) - (home-page ,home-page) - (synopsis ,synopsis) - (description ,description) - (license ,(license->symbol license))))))) + ;; Sometimes 'pypi-uri' doesn't quite work due to mixed + ;; cases in NAME, for instance, as is the case with + ;; "uwsgi". In that case, fall back to a full URL. + (uri (pypi-uri ,(string-downcase name) version)) + (sha256 + (base32 + ,(guix-hash-url temp))))) + (build-system python-build-system) + ,@(maybe-inputs input-package-names) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,description) + (license ,(license->symbol license))) + upstream-dependency-names)))))) -(define (pypi->guix-package package-name) - "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the +(define pypi->guix-package + (memoize + (lambda* (package-name) + "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." - (let ((package (pypi-fetch package-name))) - (and package - (guard (c ((missing-source-error? c) - (let ((package (missing-source-error-package c))) - (leave (G_ "no source release for pypi package ~a ~a~%") - (assoc-ref* package "info" "name") - (assoc-ref* package "info" "version"))))) - (let ((name (assoc-ref* package "info" "name")) - (version (assoc-ref* package "info" "version")) - (release (assoc-ref (latest-source-release package) "url")) - (wheel (assoc-ref (latest-wheel-release package) "url")) - (synopsis (assoc-ref* package "info" "summary")) - (description (assoc-ref* package "info" "summary")) - (home-page (assoc-ref* package "info" "home_page")) - (license (string->license (assoc-ref* package "info" "license")))) - (make-pypi-sexp name version release wheel home-page synopsis - description license)))))) + (let ((package (pypi-fetch package-name))) + (and package + (guard (c ((missing-source-error? c) + (let ((package (missing-source-error-package c))) + (leave (G_ "no source release for pypi package ~a ~a~%") + (assoc-ref* package "info" "name") + (assoc-ref* package "info" "version"))))) + (let ((name (assoc-ref* package "info" "name")) + (version (assoc-ref* package "info" "version")) + (release (assoc-ref (latest-source-release package) "url")) + (wheel (assoc-ref (latest-wheel-release package) "url")) + (synopsis (assoc-ref* package "info" "summary")) + (description (assoc-ref* package "info" "summary")) + (home-page (assoc-ref* package "info" "home_page")) + (license (string->license (assoc-ref* package "info" "license")))) + (make-pypi-sexp name version release wheel home-page synopsis + description license)))))))) + +(define (pypi-recursive-import package-name) + (recursive-import package-name #f + #:repo->guix-package (lambda (name repo) + (pypi->guix-package name)) + #:guix-name python->package-name)) (define (string->license str) "Convert the string STR into a license object." @@ -305,7 +330,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (define (pypi-url? url) (or (string-prefix? "https://pypi.org/" url) (string-prefix? "https://pypi.python.org/" url) - (string-prefix? "https://pypi.io/packages" url))) + (string-prefix? "https://pypi.org/packages" url))) (let ((source-url (and=> (package-source package) origin-uri)) (fetch-method (and=> (package-source package) origin-method))) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm index ec93fbced..1c1e73a72 100644 --- a/guix/import/stackage.scm +++ b/guix/import/stackage.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> +;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,10 +26,12 @@ #:use-module (srfi srfi-35) #:use-module (guix import json) #:use-module (guix import hackage) + #:use-module (guix import utils) #:use-module (guix memoization) #:use-module (guix packages) #:use-module (guix upstream) #:export (stackage->guix-package + stackage-recursive-import %stackage-updater)) @@ -40,15 +43,12 @@ (define (lts-info-ghc-version lts-info) "Retruns the version of the GHC compiler contained in LTS-INFO." - (match lts-info - ((("snapshot" ("ghc" . version) _ _) _) version) - (_ #f))) + (and=> (assoc-ref lts-info "snapshot") + (cut assoc-ref <> "ghc"))) (define (lts-info-packages lts-info) "Retruns the alist of packages contained in LTS-INFO." - (match lts-info - ((_ ("packages" pkg ...)) pkg) - (_ '()))) + (or (assoc-ref lts-info "packages") '())) (define (leave-with-message fmt . args) (raise (condition (&message (message (apply format #f fmt args)))))) @@ -85,25 +85,33 @@ (define (hackage-name-version name version) (and version (string-append name "@" version))) -(define* (stackage->guix-package package-name ; upstream name - #:key - (include-test-dependencies? #t) - (lts-version "") - (packages-info - (lts-info-packages - (stackage-lts-info-fetch lts-version)))) - "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved +(define stackage->guix-package + (memoize + (lambda* (package-name ; upstream name + #:key + (include-test-dependencies? #t) + (lts-version "") + (packages-info + (lts-info-packages + (stackage-lts-info-fetch lts-version)))) + "Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved vesion corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION release at stackage.org. Return the `package' S-expression corresponding to that package, or #f on failure. PACKAGES-INFO is the alist with the packages included in the Stackage LTS release." - (let* ((version (lts-package-version packages-info package-name)) - (name-version (hackage-name-version package-name version))) - (if name-version - (hackage->guix-package name-version - #:include-test-dependencies? - include-test-dependencies?) - (leave-with-message "~a: Stackage package not found" package-name)))) + (let* ((version (lts-package-version packages-info package-name)) + (name-version (hackage-name-version package-name version))) + (if name-version + (hackage->guix-package name-version + #:include-test-dependencies? + include-test-dependencies?) + (leave-with-message "~a: Stackage package not found" package-name)))))) + +(define (stackage-recursive-import package-name . args) + (recursive-import package-name #f + #:repo->guix-package (lambda (name repo) + (apply stackage->guix-package (cons name args))) + #:guix-name hackage-name->package-name)) ;;; diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index d4c371436..791b51448 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -26,7 +26,7 @@ #:use-module (srfi srfi-34) #:use-module (web uri) #:use-module (guix http-client) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix memoization) #:use-module (guix store) #:use-module (guix base32) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 0dc8fd585..516c0cfaa 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -23,7 +23,7 @@ (define-module (guix import utils) #:use-module (guix base32) #:use-module ((guix build download) #:prefix build:) - #:use-module (guix hash) + #:use-module (gcrypt hash) #:use-module (guix http-client) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix utils) |