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.
2020-11-03 15:30:28 -05:00 · 2020-11-03 15:30:28 -05:00 · 464b1fffb0
parent eeee65076e
commit 464b1fffb0
4 changed files with 73 additions and 9 deletions
--- 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)
--- 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)))
--- 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
--- 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: