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.
This commit is contained in:
Timothy Sample 2020-11-03 15:30:28 -05:00
parent eeee65076e
commit 464b1fffb0
No known key found for this signature in database
GPG Key ID: 2AC6A5EC1C357C59
4 changed files with 73 additions and 9 deletions

View File

@ -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)

View File

@ -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)))

View File

@ -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

View File

@ -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: