lint: Add 'check-haskell-stackage' checker.

* guix/lint.scm (check-haskell-stackage): New procedure.
(%network-dependent-checkers): Add 'haskell-stackage' checker.
* guix/import/hackage.scm (%hackage-url): New variable.
(hackage-source-url, hackage-cabal-url): Use it in place of a
hard-coded string.
* guix/import/stackage.scm (%stackage-url): Make it a parameter.
(stackage-lts-info-fetch): Update accordingly.
* tests/lint.scm ("hackage-stackage"): New test.

4 files changed, 73 insertions, 9 deletions

diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 35c67cad8d..6ca4f65cb0 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -40,7 +40,8 @@
   #:use-module (guix upstream)
   #:use-module (guix packages)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
-  #:export (hackage->guix-package
+  #:export (%hackage-url
+            hackage->guix-package
             hackage-recursive-import
             %hackage-updater
 
@@ -92,20 +93,23 @@
 
 (define package-name-prefix "ghc-")
 
+(define %hackage-url
+  (make-parameter "https://hackage.haskell.org"))
+
 (define (hackage-source-url name version)
   "Given a Hackage package NAME and VERSION, return a url to the source
 tarball."
-  (string-append "https://hackage.haskell.org/package/" name
-                 "/" name "-" version ".tar.gz"))
+  (string-append (%hackage-url) "/package/"
+                 name "/" name "-" version ".tar.gz"))
 
 (define* (hackage-cabal-url name #:optional version)
   "Given a Hackage package NAME and VERSION, return a url to the corresponding
 .cabal file on Hackage.  If VERSION is #f or missing, the url for the latest
 version is returned."
   (if version
-      (string-append "https://hackage.haskell.org/package/"
+      (string-append (%hackage-url) "/package/"
                      name "-" version "/" name ".cabal")
-      (string-append "https://hackage.haskell.org/package/"
+      (string-append (%hackage-url) "/package/"
                      name "/" name ".cabal")))
 
 (define (hackage-name->package-name name)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 93cf214127..77cc6350cb 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -30,7 +30,8 @@
   #:use-module (guix memoization)
   #:use-module (guix packages)
   #:use-module (guix upstream)
-  #:export (stackage->guix-package
+  #:export (%stackage-url
+            stackage->guix-package
             stackage-recursive-import
             %stackage-updater))
 
@@ -39,7 +40,8 @@
 ;;; Stackage info fetcher and access functions
 ;;;
 
-(define %stackage-url "https://www.stackage.org")
+(define %stackage-url
+  (make-parameter "https://www.stackage.org"))
 
 ;; Latest LTS version compatible with GHC 8.6.5.
 (define %default-lts-version "14.27")
@@ -55,7 +57,7 @@
   ;; "Retrieve the information about the LTS Stackage release VERSION."
   (memoize
    (lambda* (#:optional (version ""))
-     (let* ((url (string-append %stackage-url
+     (let* ((url (string-append (%stackage-url)
                                 "/lts-" (if (string-null? version)
                                             %default-lts-version
                                             version)))
diff --git a/guix/lint.scm b/guix/lint.scm
index 0b38ca0d33..be6bb4eb01 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -52,6 +53,7 @@
   #:use-module ((guix swh) #:hide (origin?))
   #:autoload   (guix git-download) (git-reference?
                                     git-reference-url git-reference-commit)
+  #:use-module (guix import stackage)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
@@ -90,6 +92,7 @@
             check-formatting
             check-archival
             check-profile-collisions
+            check-haskell-stackage
 
             lint-warning
             lint-warning?
@@ -1285,6 +1288,25 @@ Heritage")
               '()
               (apply throw key args))))))))
 
+(define (check-haskell-stackage package)
+  "Check whether PACKAGE is a Haskell package ahead of the current
+Stackage LTS version."
+  (match (with-networking-fail-safe
+          (format #f (G_ "while retrieving upstream info for '~a'")
+                  (package-name package))
+          #f
+          (package-latest-release package (list %stackage-updater)))
+    ((? upstream-source? source)
+     (if (version>? (package-version package)
+                    (upstream-source-version source))
+         (list
+          (make-warning package
+                        (G_ "ahead of Stackage LTS version ~a")
+                        (list (upstream-source-version source))
+                        #:field 'version))
+         '()))
+    (#f '())))
+
 
 ;;;
 ;;; Source code formatting.
@@ -1511,7 +1533,11 @@ or a list thereof")
    (lint-checker
      (name        'archival)
      (description "Ensure source code archival on Software Heritage")
-     (check       check-archival))))
+     (check       check-archival))
+   (lint-checker
+     (name        'haskell-stackage)
+     (description "Ensure Haskell packages use Stackage LTS versions")
+     (check       check-haskell-stackage))))
 
 (define %all-checkers
   (append %local-checkers
diff --git a/tests/lint.scm b/tests/lint.scm
index bd052842f3..9b230814a5 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,8 @@
   #:use-module (guix swh)
   #:use-module ((guix gexp) #:select (local-file))
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module ((guix import hackage) #:select (%hackage-url))
+  #:use-module ((guix import stackage) #:select (%stackage-url))
   #:use-module (gnu packages)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
@@ -1057,6 +1060,35 @@
     (string-contains (single-lint-warning-message warnings)
                      "rate limit reached")))
 
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-assert "haskell-stackage"
+  (let* ((stackage (string-append "{ \"packages\": [{"
+                                  "    \"name\":\"x\","
+                                  "    \"version\":\"1.0\" }]}"))
+         (packages (map (lambda (version)
+                          (dummy-package
+                           (string-append "ghc-x")
+                           (version version)
+                           (source
+                            (dummy-origin
+                             (method url-fetch)
+                             (uri (string-append
+                                   "https://hackage.haskell.org/package/"
+                                   "x-" version "/x-" version ".tar.gz"))))))
+                        '("0.9" "1.0" "2.0")))
+         (warnings (pk (with-http-server `((200 ,stackage) ; memoized
+                                           (200 "name: x\nversion: 1.0\n")
+                                           (200 "name: x\nversion: 1.0\n")
+                                           (200 "name: x\nversion: 1.0\n"))
+                         (parameterize ((%hackage-url (%local-url))
+                                        (%stackage-url (%local-url)))
+                           (append-map check-haskell-stackage packages))))))
+    (match warnings
+      (((? lint-warning? warning))
+       (and (string=? (package-version (lint-warning-package warning)) "2.0")
+            (string-contains (lint-warning-message warning)
+                             "ahead of Stackage LTS version"))))))
+
 (test-end "lint")
 
 ;; Local Variables: