diff options
Diffstat (limited to 'guix/import')
| -rw-r--r-- | guix/import/cran.scm | 4 | ||||
| -rw-r--r-- | guix/import/elpa.scm | 3 | ||||
| -rw-r--r-- | guix/import/github.scm | 25 | ||||
| -rw-r--r-- | guix/import/hackage.scm | 24 | ||||
| -rw-r--r-- | guix/import/json.scm | 3 | ||||
| -rw-r--r-- | guix/import/pypi.scm | 19 | ||||
| -rw-r--r-- | guix/import/stackage.scm | 135 |
7 files changed, 190 insertions, 23 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 463a25514e..40cdea029b 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,7 @@ #:use-module (srfi srfi-41) #:use-module (ice-9 receive) #:use-module (web uri) - #:use-module (guix combinators) + #:use-module (guix memoization) #:use-module (guix http-client) #:use-module (guix hash) #:use-module (guix store) diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 96cf5bbae6..c0b0c415cf 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,7 +35,6 @@ #:use-module (guix base32) #:use-module (guix upstream) #:use-module (guix packages) - #:use-module ((guix combinators) #:select (memoize)) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (elpa->guix-package %elpa-updater)) diff --git a/guix/import/github.scm b/guix/import/github.scm index 01452b12e3..b249b39067 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -19,21 +19,38 @@ (define-module (guix import github) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #: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" (find (lambda (x) (string-suffix? x url)) - (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar" ".tgz" ".love"))) + (list ".tar.gz" ".tar.bz2" ".tar.xz" ".zip" ".tar" + ".tgz" ".tbz" ".love"))) (define (updated-github-url old-package new-version) ;; Return a url for the OLD-PACKAGE with NEW-VERSION. If no source url in @@ -41,7 +58,7 @@ false if none is recognized" (define (updated-url url) (if (string-prefix? "https://github.com/" url) - (let ((ext (find-extension url)) + (let ((ext (or (find-extension url) "")) (name (package-name old-package)) (version (package-version old-package)) (prefix (string-append "https://github.com/" @@ -125,7 +142,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/hackage.scm b/guix/import/hackage.scm index 9af78ea888..2c9df073d3 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -21,6 +21,7 @@ (define-module (guix import hackage) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-26) #:use-module (srfi srfi-11) #:use-module (srfi srfi-1) @@ -37,7 +38,13 @@ #:use-module (guix packages) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (hackage->guix-package - %hackage-updater)) + %hackage-updater + + guix-package->hackage-name + hackage-fetch + hackage-source-url + hackage-cabal-url + hackage-package?)) (define ghc-standard-libraries ;; List of libraries distributed with ghc (7.10.2). We include GHC itself as @@ -109,12 +116,15 @@ version is returned." "Return the Cabal file for the package NAME-VERSION, or #f on failure. If the version part is omitted from the package name, then return the latest version." - (let-values (((name version) (package-name->name+version name-version))) - (let* ((url (hackage-cabal-url name version)) - (port (http-fetch url)) - (result (read-cabal (canonical-newline-port port)))) - (close-port port) - result))) + (guard (c ((and (http-get-error? c) + (= 404 (http-get-error-code c))) + #f)) ;"expected" if package is unknown + (let-values (((name version) (package-name->name+version name-version))) + (let* ((url (hackage-cabal-url name version)) + (port (http-fetch url)) + (result (read-cabal (canonical-newline-port port)))) + (close-port port) + result)))) (define string->license ;; List of valid values from diff --git a/guix/import/json.scm b/guix/import/json.scm index 5940f5e48f..c76bc9313c 100644 --- a/guix/import/json.scm +++ b/guix/import/json.scm @@ -29,7 +29,8 @@ (guard (c ((and (http-get-error? c) (= 404 (http-get-error-code c))) #f)) ;"expected" if package is unknown - (let* ((port (http-fetch url)) + (let* ((port (http-fetch url #:headers '((user-agent . "GNU Guile") + (Accept . "application/json")))) (result (hash-table->alist (json->scm port)))) (close-port port) result))) diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 7cce0fc594..1e433e3fb3 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com> -;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,9 +89,16 @@ package." (define (guix-package->pypi-name package) "Given a Python PACKAGE built from pypi.python.org, return the name of the package on PyPI." - (let ((source-url (and=> (package-source package) origin-uri))) + (define (url->pypi-name url) (hyphen-package-name->name+version - (basename (file-sans-extension source-url))))) + (basename (file-sans-extension url)))) + + (match (and=> (package-source package) origin-uri) + ((? string? url) + (url->pypi-name url)) + ((lst ...) + (any url->pypi-name lst)) + (#f #f))) (define (wheel-url->extracted-directory wheel-url) (match (string-split (basename wheel-url) #\-) @@ -227,10 +234,8 @@ name/variable pairs describing the required inputs of this package." (sort (map (lambda (input) (list input (list 'unquote (string->symbol input)))) - (append '("python-setuptools") - ;; Argparse has been part of Python since 2.7. - (remove (cut string=? "python-argparse" <>) - (guess-requirements source-url wheel-url tarball)))) + (remove (cut string=? "python-argparse" <>) + (guess-requirements source-url wheel-url tarball))) (lambda args (match args (((a _ ...) (b _ ...)) diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm new file mode 100644 index 0000000000..542b718083 --- /dev/null +++ b/guix/import/stackage.scm @@ -0,0 +1,135 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 stackage) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (guix import json) + #:use-module (guix import hackage) + #:use-module (guix memoization) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (guix ui) + #:export (stackage->guix-package + %stackage-updater)) + + +;;; +;;; Stackage info fetcher and access functions +;;; + +(define %stackage-url "http://www.stackage.org") + +(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))) + +(define (lts-info-packages lts-info) + "Retruns the alist of packages contained in LTS-INFO." + (match lts-info + ((_ ("packages" pkg ...)) pkg) + (_ '()))) + +(define stackage-lts-info-fetch + ;; "Retrieve the information about the LTS Stackage release VERSION." + (memoize + (lambda* (#:optional (version "")) + (let* ((url (if (string=? "" version) + (string-append %stackage-url "/lts") + (string-append %stackage-url "/lts-" version))) + (lts-info (json-fetch url))) + (if lts-info + (reverse lts-info) + (leave (_ "LTS release version not found: ~A~%") version)))))) + +(define (stackage-package-name pkg-info) + (assoc-ref pkg-info "name")) + +(define (stackage-package-version pkg-info) + (assoc-ref pkg-info "version")) + +(define (lts-package-version pkgs-info name) + "Return the version of the package with upstream NAME included in PKGS-INFO." + (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name)) + pkgs-info))) + (stackage-package-version pkg))) + + +;;; +;;; Importer entry point +;;; + +(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 +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 (_ "package not found: ~A~%") package-name)))) + + +;;; +;;; Updater +;;; + +(define latest-lts-release + (let ((pkgs-info (mlambda () (lts-info-packages (stackage-lts-info-fetch))))) + (lambda* (package) + "Return an <upstream-source> for the latest Stackage LTS release of +PACKAGE or #f it the package is not inlucded in the Stackage LTS release." + (let* ((hackage-name (guix-package->hackage-name package)) + (version (lts-package-version (pkgs-info) hackage-name)) + (name-version (hackage-name-version hackage-name version))) + (match (and=> name-version hackage-fetch) + (#f (format (current-error-port) + "warning: failed to parse ~a~%" + (hackage-cabal-url hackage-name)) + #f) + (_ (let ((url (hackage-source-url hackage-name version))) + (upstream-source + (package (package-name package)) + (version version) + (urls (list url)))))))))) + +(define %stackage-updater + (upstream-updater + (name 'stackage) + (description "Updater for Stackage LTS packages") + (pred hackage-package?) + (latest latest-lts-release))) + +;;; stackage.scm ends here |