me
/
guix
Archived
1
0
Fork 0

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.
master
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 upstream)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (hackage->guix-package #:export (%hackage-url
hackage->guix-package
hackage-recursive-import hackage-recursive-import
%hackage-updater %hackage-updater
@ -92,20 +93,23 @@
(define package-name-prefix "ghc-") (define package-name-prefix "ghc-")
(define %hackage-url
(make-parameter "https://hackage.haskell.org"))
(define (hackage-source-url name version) (define (hackage-source-url name version)
"Given a Hackage package NAME and VERSION, return a url to the source "Given a Hackage package NAME and VERSION, return a url to the source
tarball." tarball."
(string-append "https://hackage.haskell.org/package/" name (string-append (%hackage-url) "/package/"
"/" name "-" version ".tar.gz")) name "/" name "-" version ".tar.gz"))
(define* (hackage-cabal-url name #:optional version) (define* (hackage-cabal-url name #:optional version)
"Given a Hackage package NAME and VERSION, return a url to the corresponding "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 .cabal file on Hackage. If VERSION is #f or missing, the url for the latest
version is returned." version is returned."
(if version (if version
(string-append "https://hackage.haskell.org/package/" (string-append (%hackage-url) "/package/"
name "-" version "/" name ".cabal") name "-" version "/" name ".cabal")
(string-append "https://hackage.haskell.org/package/" (string-append (%hackage-url) "/package/"
name "/" name ".cabal"))) name "/" name ".cabal")))
(define (hackage-name->package-name name) (define (hackage-name->package-name name)

View File

@ -30,7 +30,8 @@
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix upstream) #:use-module (guix upstream)
#:export (stackage->guix-package #:export (%stackage-url
stackage->guix-package
stackage-recursive-import stackage-recursive-import
%stackage-updater)) %stackage-updater))
@ -39,7 +40,8 @@
;;; Stackage info fetcher and access functions ;;; 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. ;; Latest LTS version compatible with GHC 8.6.5.
(define %default-lts-version "14.27") (define %default-lts-version "14.27")
@ -55,7 +57,7 @@
;; "Retrieve the information about the LTS Stackage release VERSION." ;; "Retrieve the information about the LTS Stackage release VERSION."
(memoize (memoize
(lambda* (#:optional (version "")) (lambda* (#:optional (version ""))
(let* ((url (string-append %stackage-url (let* ((url (string-append (%stackage-url)
"/lts-" (if (string-null? version) "/lts-" (if (string-null? version)
%default-lts-version %default-lts-version
version))) version)))

View File

@ -10,6 +10,7 @@
;;; Copyright © 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2020 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -52,6 +53,7 @@
#:use-module ((guix swh) #:hide (origin?)) #:use-module ((guix swh) #:hide (origin?))
#:autoload (guix git-download) (git-reference? #:autoload (guix git-download) (git-reference?
git-reference-url git-reference-commit) git-reference-url git-reference-commit)
#:use-module (guix import stackage)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -90,6 +92,7 @@
check-formatting check-formatting
check-archival check-archival
check-profile-collisions check-profile-collisions
check-haskell-stackage
lint-warning lint-warning
lint-warning? lint-warning?
@ -1285,6 +1288,25 @@ Heritage")
'() '()
(apply throw key args)))))))) (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. ;;; Source code formatting.
@ -1511,7 +1533,11 @@ or a list thereof")
(lint-checker (lint-checker
(name 'archival) (name 'archival)
(description "Ensure source code archival on Software Heritage") (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 (define %all-checkers
(append %local-checkers (append %local-checkers

View File

@ -7,6 +7,7 @@
;;; Copyright © 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -38,6 +39,8 @@
#:use-module (guix swh) #:use-module (guix swh)
#:use-module ((guix gexp) #:select (local-file)) #:use-module ((guix gexp) #:select (local-file))
#:use-module ((guix utils) #:select (call-with-temporary-directory)) #: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)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
@ -1057,6 +1060,35 @@
(string-contains (single-lint-warning-message warnings) (string-contains (single-lint-warning-message warnings)
"rate limit reached"))) "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") (test-end "lint")
;; Local Variables: ;; Local Variables: