Merge branch 'master' into python-tests

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