* Linting, and how to get the information in to the Guix Data Serivce
@ 2019-05-06 18:26 Christopher Baines
2019-05-06 19:10 ` Christopher Baines
0 siblings, 1 reply; 5+ messages in thread
From: Christopher Baines @ 2019-05-06 18:26 UTC (permalink / raw)
To: guix-devel
[-- Attachment #1.1: Type: text/plain, Size: 1850 bytes --]
Hey,
I'm still making progress with the Guix Data Serivce, I recently added
support for recording information about branches from the Commits
mailing list [1]. One reason why this is useful is that it gives some
context to the individual commits.
1: https://prototype-guix-data-service.cbaines.net/branches
But, I've also made some time to try to start working on linting. I've
had this in mind for a while, in terms of using the Guix Data Service to
tell what a set of patches do, detecting linting warnings that have been
introduced or removed would be really useful in my opinion.
I have actually looked at importing the linting warnings for all the
packages in the past, but the way the code works, by outputting the
linting warnings to a port doesn't make it easy to capture all the
information and store this away.
Another key issue is that I'd at least initially only want to run checks
that just relate to the contents of the Git repository, so nothing
network dependant, as the network dependant checks could change over
time, so they need a bit more thinking about.
So, I think for this use case it would be useful if the code in Guix
around linting:
- Stored warnings as data, before outputting them
- Was in two parts, the lint checkers, and then the guix lint script
- Distinguished between lint checkers that use the network, and those
that don't
I've never worked with this part of Guix before, and some of it is quite
complex, so I've started by attempting to do the first bit, storing
warnings as data before outputting them. I've attached a patch.
Personally, this seems to have worked out quite well. I think the lint
checkers often are simpler when they just return one or more
<lint-warning> records.
If anyone has any thoughts on this, the patch, or linting in general,
I'd love to hear them.
Thanks,
Chris
[-- Attachment #1.2: /home/chris/Projects/Guix/guix/0001-scripts-lint-Handle-warnings-with-a-record-type.patch --]
[-- Type: message/external-body, Size: 104 bytes --]
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Linting, and how to get the information in to the Guix Data Serivce
2019-05-06 18:26 Linting, and how to get the information in to the Guix Data Serivce Christopher Baines
@ 2019-05-06 19:10 ` Christopher Baines
2019-05-07 21:16 ` Ludovic Courtès
0 siblings, 1 reply; 5+ messages in thread
From: Christopher Baines @ 2019-05-06 19:10 UTC (permalink / raw)
To: guix-devel
[-- Attachment #1.1: Type: text/plain, Size: 310 bytes --]
Christopher Baines <mail@cbaines.net> writes:
> I've never worked with this part of Guix before, and some of it is quite
> complex, so I've started by attempting to do the first bit, storing
> warnings as data before outputting them. I've attached a patch.
Now hopefuily with an actually attached patch...
[-- Attachment #1.2: Patch --]
[-- Type: text/x-patch, Size: 37809 bytes --]
From cd16443893afdacf9f3e4d8256cc943a5928aed4 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 6 May 2019 19:00:58 +0100
Subject: [PATCH] scripts: lint: Handle warnings with a record type.
Rather than emiting warnings directly to a port, have the checkers return the
warning or warnings.
This makes it easier to use the warnings in different ways, for example,
loading the data in to a database, as you can work with the <lint-warning>
records directly, rather than having to parse the output to determine the
package and location.
---
guix/scripts/lint.scm | 501 ++++++++++++++++++++++--------------------
1 file changed, 268 insertions(+), 233 deletions(-)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index dc338a1d7b..878864030a 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -93,42 +93,65 @@
\f
;;;
-;;; Helpers
+;;; Warnings
;;;
-(define* (emit-warning package message #:optional field)
+
+(define-record-type* <lint-warning>
+ lint-warning make-lint-warning
+ lint-warning?
+ (package lint-warning-package)
+ (message lint-warning-message)
+ (location lint-warning-field
+ (default #f)))
+
+(define (package-file package)
+ (location-file
+ (package-location package)))
+
+(define* (make-warning package message
+ #:key field location)
+ (make-lint-warning
+ package
+ message
+ (or location
+ (package-field-location package field)
+ (package-location package))))
+
+(define (emit-warnings warnings)
;; Emit a warning about PACKAGE, printing the location of FIELD if it is
;; given, the location of PACKAGE otherwise, the full name of PACKAGE and the
;; provided MESSAGE.
- (let ((loc (or (package-field-location package field)
- (package-location package))))
- (format (guix-warning-port) "~a: ~a@~a: ~a~%"
- (location->string loc)
- (package-name package) (package-version package)
- message)))
-
-(define (call-with-accumulated-warnings thunk)
- "Call THUNK, accumulating any warnings in the current state, using the state
-monad."
- (let ((port (open-output-string)))
- (mlet %state-monad ((state (current-state))
- (result -> (parameterize ((guix-warning-port port))
- (thunk)))
- (warning -> (get-output-string port)))
- (mbegin %state-monad
- (munless (string=? "" warning)
- (set-current-state (cons warning state)))
- (return result)))))
-
-(define-syntax-rule (with-accumulated-warnings exp ...)
- "Evaluate EXP and accumulate warnings in the state monad."
- (call-with-accumulated-warnings
- (lambda ()
- exp ...)))
+ (for-each
+ (match-lambda
+ (($ <lint-warning> package message loc)
+ (format (guix-warning-port) "~a: ~a@~a: ~a~%"
+ (location->string loc)
+ (package-name package) (package-version package)
+ message)))
+ (match warnings
+ ((? lint-warning?) (list warnings))
+ ((? list?) (apply append-warnings warnings))
+ (_ '()))))
+
+(define (append-warnings . args)
+ (fold (lambda (arg warnings)
+ (cond
+ ((list? arg)
+ (append warnings
+ (filter lint-warning?
+ arg)))
+ ((lint-warning? arg)
+ (append warnings
+ (list arg)))
+ (else warnings)))
+ '()
+ args))
\f
;;;
;;; Checkers
;;;
+
(define-record-type* <lint-checker>
lint-checker make-lint-checker
lint-checker?
@@ -164,9 +187,9 @@ monad."
;; Emit a warning if stylistic issues are found in the description of PACKAGE.
(define (check-not-empty description)
(when (string-null? description)
- (emit-warning package
+ (make-warning package
(G_ "description should not be empty")
- 'description)))
+ #:field 'description)))
(define (check-texinfo-markup description)
"Check that DESCRIPTION can be parsed as a Texinfo fragment. If the
@@ -174,39 +197,38 @@ markup is valid return a plain-text version of DESCRIPTION, otherwise #f."
(catch #t
(lambda () (texi->plain-text description))
(lambda (keys . args)
- (emit-warning package
+ (make-warning package
(G_ "Texinfo markup in description is invalid")
- 'description)
- #f)))
+ #:field 'description))))
(define (check-trademarks description)
"Check that DESCRIPTION does not contain '™' or '®' characters. See
http://www.gnu.org/prep/standards/html_node/Trademarks.html."
(match (string-index description (char-set #\™ #\®))
((and (? number?) index)
- (emit-warning package
+ (make-warning package
(format #f (G_ "description should not contain ~
trademark sign '~a' at ~d")
(string-ref description index) index)
- 'description))
+ #:field 'description))
(else #t)))
(define (check-quotes description)
"Check whether DESCRIPTION contains single quotes and suggest @code."
(when (regexp-exec %quoted-identifier-rx description)
- (emit-warning package
-
+ (make-warning package
;; TRANSLATORS: '@code' is Texinfo markup and must be kept
;; as is.
(G_ "use @code or similar ornament instead of quotes")
- 'description)))
+ #:field 'description)))
(define (check-proper-start description)
(unless (or (properly-starts-sentence? description)
(string-prefix-ci? (package-name package) description))
- (emit-warning package
- (G_ "description should start with an upper-case letter or digit")
- 'description)))
+ (make-warning
+ package
+ (G_ "description should start with an upper-case letter or digit")
+ #:field 'description)))
(define (check-end-of-sentence-space description)
"Check that an end-of-sentence period is followed by two spaces."
@@ -220,27 +242,30 @@ trademark sign '~a' at ~d")
'("i.e" "e.g" "a.k.a" "resp"))
r (cons (match:start m) r)))))))
(unless (null? infractions)
- (emit-warning package
+ (make-warning package
(format #f (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
(length infractions)
infractions)
- 'description))))
+ #:field 'description))))
(let ((description (package-description package)))
(if (string? description)
- (begin
- (check-not-empty description)
- (check-quotes description)
- (check-trademarks description)
- ;; Use raw description for this because Texinfo rendering
- ;; automatically fixes end of sentence space.
- (check-end-of-sentence-space description)
- (and=> (check-texinfo-markup description)
- check-proper-start))
- (emit-warning package
+ (append-warnings
+ (check-not-empty description)
+ (check-quotes description)
+ (check-trademarks description)
+ ;; Use raw description for this because Texinfo rendering
+ ;; automatically fixes end of sentence space.
+ (check-end-of-sentence-space description)
+ (and=> (check-texinfo-markup description)
+ (match-lambda
+ ((and warning (? lint-warning?)) warning)
+ (description
+ (check-proper-start description)))))
+ (make-warning package
(format #f (G_ "invalid description: ~s") description)
- 'description))))
+ #:field 'description))))
(define (package-input-intersection inputs-to-check input-names)
"Return the intersection between INPUTS-TO-CHECK, the list of input tuples
@@ -281,13 +306,13 @@ of a package, and INPUT-NAMES, a list of package specifications such as
"python-pytest-cov" "python2-pytest-cov"
"python-setuptools-scm" "python2-setuptools-scm"
"python-sphinx" "python2-sphinx")))
- (for-each (lambda (input)
- (emit-warning
- package
- (format #f (G_ "'~a' should probably be a native input")
- input)
- 'inputs-to-check))
- (package-input-intersection inputs input-names))))
+ (map (lambda (input)
+ (make-warning
+ package
+ (format #f (G_ "'~a' should probably be a native input")
+ input)
+ #:field 'inputs))
+ (package-input-intersection inputs input-names))))
(define (check-inputs-should-not-be-an-input-at-all package)
;; Emit a warning if some inputs of PACKAGE are likely to should not be
@@ -296,14 +321,15 @@ of a package, and INPUT-NAMES, a list of package specifications such as
"python2-setuptools"
"python-pip"
"python2-pip")))
- (for-each (lambda (input)
- (emit-warning
- package
- (format #f
- (G_ "'~a' should probably not be an input at all")
- input)))
- (package-input-intersection (package-direct-inputs package)
- input-names))))
+ (map (lambda (input)
+ (make-warning
+ package
+ (format #f
+ (G_ "'~a' should probably not be an input at all")
+ input)
+ #:field 'inputs))
+ (package-input-intersection (package-direct-inputs package)
+ input-names))))
(define (package-name-regexp package)
"Return a regexp that matches PACKAGE's name as a word at the beginning of a
@@ -316,17 +342,17 @@ line."
;; Emit a warning if stylistic issues are found in the synopsis of PACKAGE.
(define (check-not-empty synopsis)
(when (string-null? synopsis)
- (emit-warning package
+ (make-warning package
(G_ "synopsis should not be empty")
- 'synopsis)))
+ #:field 'synopsis)))
(define (check-final-period synopsis)
;; Synopsis should not end with a period, except for some special cases.
(when (and (string-suffix? "." synopsis)
(not (string-suffix? "etc." synopsis)))
- (emit-warning package
+ (make-warning package
(G_ "no period allowed at the end of the synopsis")
- 'synopsis)))
+ #:field 'synopsis)))
(define check-start-article
;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
@@ -336,29 +362,29 @@ line."
(lambda (synopsis)
(when (or (string-prefix-ci? "A " synopsis)
(string-prefix-ci? "An " synopsis))
- (emit-warning package
+ (make-warning package
(G_ "no article allowed at the beginning of \
the synopsis")
- 'synopsis)))))
+ #:field 'synopsis)))))
(define (check-synopsis-length synopsis)
(when (>= (string-length synopsis) 80)
- (emit-warning package
+ (make-warning package
(G_ "synopsis should be less than 80 characters long")
- 'synopsis)))
+ #:field 'synopsis)))
(define (check-proper-start synopsis)
(unless (properly-starts-sentence? synopsis)
- (emit-warning package
+ (make-warning package
(G_ "synopsis should start with an upper-case letter or digit")
- 'synopsis)))
+ #:field 'synopsis)))
(define (check-start-with-package-name synopsis)
(when (and (regexp-exec (package-name-regexp package) synopsis)
(not (starts-with-abbreviation? synopsis)))
- (emit-warning package
+ (make-warning package
(G_ "synopsis should not start with the package name")
- 'synopsis)))
+ #:field 'synopsis)))
(define (check-texinfo-markup synopsis)
"Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
@@ -366,10 +392,9 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
(catch #t
(lambda () (texi->plain-text synopsis))
(lambda (keys . args)
- (emit-warning package
+ (make-warning package
(G_ "Texinfo markup in synopsis is invalid")
- 'synopsis)
- #f)))
+ #:field 'synopsis))))
(define checks
(list check-not-empty
@@ -382,12 +407,13 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
(match (package-synopsis package)
((? string? synopsis)
- (for-each (lambda (proc)
- (proc synopsis))
- checks))
+ (apply append-warnings
+ (map (lambda (proc)
+ (proc synopsis))
+ checks)))
(invalid
- (emit-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
- 'synopsis))))
+ (make-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
+ #:field 'synopsis))))
(define* (probe-uri uri #:key timeout)
"Probe URI, a URI object, and return two values: a symbol denoting the
@@ -502,71 +528,66 @@ warning for PACKAGE mentionning the FIELD."
;; with a small HTML page upon failure. Attempt to detect
;; such malicious behavior.
(or (> length 1000)
- (begin
- (emit-warning package
- (format #f
- (G_ "URI ~a returned \
+ (make-warning package
+ (format #f
+ (G_ "URI ~a returned \
suspiciously small file (~a bytes)")
- (uri->string uri)
- length))
- #f)))
+ (uri->string uri)
+ length)
+ #:field field)))
(_ #t)))
((= 301 (response-code argument))
(if (response-location argument)
- (begin
- (emit-warning package
- (format #f (G_ "permanent redirect from ~a to ~a")
- (uri->string uri)
- (uri->string
- (response-location argument))))
- #t)
- (begin
- (emit-warning package
- (format #f (G_ "invalid permanent redirect \
+ (make-warning package
+ (format #f (G_ "permanent redirect from ~a to ~a")
+ (uri->string uri)
+ (uri->string
+ (response-location argument)))
+ #:field field)
+ (make-warning package
+ (format #f (G_ "invalid permanent redirect \
from ~a")
- (uri->string uri)))
- #f)))
+ (uri->string uri))
+ #:field)))
(else
- (emit-warning package
+ (make-warning package
(format #f
(G_ "URI ~a not reachable: ~a (~s)")
(uri->string uri)
(response-code argument)
(response-reason-phrase argument))
- field)
- #f)))
+ #:field field))))
((ftp-response)
(match argument
(('ok) #t)
(('error port command code message)
- (emit-warning package
+ (make-warning package
(format #f
(G_ "URI ~a not reachable: ~a (~s)")
(uri->string uri)
- code (string-trim-both message)))
- #f)))
+ code (string-trim-both message))
+ #:field field))))
((getaddrinfo-error)
- (emit-warning package
+ (make-warning package
(format #f
(G_ "URI ~a domain not found: ~a")
(uri->string uri)
(gai-strerror (car argument)))
- field)
- #f)
+ #:field field))
((system-error)
- (emit-warning package
+ (make-warning package
(format #f
(G_ "URI ~a unreachable: ~a")
(uri->string uri)
(strerror
(system-error-errno
(cons status argument))))
- field)
- #f)
+ #:field field))
((tls-certificate-error)
- (emit-warning package
+ (make-warning package
(format #f (G_ "TLS certificate error: ~a")
- (tls-certificate-error-string argument))))
+ (tls-certificate-error-string argument))
+ #:field field))
((invalid-http-response gnutls-error)
;; Probably a misbehaving server; ignore.
#f)
@@ -585,13 +606,13 @@ from ~a")
((not (package-home-page package))
(unless (or (string-contains (package-name package) "bootstrap")
(string=? (package-name package) "ld-wrapper"))
- (emit-warning package
+ (make-warning package
(G_ "invalid value for home page")
- 'home-page)))
+ #:field 'home-page)))
(else
- (emit-warning package (format #f (G_ "invalid home page URL: ~s")
+ (make-warning package (format #f (G_ "invalid home page URL: ~s")
(package-home-page package))
- 'home-page)))))
+ #:field 'home-page)))))
(define %distro-directory
(mlambda ()
@@ -601,42 +622,43 @@ from ~a")
"Emit a warning if the patches requires by PACKAGE are badly named or if the
patch could not be found."
(guard (c ((message-condition? c) ;raised by 'search-patch'
- (emit-warning package (condition-message c)
- 'patch-file-names)))
+ (make-warning package (condition-message c)
+ #:field 'patch-file-names)))
(define patches
(or (and=> (package-source package) origin-patches)
'()))
- (unless (every (match-lambda ;patch starts with package name?
+ (cons*
+ (unless (every (match-lambda ;patch starts with package name?
+ ((? string? patch)
+ (and=> (string-contains (basename patch)
+ (package-name package))
+ zero?))
+ (_ #f)) ;must be an <origin> or something like that.
+ patches)
+ (make-warning
+ package
+ (G_ "file names of patches should start with the package name")
+ #:field 'patch-file-names))
+
+ ;; Check whether we're reaching tar's maximum file name length.
+ (let ((prefix (string-length (%distro-directory)))
+ (margin (string-length "guix-0.13.0-10-123456789/"))
+ (max 99))
+ (filter-map (match-lambda
((? string? patch)
- (and=> (string-contains (basename patch)
- (package-name package))
- zero?))
- (_ #f)) ;must be an <origin> or something like that.
- patches)
- (emit-warning
- package
- (G_ "file names of patches should start with the package name")
- 'patch-file-names))
-
- ;; Check whether we're reaching tar's maximum file name length.
- (let ((prefix (string-length (%distro-directory)))
- (margin (string-length "guix-0.13.0-10-123456789/"))
- (max 99))
- (for-each (match-lambda
- ((? string? patch)
- (when (> (+ margin (if (string-prefix? (%distro-directory)
- patch)
- (- (string-length patch) prefix)
- (string-length patch)))
- max)
- (emit-warning
- package
- (format #f (G_ "~a: file name is too long")
- (basename patch))
- 'patch-file-names)))
- (_ #f))
- patches))))
+ (when (> (+ margin (if (string-prefix? (%distro-directory)
+ patch)
+ (- (string-length patch) prefix)
+ (string-length patch)))
+ max)
+ (make-warning
+ package
+ (format #f (G_ "~a: file name is too long")
+ (basename patch))
+ #:field 'patch-file-names)))
+ (_ #f))
+ patches)))))
(define (escape-quotes str)
"Replace any quote character in STR by an escaped quote character."
@@ -665,30 +687,29 @@ descriptions maintained upstream."
(#f ;not a GNU package, so nothing to do
#t)
(descriptor ;a genuine GNU package
- (let ((upstream (gnu-package-doc-summary descriptor))
- (downstream (package-synopsis package))
- (loc (or (package-field-location package 'synopsis)
- (package-location package))))
- (when (and upstream
- (or (not (string? downstream))
- (not (string=? upstream downstream))))
- (format (guix-warning-port)
- (G_ "~a: ~a: proposed synopsis: ~s~%")
- (location->string loc) (package-full-name package)
- upstream)))
-
- (let ((upstream (gnu-package-doc-description descriptor))
- (downstream (package-description package))
- (loc (or (package-field-location package 'description)
- (package-location package))))
- (when (and upstream
- (or (not (string? downstream))
- (not (string=? (fill-paragraph upstream 100)
- (fill-paragraph downstream 100)))))
- (format (guix-warning-port)
- (G_ "~a: ~a: proposed description:~% \"~a\"~%")
- (location->string loc) (package-full-name package)
- (fill-paragraph (escape-quotes upstream) 77 7)))))))
+ (list
+ (let ((upstream (gnu-package-doc-summary descriptor))
+ (downstream (package-synopsis package)))
+ (when (and upstream
+ (or (not (string? downstream))
+ (not (string=? upstream downstream))))
+ (make-warning package
+ (format #f (G_ "proposed synopsis: ~s~%")
+ upstream)
+ #:field 'synopsis)))
+
+ (let ((upstream (gnu-package-doc-description descriptor))
+ (downstream (package-description package)))
+ (when (and upstream
+ (or (not (string? downstream))
+ (not (string=? (fill-paragraph upstream 100)
+ (fill-paragraph downstream 100)))))
+ (make-warning
+ package
+ (format #f
+ (G_ "proposed description:~% \"~a\"~%")
+ (fill-paragraph (escape-quotes upstream) 77 7))
+ #:field 'description)))))))
(define (origin-uris origin)
"Return the list of URIs (strings) for ORIGIN."
@@ -701,38 +722,34 @@ descriptions maintained upstream."
(define (check-source package)
"Emit a warning if PACKAGE has an invalid 'source' field, or if that
'source' is not reachable."
- (define (try-uris uris)
- (run-with-state
- (anym %state-monad
- (lambda (uri)
- (with-accumulated-warnings
- (validate-uri uri package 'source)))
- (append-map (cut maybe-expand-mirrors <> %mirrors)
- uris))
- '()))
+ (define (warnings-for-uris uris)
+ (apply
+ append-warnings
+ (map
+ (lambda (uri)
+ (validate-uri uri package 'source))
+ (append-map (cut maybe-expand-mirrors <> %mirrors)
+ uris))))
(let ((origin (package-source package)))
(when (and origin
(eqv? (origin-method origin) url-fetch))
- (let ((uris (map string->uri (origin-uris origin))))
+ (let* ((uris (map string->uri (origin-uris origin)))
+ (warnings (warnings-for-uris uris)))
;; Just make sure that at least one of the URIs is valid.
- (call-with-values
- (lambda () (try-uris uris))
- (lambda (success? warnings)
+ (if (eq? (length uris) (length warnings))
;; When everything fails, report all of WARNINGS, otherwise don't
;; report anything.
;;
;; XXX: Ideally we'd still allow warnings to be raised if *some*
;; URIs are unreachable, but distinguish that from the error case
;; where *all* the URIs are unreachable.
- (unless success?
- (emit-warning package
- (G_ "all the source URIs are unreachable:")
- 'source)
- (for-each (lambda (warning)
- (display warning (guix-warning-port)))
- (reverse warnings)))))))))
+ (cons*
+ (make-warning package
+ (G_ "all the source URIs are unreachable:")
+ #:field 'source)
+ warnings))))))
(define (check-source-file-name package)
"Emit a warning if PACKAGE's origin has no meaningful file name."
@@ -749,9 +766,9 @@ descriptions maintained upstream."
(let ((origin (package-source package)))
(unless (or (not origin) (origin-file-name-valid? origin))
- (emit-warning package
+ (make-warning package
(G_ "the source file name should contain the package name")
- 'source))))
+ #:field 'source))))
(define (check-source-unstable-tarball package)
"Emit a warning if PACKAGE's source is an autogenerated tarball."
@@ -761,14 +778,14 @@ descriptions maintained upstream."
(uri-path (string->uri uri)))
((_ _ "archive" _ ...) #t)
(_ #f)))
- (emit-warning package
+ (make-warning package
(G_ "the source URI should not be an autogenerated tarball")
- 'source)))
+ #:field 'source)))
(let ((origin (package-source package)))
(when (and (origin? origin)
(eqv? (origin-method origin) url-fetch))
(let ((uris (origin-uris origin)))
- (for-each check-source-uri uris)))))
+ (filter-map check-source-uri uris)))))
(define (check-mirror-url package)
"Check whether PACKAGE uses source URLs that should be 'mirror://'."
@@ -782,18 +799,18 @@ descriptions maintained upstream."
(#f
(loop rest))
(prefix
- (emit-warning package
+ (make-warning package
(format #f (G_ "URL should be \
'mirror://~a/~a'")
mirror-id
(string-drop uri (string-length prefix)))
- 'source)))))))
+ #:field 'source)))))))
(let ((origin (package-source package)))
(when (and (origin? origin)
(eqv? (origin-method origin) url-fetch))
(let ((uris (origin-uris origin)))
- (for-each check-mirror-uri uris)))))
+ (filter-map check-mirror-uri uris)))))
(define* (check-github-url package #:key (timeout 3))
"Check whether PACKAGE uses source URLs that redirect to GitHub."
@@ -819,15 +836,15 @@ descriptions maintained upstream."
(let ((origin (package-source package)))
(when (and (origin? origin)
(eqv? (origin-method origin) url-fetch))
- (for-each
+ (filter-map
(lambda (uri)
(and=> (follow-redirects-to-github uri)
(lambda (github-uri)
(unless (string=? github-uri uri)
- (emit-warning
+ (make-warning
package
(format #f (G_ "URL should be '~a'") github-uri)
- 'source)))))
+ #:field 'source)))))
(origin-uris origin)))))
(define (check-derivation package)
@@ -836,12 +853,12 @@ descriptions maintained upstream."
(catch #t
(lambda ()
(guard (c ((store-protocol-error? c)
- (emit-warning package
+ (make-warning package
(format #f (G_ "failed to create ~a derivation: ~a")
system
(store-protocol-error-message c))))
((message-condition? c)
- (emit-warning package
+ (make-warning package
(format #f (G_ "failed to create ~a derivation: ~a")
system
(condition-message c)))))
@@ -858,11 +875,11 @@ descriptions maintained upstream."
(package-derivation store replacement system
#:graft? #f)))))))
(lambda args
- (emit-warning package
+ (make-warning package
(format #f (G_ "failed to create ~a derivation: ~s")
system args)))))
- (for-each try (package-supported-systems package)))
+ (filter-map try (package-supported-systems package)))
(define (check-license package)
"Warn about type errors of the 'license' field of PACKAGE."
@@ -871,8 +888,8 @@ descriptions maintained upstream."
((? license?) ...))
#t)
(x
- (emit-warning package (G_ "invalid license field")
- 'license))))
+ (make-warning package (G_ "invalid license field")
+ #:field 'license))))
(define (call-with-networking-fail-safe message error-value proc)
"Call PROC catching any network-related errors. Upon a networking error,
@@ -944,10 +961,10 @@ the NIST server non-fatal."
(member id known-safe))))
vulnerabilities)))
(unless (null? unpatched)
- (emit-warning package
- (format #f (G_ "probably vulnerable to ~a")
- (string-join (map vulnerability-id unpatched)
- ", ")))))))))
+ (make-warning package
+ (format #f (G_ "probably vulnerable to ~a")
+ (string-join (map vulnerability-id unpatched)
+ ", ")))))))))
(define (check-for-updates package)
"Check if there is an update available for PACKAGE."
@@ -959,9 +976,10 @@ the NIST server non-fatal."
((? upstream-source? source)
(when (version>? (upstream-source-version source)
(package-version package))
- (emit-warning package
+ (make-warning package
(format #f (G_ "can be upgraded to ~a")
- (upstream-source-version source)))))
+ (upstream-source-version source))
+ #:field 'version)))
(#f #f))) ; cannot find newer upstream release
\f
@@ -974,18 +992,26 @@ the NIST server non-fatal."
(match (string-index line #\tab)
(#f #t)
(index
- (emit-warning package
+ (make-warning package
(format #f (G_ "tabulation on line ~a, column ~a")
- line-number index)))))
+ line-number index)
+ #:location
+ (location (package-file package)
+ line-number
+ index)))))
(define (report-trailing-white-space package line line-number)
"Warn about trailing white space in LINE."
(unless (or (string=? line (string-trim-right line))
(string=? line (string #\page)))
- (emit-warning package
+ (make-warning package
(format #f
(G_ "trailing white space on line ~a")
- line-number))))
+ line-number)
+ #:location
+ (location (package-file package)
+ line-number
+ 0))))
(define (report-long-line package line line-number)
"Emit a warning if LINE is too long."
@@ -993,9 +1019,13 @@ the NIST server non-fatal."
;; make it hard to fit within that limit and we want to avoid making too
;; much noise.
(when (> (string-length line) 90)
- (emit-warning package
+ (make-warning package
(format #f (G_ "line ~a is way too long (~a characters)")
- line-number (string-length line)))))
+ line-number (string-length line))
+ #:location
+ (location (package-file package)
+ line-number
+ 0))))
(define %hanging-paren-rx
(make-regexp "^[[:blank:]]*[()]+[[:blank:]]*$"))
@@ -1003,11 +1033,15 @@ the NIST server non-fatal."
(define (report-lone-parentheses package line line-number)
"Emit a warning if LINE contains hanging parentheses."
(when (regexp-exec %hanging-paren-rx line)
- (emit-warning package
+ (make-warning package
(format #f
- (G_ "line ~a: parentheses feel lonely, \
+ (G_ "parentheses feel lonely, \
move to the previous or next line")
- line-number))))
+ line-number)
+ #:location
+ (location (package-file package)
+ line-number
+ 0))))
(define %formatting-reporters
;; List of procedures that report formatting issues. These are not separate
@@ -1155,7 +1189,8 @@ or a list thereof")
(package-name package) (package-version package)
(lint-checker-name checker))
(force-output (current-error-port)))
- ((lint-checker-check checker) package))
+ (emit-warnings
+ ((lint-checker-check checker) package)))
checkers)
(when tty?
(format (current-error-port) "\x1b[K")
--
2.21.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: Linting, and how to get the information in to the Guix Data Serivce
2019-05-06 19:10 ` Christopher Baines
@ 2019-05-07 21:16 ` Ludovic Courtès
2019-05-10 7:02 ` Christopher Baines
0 siblings, 1 reply; 5+ messages in thread
From: Ludovic Courtès @ 2019-05-07 21:16 UTC (permalink / raw)
To: Christopher Baines; +Cc: guix-devel
Hello!
Christopher Baines <mail@cbaines.net> skribis:
> Christopher Baines <mail@cbaines.net> writes:
>
>> I've never worked with this part of Guix before, and some of it is quite
>> complex, so I've started by attempting to do the first bit, storing
>> warnings as data before outputting them. I've attached a patch.
Providing more structure sounds like a good idea to me (though in the
end it’s still just text; not sure if that’s good enough for what you
had in mind?).
From a UI viewpoint, it’s important that ‘guix lint’ prints warning as
they come, rather than eat CPU for some time and eventually spit out
everything at once.
> From cd16443893afdacf9f3e4d8256cc943a5928aed4 Mon Sep 17 00:00:00 2001
> From: Christopher Baines <mail@cbaines.net>
> Date: Mon, 6 May 2019 19:00:58 +0100
> Subject: [PATCH] scripts: lint: Handle warnings with a record type.
>
> Rather than emiting warnings directly to a port, have the checkers return the
> warning or warnings.
>
> This makes it easier to use the warnings in different ways, for example,
> loading the data in to a database, as you can work with the <lint-warning>
> records directly, rather than having to parse the output to determine the
> package and location.
[...]
> +(define-record-type* <lint-warning>
> + lint-warning make-lint-warning
> + lint-warning?
> + (package lint-warning-package)
> + (message lint-warning-message)
> + (location lint-warning-field
> + (default #f)))
It could be useful to have a ‘checker’ field linking to the checker that
produced the warning.
> (define (check-not-empty description)
> (when (string-null? description)
> - (emit-warning package
> + (make-warning package
> (G_ "description should not be empty")
> - 'description)))
> + #:field 'description)))
This procedure returns either a warning or the unspecified value, which
is probably not intended? I suppose a lot of the code is currently
written with ‘emit-warning’ in effect position, which will have to be
changed.
I suppose tests/lint.scm needs to be converted to the new API?
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Linting, and how to get the information in to the Guix Data Serivce
2019-05-07 21:16 ` Ludovic Courtès
@ 2019-05-10 7:02 ` Christopher Baines
2019-05-18 10:30 ` Christopher Baines
0 siblings, 1 reply; 5+ messages in thread
From: Christopher Baines @ 2019-05-10 7:02 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
[-- Attachment #1: Type: text/plain, Size: 3688 bytes --]
Ludovic Courtès <ludo@gnu.org> writes:
> Hello!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Christopher Baines <mail@cbaines.net> writes:
>>
>>> I've never worked with this part of Guix before, and some of it is quite
>>> complex, so I've started by attempting to do the first bit, storing
>>> warnings as data before outputting them. I've attached a patch.
>
> Providing more structure sounds like a good idea to me (though in the
> end it’s still just text; not sure if that’s good enough for what you
> had in mind?).
Great, I'm also not entirely sure what would be best, but I think having
the package and location as the record values, along with the message is
a good start.
> From a UI viewpoint, it’s important that ‘guix lint’ prints warning as
> they come, rather than eat CPU for some time and eventually spit out
> everything at once.
So, currently this does change the behaviour, but I'm hoping it's still
ok. The warnings will be printed after running each checker. So if there
are checkers that take a long time, and possibly report multiple
warnings, then that could be an issue, but I don't believe this is the
case.
>> From cd16443893afdacf9f3e4d8256cc943a5928aed4 Mon Sep 17 00:00:00 2001
>> From: Christopher Baines <mail@cbaines.net>
>> Date: Mon, 6 May 2019 19:00:58 +0100
>> Subject: [PATCH] scripts: lint: Handle warnings with a record type.
>>
>> Rather than emiting warnings directly to a port, have the checkers return the
>> warning or warnings.
>>
>> This makes it easier to use the warnings in different ways, for example,
>> loading the data in to a database, as you can work with the <lint-warning>
>> records directly, rather than having to parse the output to determine the
>> package and location.
>
> [...]
>
>> +(define-record-type* <lint-warning>
>> + lint-warning make-lint-warning
>> + lint-warning?
>> + (package lint-warning-package)
>> + (message lint-warning-message)
>> + (location lint-warning-field
>> + (default #f)))
>
> It could be useful to have a ‘checker’ field linking to the checker that
> produced the warning.
Good point. Any suggestions on how to do this? At the moment, the
checker values don't really have names, they're just in a list. I could
move the definitions out of the list, and define them at the top level
like packages. Another option I was possibly considering is populating
the checker field after the warnings are returned from the checker
function... any thoughts?
>> (define (check-not-empty description)
>> (when (string-null? description)
>> - (emit-warning package
>> + (make-warning package
>> (G_ "description should not be empty")
>> - 'description)))
>> + #:field 'description)))
>
> This procedure returns either a warning or the unspecified value, which
> is probably not intended? I suppose a lot of the code is currently
> written with ‘emit-warning’ in effect position, which will have to be
> changed.
So, it's important that all the generated warnings are returned, so I
changed some checkers to return lists. Also, I added a append-warnings
function which takes 1 or more arguments, and will sort the warnings in
to a neat list. I did consider changing all the checkers to return a
neat list of warnings, but that would require more changes. What do you
think?
> I suppose tests/lint.scm needs to be converted to the new API?
Ah, yep. I've made a start on this now. I think returning
<lint-warnings> will make writing the tests easier, which is nice.
Thanks,
Chris
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: Linting, and how to get the information in to the Guix Data Serivce
2019-05-10 7:02 ` Christopher Baines
@ 2019-05-18 10:30 ` Christopher Baines
0 siblings, 0 replies; 5+ messages in thread
From: Christopher Baines @ 2019-05-18 10:30 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
[-- Attachment #1: Type: text/plain, Size: 549 bytes --]
Christopher Baines <mail@cbaines.net> writes:
>> I suppose tests/lint.scm needs to be converted to the new API?
>
> Ah, yep. I've made a start on this now. I think returning
> <lint-warnings> will make writing the tests easier, which is nice.
I've finally made it through re-writing all the linting tests... and I
think they should all pass. I've send the patch now to
guix-patches. I've got no idea what to put for the changelog part of the
commit message, so I've left that out for now.
1: https://issues.guix.info/issue/35790
Thanks,
Chris
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2019-05-18 10:31 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-05-06 18:26 Linting, and how to get the information in to the Guix Data Serivce Christopher Baines
2019-05-06 19:10 ` Christopher Baines
2019-05-07 21:16 ` Ludovic Courtès
2019-05-10 7:02 ` Christopher Baines
2019-05-18 10:30 ` Christopher Baines
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).