[PATCH] scripts: lint: Handle warnings with a record type.

  • Done
  • quality assurance status badge
Details
2 participants
  • Ludovic Courtès
  • Christopher Baines
Owner
unassigned
Submitted by
Christopher Baines
Severity
normal

Debbugs page

Christopher Baines wrote 6 years ago
(address . guix-patches@gnu.org)
20190518093206.22069-1-mail@cbaines.net
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 | 544 +++++++++-------
tests/lint.scm | 1436 +++++++++++++++++++----------------------
2 files changed, 974 insertions(+), 1006 deletions(-)

Toggle diff (488 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index dc338a1d7b..37b17cefb4 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -84,6 +84,14 @@
check-formatting
run-checkers
+ <lint-warning>
+ lint-warning
+ lint-warning-package
+ lint-warning-message
+ lint-warning-location
+
+ append-warnings
+
%checkers
lint-checker
lint-checker?
@@ -93,42 +101,65 @@
;;;
-;;; 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-location
+ (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))
;;;
;;; Checkers
;;;
+
(define-record-type* <lint-checker>
lint-checker make-lint-checker
lint-checker?
@@ -164,9 +195,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 +205,39 @@ 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)
+ (unless (or (string-null? description)
+ (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 +251,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 +315,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 +330,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
@@ -314,19 +349,13 @@ line."
(define (check-synopsis-style package)
;; 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
- (G_ "synopsis should not be empty")
- '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 +365,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,14 +395,12 @@ 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
- check-proper-start
+ (list check-proper-start
check-final-period
check-start-article
check-start-with-package-name
@@ -381,13 +408,18 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
check-texinfo-markup))
(match (package-synopsis package)
+ (""
+ (make-warning package
+ (G_ "synopsis should not be empty")
+ #:field 'synopsis))
((? 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 +534,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 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 +612,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 +628,43 @@ from ~a")
"Emit a warning if the patches requires by PACKAGE are badly named or if the
patch could not b
This message was truncated. Download the full message here.
Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
878suz27ke.fsf@gnu.org
Hello!

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (8 lines)
> 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.

Yay!

Toggle quote (2 lines)
> + <lint-warning>

As a rule of thumb, it’s best to not export the record type descriptor
(RTD) because then anything could happen. In this case, I think the
tests would be just as readable if we used ‘lint-warning-message’ &
co. instead of matching on the record.

WDYT?

Toggle quote (6 lines)
> +(define* (make-warning package message
> + #:key field location)
> + (make-lint-warning
> + package
> + message

In practice MESSAGE is already translated. I think it would be more
flexible if it were not; ‘lint-warning-message’ would always return the
English message, and it’d be up to the user to call ‘gettext’ on it,
like we do for package descriptions.

To achieve this, you’d need a little trick so that ‘xgettext’ can still
extract the messages, like:


(define-syntax-rule make-warning
(syntax-rule (G_)
((_ package (G_ message) rest ...)
(%make-warning package message rest ...))))

where ‘%make-warning’ is the procedure you define above.

Then you need an explicit call to ‘G_’ at the point where messages are
displayed.

Does that make sense?

Toggle quote (14 lines)
> +(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))

I always feel that we should have procedures that operate on lists of
anything, like ‘append’, and thus ‘append-warnings’ looks like an
anti-pattern to me.

What about simply ensuring that every checker returns a list of
<lint-warning>s? That way, we wouldn’t have to do such things, I think.

That’s all!

Thanks,
Ludo’.
Christopher Baines wrote 6 years ago
[PATCH] scripts: lint: Handle warnings with a record type.
(address . 35790@debbugs.gnu.org)
20190601183135.11882-1-mail@cbaines.net
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 | 757 +++++++++++----------
tests/lint.scm | 1453 +++++++++++++++++++----------------------
2 files changed, 1102 insertions(+), 1108 deletions(-)

Toggle diff (481 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index dc338a1d7b..1b08068669 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -84,6 +84,12 @@
check-formatting
run-checkers
+ lint-warning
+ lint-warning?
+ lint-warning-package
+ lint-warning-message
+ lint-warning-location
+
%checkers
lint-checker
lint-checker?
@@ -93,42 +99,48 @@
;;;
-;;; 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-location
+ (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)))
+ warnings))
;;;
;;; Checkers
;;;
+
(define-record-type* <lint-checker>
lint-checker make-lint-checker
lint-checker?
@@ -163,10 +175,12 @@ monad."
(define (check-description-style package)
;; 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
- (G_ "description should not be empty")
- 'description)))
+ (if (string-null? description)
+ (list
+ (make-warning package
+ (G_ "description should not be empty")
+ #:field 'description))
+ '()))
(define (check-texinfo-markup description)
"Check that DESCRIPTION can be parsed as a Texinfo fragment. If the
@@ -174,39 +188,44 @@ 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
- (format #f (G_ "description should not contain ~
+ (list
+ (make-warning package
+ (format #f (G_ "description should not contain ~
trademark sign '~a' at ~d")
- (string-ref description index) index)
- 'description))
- (else #t)))
+ (string-ref description index) index)
+ #:field 'description)))
+ (else '())))
(define (check-quotes description)
"Check whether DESCRIPTION contains single quotes and suggest @code."
- (when (regexp-exec %quoted-identifier-rx description)
- (emit-warning package
-
- ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
- ;; as is.
- (G_ "use @code or similar ornament instead of quotes")
- 'description)))
+ (if (regexp-exec %quoted-identifier-rx description)
+ (list
+ (make-warning package
+ ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
+ ;; as is.
+ (G_ "use @code or similar ornament instead of quotes")
+ #: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)))
+ (if (or (string-null? description)
+ (properly-starts-sentence? description)
+ (string-prefix-ci? (package-name package) description))
+ '()
+ (list
+ (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."
@@ -219,28 +238,33 @@ trademark sign '~a' at ~d")
(string-suffix-ci? s (match:prefix m)))
'("i.e" "e.g" "a.k.a" "resp"))
r (cons (match:start m) r)))))))
- (unless (null? infractions)
- (emit-warning package
- (format #f (G_ "sentences in description should be followed ~
+ (if (null? infractions)
+ '()
+ (list
+ (make-warning package
+ (format #f (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
- (length infractions)
- infractions)
- 'description))))
+ (length infractions)
+ infractions)
+ #: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
- (format #f (G_ "invalid description: ~s") description)
- 'description))))
+ (append
+ (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)
+ (match (check-texinfo-markup description)
+ ((and warning (? lint-warning?)) (list warning))
+ (plain-description
+ (check-proper-start plain-description))))
+ (list
+ (make-warning package
+ (format #f (G_ "invalid description: ~s") 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 +305,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 +320,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
@@ -314,66 +339,71 @@ line."
(define (check-synopsis-style package)
;; 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
- (G_ "synopsis should not be empty")
- '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
- (G_ "no period allowed at the end of the synopsis")
- 'synopsis)))
+ (if (and (string-suffix? "." synopsis)
+ (not (string-suffix? "etc." synopsis)))
+ (list
+ (make-warning package
+ (G_ "no period allowed at the end of the synopsis")
+ #:field 'synopsis))
+ '()))
(define check-start-article
;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
;; <http://lists.gnu.org/archive/html/bug-womb/2014-11/msg00000.html>.
(if (false-if-exception (gnu-package? package))
- (const #t)
+ (const '())
(lambda (synopsis)
- (when (or (string-prefix-ci? "A " synopsis)
- (string-prefix-ci? "An " synopsis))
- (emit-warning package
- (G_ "no article allowed at the beginning of \
+ (if (or (string-prefix-ci? "A " synopsis)
+ (string-prefix-ci? "An " synopsis))
+ (list
+ (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
- (G_ "synopsis should be less than 80 characters long")
- 'synopsis)))
+ (if (>= (string-length synopsis) 80)
+ (list
+ (make-warning package
+ (G_ "synopsis should be less than 80 characters long")
+ #:field 'synopsis))
+ '()))
(define (check-proper-start synopsis)
- (unless (properly-starts-sentence? synopsis)
- (emit-warning package
- (G_ "synopsis should start with an upper-case letter or digit")
- 'synopsis)))
+ (if (properly-starts-sentence? synopsis)
+ '()
+ (list
+ (make-warning package
+ (G_ "synopsis should start with an upper-case letter or digit")
+ #:field 'synopsis))))
(define (check-start-with-package-name synopsis)
- (when (and (regexp-exec (package-name-regexp package) synopsis)
+ (if (and (regexp-exec (package-name-regexp package) synopsis)
(not (starts-with-abbreviation? synopsis)))
- (emit-warning package
- (G_ "synopsis should not start with the package name")
- 'synopsis)))
+ (list
+ (make-warning package
+ (G_ "synopsis should not start with the package name")
+ #:field 'synopsis))
+ '()))
(define (check-texinfo-markup synopsis)
"Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
(catch #t
- (lambda () (texi->plain-text synopsis))
+ (lambda ()
+ (texi->plain-text synopsis)
+ '())
(lambda (keys . args)
- (emit-warning package
- (G_ "Texinfo markup in synopsis is invalid")
- 'synopsis)
- #f)))
+ (list
+ (make-warning package
+ (G_ "Texinfo markup in synopsis is invalid")
+ #:field 'synopsis)))))
(define checks
- (list check-not-empty
- check-proper-start
+ (list check-proper-start
check-final-period
check-start-article
check-start-with-package-name
@@ -381,13 +411,20 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
check-texinfo-markup))
(match (package-synopsis package)
+ (""
+ (list
+ (make-warning package
+ (G_ "synopsis should not be empty")
+ #:field 'synopsis)))
((? string? synopsis)
- (for-each (lambda (proc)
- (proc synopsis))
- checks))
+ (append-map
+ (lambda (proc)
+ (proc synopsis))
+ checks))
(invalid
- (emit-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
- 'synopsis))))
+ (list
+ (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
@@ -489,8 +526,8 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed."
'tls-certificate-error args))))
(define (validate-uri uri package field)
- "Return #t if the given URI can be reached, otherwise return #f and emit a
-warning for PACKAGE mentionning the FIELD."
+ "Return #t if the given URI can be reached, otherwise return a warning for
+PACKAGE mentionning the FIELD."
(let-values (((status argument)
(probe-uri uri #:timeout 3))) ;wait at most 3 seconds
(case status
@@ -502,71 +539,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 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)")
This message was truncated. Download the full message here.
Christopher Baines wrote 6 years ago
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87ef4dxgvl.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (23 lines)
> Hello!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> 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.
>
> Yay!
>
>> + <lint-warning>
>
> As a rule of thumb, it’s best to not export the record type descriptor
> (RTD) because then anything could happen. In this case, I think the
> tests would be just as readable if we used ‘lint-warning-message’ &
> co. instead of matching on the record.
>
> WDYT?

Interesting. I've now adjusted the tests accordingly and sent an updated
patch.

I've stuck with using match, as this gives much better error messages
than using car, or lint-warning-message without checking the thing your
working with is actually a list with a single warning. I've wrapped this
up as a single-lint-warning-message that many of the tests use.

Toggle quote (27 lines)
>> +(define* (make-warning package message
>> + #:key field location)
>> + (make-lint-warning
>> + package
>> + message
>
> In practice MESSAGE is already translated. I think it would be more
> flexible if it were not; ‘lint-warning-message’ would always return the
> English message, and it’d be up to the user to call ‘gettext’ on it,
> like we do for package descriptions.
>
> To achieve this, you’d need a little trick so that ‘xgettext’ can still
> extract the messages, like:
>
>
> (define-syntax-rule make-warning
> (syntax-rule (G_)
> ((_ package (G_ message) rest ...)
> (%make-warning package message rest ...))))
>
> where ‘%make-warning’ is the procedure you define above.
>
> Then you need an explicit call to ‘G_’ at the point where messages are
> displayed.
>
> Does that make sense?

Yes, but I'm unsure it'll work for all the messages.

Some of them it translates a format string first, then uses that format
string, and that becomes the message, e.g.

(format #f (G_ "invalid description: ~s") description)

Given that you'd be trying to get the translation for "invalid
description: guile" for example, I'm not sure you can defer the
translation without also defering customising the message, if that makes
sense?

I haven't actually tried this yet, so I could be wrong.

Toggle quote (21 lines)
>> +(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))
>
> I always feel that we should have procedures that operate on lists of
> anything, like ‘append’, and thus ‘append-warnings’ looks like an
> anti-pattern to me.
>
> What about simply ensuring that every checker returns a list of
> <lint-warning>s? That way, we wouldn’t have to do such things, I think.

I did consider that initially, but it involved restructuring the code
even more, so I put it off. In this latest patch though, I have adjusted
it so all the checkers return lists of warnings.

Thanks for taking a look :)

Chris
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAlzyzU5fFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XfciA/+PintFk8rgFxv4dP9J8jJzehnYC7/cGNpGnfAf3JPN9uXmRRQlgPUJcvK
Q1VP4fCqZVsLRWgRkjuLMseg58GRjCs/kXHp/6UX6uzfHFc+j75O5HDRfytK/ZpN
1yDq8rRogI+53HYJquVP2e1d25pWaqihWtHMt07ZKcAISNC6Shw0/lMKntI49yp+
pOwTBwuiysZLjpM5O6Gfbc0t2Slk7VW13t/c5WQp1Cs+ZEvKMlsCo5ra/gPF/YT3
YS0KoHATV0Ng4Qf92PzOsuXCnYDiAYQZqD3H7UNpL0nC3UbP6v4jZJ1t7FyXUHOV
qfaO0XwStTa5+pdnz5W2iQPziyFVxL9JDMkpX+xSOwKrDFt1uDX0fBU/FtOapJiJ
eIIrDdsHt66i3Ozz111OnLq7pPpeDcdKbW3E+hL9/WJ/OK/JxleXIx/ZEq32eECT
DXEzg/HGZeD/ipCmFId5L58NnTxCwqy/fnrOl5pHmwixKA9HkuOis82ILJgdRACu
Jd8TGxnyocJdQ6PqGX9nD9XHA7ecTJqN+wc5ujmA8FMJDN74pkasXqgzNEj3yAkg
Lc3fobbL7qMYNMn+WKi/MqFlp5jlzukUHJtnc2V7GSX9NkpjuUG6FOiSnqD1ZB1Q
Cn+nDVY6j/+aJpmE0XfiuArkqaNpWsUYTFmhvWUIlPz+XOXj51s=
=j76C
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87pnnpj15u.fsf@gnu.org
Hello,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (2 lines)
> Ludovic Courtès <ludo@gnu.org> writes:

[...]

Toggle quote (39 lines)
>>> +(define* (make-warning package message
>>> + #:key field location)
>>> + (make-lint-warning
>>> + package
>>> + message
>>
>> In practice MESSAGE is already translated. I think it would be more
>> flexible if it were not; ‘lint-warning-message’ would always return the
>> English message, and it’d be up to the user to call ‘gettext’ on it,
>> like we do for package descriptions.
>>
>> To achieve this, you’d need a little trick so that ‘xgettext’ can still
>> extract the messages, like:
>>
>>
>> (define-syntax-rule make-warning
>> (syntax-rule (G_)
>> ((_ package (G_ message) rest ...)
>> (%make-warning package message rest ...))))
>>
>> where ‘%make-warning’ is the procedure you define above.
>>
>> Then you need an explicit call to ‘G_’ at the point where messages are
>> displayed.
>>
>> Does that make sense?
>
> Yes, but I'm unsure it'll work for all the messages.
>
> Some of them it translates a format string first, then uses that format
> string, and that becomes the message, e.g.
>
> (format #f (G_ "invalid description: ~s") description)
>
> Given that you'd be trying to get the translation for "invalid
> description: guile" for example, I'm not sure you can defer the
> translation without also defering customising the message, if that makes
> sense?

Good point!

A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
a single string:

(make-warning package (list (G_ "~a is bad") 'something) …)

That’d solve the problem but it’d have to be packaged nicely to avoid
having too much boilerplate.

WDYT?

Thanks,
Ludo’.
Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87ftolj0v2.fsf@gnu.org
Hello,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (8 lines)
> 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.

I like it!

Maybe we should just ignore the i18n issue for now and keep
already-translated messages in <lint-warning>.

One question I have: before, warnings would be emitted as we go; now, we
first collect all the warnings for a given package, and emit all of them
at once. How does it look in terms of UX?

Perhaps an improvement would be to use SRFI-41 streams instead of lists
to address this issue, but… future work. :-)

WDYT?

Ludo’.
Christopher Baines wrote 6 years ago
[PATCH] scripts: lint: Separate the message warning text and data.
(address . 35790@debbugs.gnu.org)
20190616125608.15690-1-mail@cbaines.net
So that translations can be handled more flexibly, rather than having to
translate the message text within the checker.
---
guix/scripts/lint.scm | 194 ++++++++++++++++++++++--------------------
1 file changed, 104 insertions(+), 90 deletions(-)

Toggle diff (418 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 1b08068669..d1919d8e0a 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -88,6 +88,8 @@
lint-warning?
lint-warning-package
lint-warning-message
+ lint-warning-message-text
+ lint-warning-message-data
lint-warning-location
%checkers
@@ -105,35 +107,51 @@
(define-record-type* <lint-warning>
lint-warning make-lint-warning
lint-warning?
- (package lint-warning-package)
- (message lint-warning-message)
- (location lint-warning-location
- (default #f)))
+ (package lint-warning-package)
+ (message-text lint-warning-message-text)
+ (message-data lint-warning-message-data
+ (default '()))
+ (location lint-warning-location
+ (default #f)))
+
+(define (lint-warning-message warning)
+ (apply format #f
+ (G_ (lint-warning-message-text warning))
+ (lint-warning-message-data warning)))
(define (package-file package)
(location-file
(package-location package)))
-(define* (make-warning package message
- #:key field location)
+(define* (%make-warning package message-text
+ #:optional (message-data '())
+ #:key field location)
(make-lint-warning
package
- message
+ message-text
+ message-data
(or location
(package-field-location package field)
(package-location package))))
+(define-syntax make-warning
+ (syntax-rules (G_)
+ ((_ package (G_ message) rest ...)
+ (%make-warning package message rest ...))
+ ((_ package message rest ...)
+ (%make-warning package message rest ...))))
+
(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.
(for-each
(match-lambda
- (($ <lint-warning> package message loc)
+ (($ <lint-warning> package message-text message-data loc)
(format (guix-warning-port) "~a: ~a@~a: ~a~%"
(location->string loc)
(package-name package) (package-version package)
- message)))
+ (apply format #f (G_ message-text) message-data))))
warnings))
@@ -199,9 +217,9 @@ http://www.gnu.org/prep/standards/html_node/Trademarks.html."
((and (? number?) index)
(list
(make-warning package
- (format #f (G_ "description should not contain ~
+ (G_ "description should not contain ~
trademark sign '~a' at ~d")
- (string-ref description index) index)
+ (list (string-ref description index) index)
#:field 'description)))
(else '())))
@@ -242,10 +260,10 @@ trademark sign '~a' at ~d")
'()
(list
(make-warning package
- (format #f (G_ "sentences in description should be followed ~
+ (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
- (length infractions)
- infractions)
+ (list (length infractions)
+ infractions)
#:field 'description)))))
(let ((description (package-description package)))
@@ -263,7 +281,8 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
(check-proper-start plain-description))))
(list
(make-warning package
- (format #f (G_ "invalid description: ~s") description)
+ (G_ "invalid description: ~s")
+ (list description)
#:field 'description)))))
(define (package-input-intersection inputs-to-check input-names)
@@ -308,8 +327,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(map (lambda (input)
(make-warning
package
- (format #f (G_ "'~a' should probably be a native input")
- input)
+ (G_ "'~a' should probably be a native input")
+ (list input)
#:field 'inputs))
(package-input-intersection inputs input-names))))
@@ -323,9 +342,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(map (lambda (input)
(make-warning
package
- (format #f
- (G_ "'~a' should probably not be an input at all")
- input)
+ (G_ "'~a' should probably not be an input at all")
+ (list input)
#:field 'inputs))
(package-input-intersection (package-direct-inputs package)
input-names))))
@@ -423,7 +441,9 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
checks))
(invalid
(list
- (make-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
+ (make-warning package
+ (G_ "invalid synopsis: ~s")
+ (list invalid)
#:field 'synopsis)))))
(define* (probe-uri uri #:key timeout)
@@ -540,64 +560,59 @@ PACKAGE mentionning the FIELD."
;; such malicious behavior.
(or (> length 1000)
(make-warning package
- (format #f
- (G_ "URI ~a returned \
+ (G_ "URI ~a returned \
suspiciously small file (~a bytes)")
- (uri->string uri)
- length)
+ (list (uri->string uri)
+ length)
#:field field)))
(_ #t)))
((= 301 (response-code argument))
(if (response-location argument)
(make-warning package
- (format #f (G_ "permanent redirect from ~a to ~a")
- (uri->string uri)
- (uri->string
- (response-location argument)))
+ (G_ "permanent redirect from ~a to ~a")
+ (list (uri->string uri)
+ (uri->string
+ (response-location argument)))
#:field field)
(make-warning package
- (format #f (G_ "invalid permanent redirect \
+ (G_ "invalid permanent redirect \
from ~a")
- (uri->string uri))
+ (list (uri->string uri))
#:field field)))
(else
(make-warning package
- (format #f
- (G_ "URI ~a not reachable: ~a (~s)")
- (uri->string uri)
- (response-code argument)
- (response-reason-phrase argument))
+ (G_ "URI ~a not reachable: ~a (~s)")
+ (list (uri->string uri)
+ (response-code argument)
+ (response-reason-phrase argument))
#:field field))))
((ftp-response)
(match argument
(('ok) #t)
(('error port command code message)
(make-warning package
- (format #f
- (G_ "URI ~a not reachable: ~a (~s)")
- (uri->string uri)
- code (string-trim-both message))
+ (G_ "URI ~a not reachable: ~a (~s)")
+ (list (uri->string uri)
+ code (string-trim-both message))
#:field field))))
((getaddrinfo-error)
(make-warning package
- (format #f
- (G_ "URI ~a domain not found: ~a")
- (uri->string uri)
- (gai-strerror (car argument)))
+ (G_ "URI ~a domain not found: ~a")
+ (list (uri->string uri)
+ (gai-strerror (car argument)))
#:field field))
((system-error)
(make-warning package
- (format #f
- (G_ "URI ~a unreachable: ~a")
- (uri->string uri)
- (strerror
- (system-error-errno
- (cons status argument))))
+ (G_ "URI ~a unreachable: ~a")
+ (list (uri->string uri)
+ (strerror
+ (system-error-errno
+ (cons status argument))))
#:field field))
((tls-certificate-error)
(make-warning package
- (format #f (G_ "TLS certificate error: ~a")
- (tls-certificate-error-string argument))
+ (G_ "TLS certificate error: ~a")
+ (list (tls-certificate-error-string argument))
#:field field))
((invalid-http-response gnutls-error)
;; Probably a misbehaving server; ignore.
@@ -627,8 +642,9 @@ from ~a")
#:field 'home-page))))
(else
(list
- (make-warning package (format #f (G_ "invalid home page URL: ~s")
- (package-home-page package))
+ (make-warning package
+ (G_ "invalid home page URL: ~s")
+ (list (package-home-page package))
#:field 'home-page))))))
(define %distro-directory
@@ -674,8 +690,8 @@ patch could not be found."
max)
(make-warning
package
- (format #f (G_ "~a: file name is too long")
- (basename patch))
+ (G_ "~a: file name is too long")
+ (list (basename patch))
#:field 'patch-file-names)
#f))
(_ #f))
@@ -716,8 +732,8 @@ descriptions maintained upstream."
(not (string=? upstream downstream))))
(list
(make-warning package
- (format #f (G_ "proposed synopsis: ~s~%")
- upstream)
+ (G_ "proposed synopsis: ~s~%")
+ (list upstream)
#:field 'synopsis))
'()))
@@ -730,9 +746,8 @@ descriptions maintained upstream."
(list
(make-warning
package
- (format #f
- (G_ "proposed description:~% \"~a\"~%")
- (fill-paragraph (escape-quotes upstream) 77 7))
+ (G_ "proposed description:~% \"~a\"~%")
+ (list (fill-paragraph (escape-quotes upstream) 77 7))
#:field 'description))
'()))))))
@@ -831,10 +846,10 @@ descriptions maintained upstream."
(loop rest))
(prefix
(make-warning package
- (format #f (G_ "URL should be \
+ (G_ "URL should be \
'mirror://~a/~a'")
- mirror-id
- (string-drop uri (string-length prefix)))
+ (list mirror-id
+ (string-drop uri (string-length prefix)))
#:field 'source)))))))
(let ((origin (package-source package)))
@@ -876,7 +891,8 @@ descriptions maintained upstream."
#f
(make-warning
package
- (format #f (G_ "URL should be '~a'") github-uri)
+ (G_ "URL should be '~a'")
+ (list github-uri)
#:field 'source)))))
(origin-uris origin))
'())))
@@ -888,14 +904,14 @@ descriptions maintained upstream."
(lambda ()
(guard (c ((store-protocol-error? c)
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~a")
- system
- (store-protocol-error-message c))))
+ (G_ "failed to create ~a derivation: ~a")
+ (list system
+ (store-protocol-error-message c))))
((message-condition? c)
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~a")
- system
- (condition-message c)))))
+ (G_ "failed to create ~a derivation: ~a")
+ (list system
+ (condition-message c)))))
(with-store store
;; Disable grafts since it can entail rebuilds.
(parameterize ((%graft? #f))
@@ -910,8 +926,8 @@ descriptions maintained upstream."
#:graft? #f)))))))
(lambda args
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~s")
- system args)))))
+ (G_ "failed to create ~a derivation: ~s")
+ (list system args)))))
(filter lint-warning?
(map try (package-supported-systems package))))
@@ -1001,15 +1017,15 @@ the NIST server non-fatal."
(list
(make-warning
package
- (format #f (G_ "probably vulnerable to ~a")
- (string-join (map vulnerability-id unpatched)
- ", "))))))))))
+ (G_ "probably vulnerable to ~a")
+ (list (string-join (map vulnerability-id unpatched)
+ ", "))))))))))
(define (check-for-updates package)
"Check if there is an update available for PACKAGE."
(match (with-networking-fail-safe
- (format #f (G_ "while retrieving upstream info for '~a'")
- (package-name package))
+ (G_ "while retrieving upstream info for '~a'")
+ (list (package-name package))
#f
(package-latest-release* package (force %updaters)))
((? upstream-source? source)
@@ -1017,8 +1033,8 @@ the NIST server non-fatal."
(package-version package))
(list
(make-warning package
- (format #f (G_ "can be upgraded to ~a")
- (upstream-source-version source))
+ (G_ "can be upgraded to ~a")
+ (list (upstream-source-version source))
#:field 'version))
'()))
(#f '()))) ; cannot find newer upstream release
@@ -1034,8 +1050,8 @@ the NIST server non-fatal."
(#f #t)
(index
(make-warning package
- (format #f (G_ "tabulation on line ~a, column ~a")
- line-number index)
+ (G_ "tabulation on line ~a, column ~a")
+ (list line-number index)
#:location
(location (package-file package)
line-number
@@ -1046,9 +1062,8 @@ the NIST server non-fatal."
(unless (or (string=? line (string-trim-right line))
(string=? line (string #\page)))
(make-warning package
- (format #f
- (G_ "trailing white space on line ~a")
- line-number)
+ (G_ "trailing white space on line ~a")
+ (list line-number)
#:location
(location (package-file package)
line-number
@@ -1061,8 +1076,8 @@ the NIST server non-fatal."
;; much noise.
(when (> (string-length line) 90)
(make-warning package
- (format #f (G_ "line ~a is way too long (~a characters)")
- line-number (string-length line))
+ (G_ "line ~a is way too long (~a characters)")
+ (list line-number (string-length line))
#:location
(location (package-file package)
line-number
@@ -1075,10 +1090,9 @@ the NIST server non-fatal."
"Emit a warning if LINE contains hanging parentheses."
(when (regexp-exec %hanging-paren-rx line)
(make-warning package
- (format #f
- (G_ "parentheses feel lonely, \
+ (G_ "parentheses feel lonely, \
move to the previous or next line")
- line-number)
+ (list line-number)
#:location
(location (package-file package)
line-number
--
2.21.0
Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH] scripts: lint: Handle warnings with a record type.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87imt5u1lr.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (17 lines)
> Hello,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> 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.
>
> I like it!
>
> Maybe we should just ignore the i18n issue for now and keep
> already-translated messages in <lint-warning>.

I want the Guix Data Service to support internationalisation at some
point, so I've had a go at doing this. I'll say more in reply to your
other email.

Toggle quote (4 lines)
> One question I have: before, warnings would be emitted as we go; now, we
> first collect all the warnings for a given package, and emit all of them
> at once. How does it look in terms of UX?

Not quite, warnings are emitted once returned from each checker for each
package. The display will only be delayed if a checker takes a long time
to return the warnings, which I don't think happens (or at least happens
much).
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0GPWBfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XdENBAAhWupmqSN5YSvpDqC9pcasK935jX60J7uUgWx1qiMVvti1viiD54bhHDP
UwsDTfWDL1TYHPZzpoCMoCn0GZXWDR7fD5KclU4e7FlRgwxfsR7TKLc58i0LRYV4
Cxpf5+Jof5kNIiJTI1wHpK5s+aj1ZBzqj4G8PMbYAt8QM/f6BwCqCu3WSvOSsunm
nHvhrIz7S5J1rvNKyGeyVZL24aogr3cmNFLyZLJCuvC8PsPyv7B6PCqB6aroA9cY
Jjfppffz06PfMgoudZI+c8UDRm2X8kGtu5f6dgq5KQCkwjeouaFEGNi+fjCXP6u4
YYVNwUQDuVEx4Rtve+uZGXa5rZqJEL5B9N+7pCClBN9yixBRf11zqV+7VzZDoby2
FqQSFMoQVlBeXtsP7C/vjXstPPNH1yXMyoLSeH2Gnp/4juLttP4crszQFl/DUjjy
VDnur6f3K4sM+QhUjciuG3pZ2SRRUXDGTpy7KWcYZVLjG2AgeX2Y7sGBmGKpWYPd
KozFfFr0zANCELfwOYOwu/Ig6ItZMvPY0SobmnTEsJ2bPegw9kKDU+zyHK0IlpEG
lRSfZSqxq/rWiqLra02v3utGi22GqDszT3ELe2JhrdJgsMrpR+AdqR+uLsgtI6sx
MLkbsHdhUFsZlErFTMfvhfuiuSJSKS2XIWmUWjK8q07DBk4lyq0=
=cG/F
-----END PGP SIGNATURE-----

Christopher Baines wrote 6 years ago
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87h88pu1cc.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (8 lines)
> A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
> a single string:
>
> (make-warning package (list (G_ "~a is bad") 'something) …)
>
> That’d solve the problem but it’d have to be packaged nicely to avoid
> having too much boilerplate.

I've now made an attempt at doing this, I've kept the changes separate
for now, and I've sent them as a separate patch.

I'm not sure I've got it working yet though. I've been testing with the
zile package, as there's a lint warning for the synopsis, however, if I
try to set the language to Spanish, it isn't translated.

I've also tried checking the existing behaviour, but that doesn't seem
to work either:

→ LC_MESSAGES=es_ES LANGUAGE=es_ES LC_ALL=es_ES ./pre-inst-env guile
...
scheme@(guile-user)> (use-modules (guix i18n))
scheme@(guile-user)> (G_ "~a: ~a: proposed synopsis: ~s~%")
$1 = "~a: ~a: proposed synopsis: ~s~%"

Many of the translated strings won't match up with the code now as I've
changed them. I did try changing the Spanish translation for this
proposed synopsis message to match the code, but it didn't seem to work.

Any ideas on what's going on here?

Chris
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0GPrNfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9Xd+bhAAgQZAlj6XXyExZ03f+o+YxD00xnELzUBXTGXn9b+n/JdSJZ5UAcJaRqUK
8ciPIv0mzRbFKYiWRgM1vdSQo/4f9+YDhbRJOBbEApUs69HQfegqYE2Dv6TfZKiF
fAYq3COzwaeYUZL0DQu6yz4+Kyq7ANMTomMtoyfoFMacMy2TEpV+eN3JvlPgj/YV
0nyzsCxxBnw20fx4L9DCV4IOaMA4wqBJmBwRahwWw9WOdpDlhIRUc3AydZxx2nzi
s/UMlGuuov1WVLZ2fa3VJv5rE3hSguZxf8yUJypPMzsd37EUIhe0vpxVVc/Hl4qV
8231QwoRo9nuyTI2FPtIM+D6pu2RH+R3ZQUGhjqQD0mxCig5dMp46ZOf2xZQdDlC
ovI115duhAjZQ3OGEkkQFqbEF8GqDdMl03UfX4jQ8Ky9/hb7jCJRboxq0n/zD7ua
ygtyKxioyxkEaEf+r8x9PuQjJa+2UoXpnpVO/dCZCMzkFO3xU74SLthwJ30XGdqZ
GQMZDtYLP/oh6Bl6vvWN5qzRtMTS+eGD6vfUuQmSJQwUhqMcT2cD+bw5KvUScR0S
EycnKQuWrV44eu4FYA3rAyGaZK3Tsp5QCU9a68lDz1f8AjEaL4p1OHzd5+BCM8Cx
5Sq1dAqM8AyKakQ3Xvb0Omh4fafHcLdU5u+gixTgRUyBqq8ueM4=
=v687
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87ef3olc21.fsf@gnu.org
Hi!

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (2 lines)
> Ludovic Courtès <ludo@gnu.org> writes:

[...]

Toggle quote (9 lines)
>> One question I have: before, warnings would be emitted as we go; now, we
>> first collect all the warnings for a given package, and emit all of them
>> at once. How does it look in terms of UX?
>
> Not quite, warnings are emitted once returned from each checker for each
> package. The display will only be delayed if a checker takes a long time
> to return the warnings, which I don't think happens (or at least happens
> much).

True, so that shouldn’t be much of an issue I guess.

Ludo’.
Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
875zp0lbmx.fsf@gnu.org
Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (13 lines)
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
>> a single string:
>>
>> (make-warning package (list (G_ "~a is bad") 'something) …)
>>
>> That’d solve the problem but it’d have to be packaged nicely to avoid
>> having too much boilerplate.
>
> I've now made an attempt at doing this, I've kept the changes separate
> for now, and I've sent them as a separate patch.

Nice!

Toggle quote (19 lines)
> I'm not sure I've got it working yet though. I've been testing with the
> zile package, as there's a lint warning for the synopsis, however, if I
> try to set the language to Spanish, it isn't translated.
>
> I've also tried checking the existing behaviour, but that doesn't seem
> to work either:
>
> → LC_MESSAGES=es_ES LANGUAGE=es_ES LC_ALL=es_ES ./pre-inst-env guile
> ...
> scheme@(guile-user)> (use-modules (guix i18n))
> scheme@(guile-user)> (G_ "~a: ~a: proposed synopsis: ~s~%")
> $1 = "~a: ~a: proposed synopsis: ~s~%"
>
> Many of the translated strings won't match up with the code now as I've
> changed them. I did try changing the Spanish translation for this
> proposed synopsis message to match the code, but it didn't seem to work.
>
> Any ideas on what's going on here?

You need to tell libc (gettext) where to look for message catalogs.
This is normally done in scripts/guix:

(bindtextdomain "guix" "@localedir@")

For testing purposes, you can probably do:

(bindtextdomain "guix"
"/run/current-system/profile/share/locale")

HTH!

Ludo’.
Christopher Baines wrote 6 years ago
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
875zovmqey.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (46 lines)
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
>>> a single string:
>>>
>>> (make-warning package (list (G_ "~a is bad") 'something) …)
>>>
>>> That’d solve the problem but it’d have to be packaged nicely to avoid
>>> having too much boilerplate.
>>
>> I've now made an attempt at doing this, I've kept the changes separate
>> for now, and I've sent them as a separate patch.
>
> Nice!
>
>> I'm not sure I've got it working yet though. I've been testing with the
>> zile package, as there's a lint warning for the synopsis, however, if I
>> try to set the language to Spanish, it isn't translated.
>>
>> I've also tried checking the existing behaviour, but that doesn't seem
>> to work either:
>>
>> → LC_MESSAGES=es_ES LANGUAGE=es_ES LC_ALL=es_ES ./pre-inst-env guile
>> ...
>> scheme@(guile-user)> (use-modules (guix i18n))
>> scheme@(guile-user)> (G_ "~a: ~a: proposed synopsis: ~s~%")
>> $1 = "~a: ~a: proposed synopsis: ~s~%"
>>
>> Many of the translated strings won't match up with the code now as I've
>> changed them. I did try changing the Spanish translation for this
>> proposed synopsis message to match the code, but it didn't seem to work.
>>
>> Any ideas on what's going on here?
>
> You need to tell libc (gettext) where to look for message catalogs.
> This is normally done in scripts/guix:
>
> (bindtextdomain "guix" "@localedir@")
>
> For testing purposes, you can probably do:
>
> (bindtextdomain "guix"
> "/run/current-system/profile/share/locale")

Thanks, so if I set the bindtextdomain, things do indeed work
better. So, regarding these two patches, I've got the following things
on my mind...

- As they change so many things, I'm not sure what to add for the GNU
changelog at the end of the commit message?

- Is it OK to break some of the translations, or should I fix some of
those as well?

- I'm thinking of the "proposed synopsis" related check specifically,
as I've changed what goes in to the translated string.

- How ready are these patches to merge? I don't know of any problems
with them, but I am making lots of changes.

Thanks,

Chris
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0QccVfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9Xd5OBAApQXAuitR8T/8zKm9evTcyjAPzO60yr9Fo+wgpgdqzhsAo4lP5nt1NWei
hssuxDsLqRLnZ/N6CQrx6W9C+fT4tiuI2tkNWoCAECHaQZtmT4o5pwhUcK9G+sVc
/gj5TVECEB7+5UTG4/hmur56hJdGLUkhRRvMcOzleOyTKDRWe1/sdm2saEH0qGSr
aEZw8Qg2ykGPx8NXC7jJphGD3+R3ddJlj7M2v/kAvGEIs2WReD/IAhgVOeXYJkqD
zKOcfM9bi1Lf9CVZ5nX2pyxdi0BOKrS/SB2X1BAb7qmo8Q41561+JLD74qSbKGNw
iZS8E5Fx7yMR2sVqoS8Vto2ooBJ6IFTy42DSno0yTjIxTIAtmeHQcy0NJqXsmrcc
8UMK0Vu/iM8yY2y3e4X431TgNHGpWiy3O4A1a+P6fuBtEUuIfYwsaEm71yNy/4c5
cuGU5HxxmyActmnLO/5TBpUnnlh3+33jIBjjxP57aky+TKlsHeywuRku1gneJzFw
LnMjvBqkBGI2UpICT6n94oODmk/M5q37CbLCHXG1mfDzmfg32fzpUkenrLgIlhjo
b2779RjeOGe8Ogqt8FRsvj/19L0tV7cwtxnFqE/50Mab6xS36XSSBGcmTKZpKsDt
ASZkElBxAflNaVGKf9N7+7W1peulSbCAkFM6eNz00jh/vfdetd0=
=guy+
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
874l4fe622.fsf@gnu.org
Hi! :-)

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (6 lines)
> - Is it OK to break some of the translations, or should I fix some of
> those as well?
>
> - I'm thinking of the "proposed synopsis" related check specifically,
> as I've changed what goes in to the translated string.

It’s OK to change strings sometimes, but this has to be done
thoughtfully as it entails more translation work and a time window
during which translations aren’t up-to-date and everyone sees the
English string.

Let me look at the other issues…

Ludo’.
Ludovic Courtès wrote 6 years ago
Re: [bug#35790] [PATCH] scripts: lint: Separate the message warning text and data.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87y31rcrc4.fsf@gnu.org
Hello,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (7 lines)
> +(define-syntax make-warning
> + (syntax-rules (G_)
> + ((_ package (G_ message) rest ...)
> + (%make-warning package message rest ...))
> + ((_ package message rest ...)
> + (%make-warning package message rest ...))))

I think you can remove the second clause: that will ensure we never
forget to add a G_ around messages.

Otherwise LGTM!

Ludo’.
Ludovic Courtès wrote 6 years ago
Re: [bug#35790] [PATCH] scripts: lint: Handle warnings with a record type.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87pnn3cr7f.fsf@gnu.org
Hi Chris,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (7 lines)
> Thanks, so if I set the bindtextdomain, things do indeed work
> better. So, regarding these two patches, I've got the following things
> on my mind...
>
> - As they change so many things, I'm not sure what to add for the GNU
> changelog at the end of the commit message?

I think you should try to write the commit log the usual way, by
listing every changed entity. It’s a bit tedious, but it’s also a good
way to review everything (and Magit makes it relatively easy.)

Now, don’t lose your hair on it, it’s not the most important part of the
patch. :-)

Toggle quote (6 lines)
> - Is it OK to break some of the translations, or should I fix some of
> those as well?
>
> - I'm thinking of the "proposed synopsis" related check specifically,
> as I've changed what goes in to the translated string.

Actually I didn’t see the change you’re referring to, but maybe it
doesn’t matter much.

Toggle quote (3 lines)
> - How ready are these patches to merge? I don't know of any problems
> with them, but I am making lots of changes.

I think it’s ready.

Thanks, and sorry for the delays!

Ludo’.
Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH] scripts: lint: Separate the message warning text and data.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87zhm0lqx7.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (14 lines)
> Hello,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> +(define-syntax make-warning
>> + (syntax-rules (G_)
>> + ((_ package (G_ message) rest ...)
>> + (%make-warning package message rest ...))
>> + ((_ package message rest ...)
>> + (%make-warning package message rest ...))))
>
> I think you can remove the second clause: that will ensure we never
> forget to add a G_ around messages.

Sure, there was one case where this clause was used, but I've switched
that to call %make-warning directly, and added a comment:

(define (check-patch-file-names package)
"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'
(list
;; Use %make-warning, as condition-mesasge is already
;; translated.
(%make-warning package (condition-message c)
#:field 'patch-file-names))))
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0XJXRfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XcoChAApuf5+XXBmKcei2GU/0tBeOfXG65WBSCaqptVHYcBk9684JuP1c+6BnGd
IvYnOC7q4gRmeF9mdzqcFxQpKtI5STb5qLrMePiQtHYKLi73kuLo62R06f9yOD4D
nVriXywOSfQ2GDwaIRYH+J6fPgiGQYKSz0MrBPmorcEKYO/B2kASV246p7mXPBLI
tZz5HwTX7RTziX5cH8mgs6VaAOR12YombJneZUuWzbBKeUT0HYWcYp0xqOPpMaqc
wU6t7X+Jvnp7aFNdjxGoRely+pLM59uH5xfPO+QKBKawoR97HL8AHUZR7c0JFkD2
bhKR64TGEWAGBTiyaXpXdUH/YEBY9tDEOXmCtksER+cZ3g24N9/UoHPh8KIGrE8x
ZLAoCRoZp6ItXyqpmAg6hMiEDzGc1Dv2TXIy0VQXJo6a+VgUvR+bb1o9B9c5Krv9
BUxiTCxHNlQo3P0f7vbIWgS6H7iRG4oGMMsO0NVGZOQoHGsTy4WIjO9YOm/VRKww
59EHMxMh9WanaXkNxeJmxvrj5/SIZ87n/naAJj78TDqSeGmZd2Unh0YOcy9MnQg3
ONs0Xl6k47Jvo2G86z/GAfFHrPnC53t1ZvFUhhQDQ9/iMQHa28BmoEU2RjN54mVt
mxuZ+pl/aWpXj4bke162wW3Tk3lR31LpKEQZyHvvTOGfQxQrOJc=
=VSre
-----END PGP SIGNATURE-----

Christopher Baines wrote 6 years ago
[PATCH 1/2] scripts: lint: Handle warnings with a record type.
(address . 35790@debbugs.gnu.org)
20190629112552.8261-1-mail@cbaines.net
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 (<lint-warning>): New record type.
(lint-warning): New macro.
(lint-warning?, lint-warning-package, lint-warning-message,
lint-warning-location, package-file, make-warning): New procedures.
(call-with-accumulated-warnings, with-accumulated-warnings): Remove.
(emit-warning): Rename to emit-warnings, and switch to displaying multiple
warnings.
(check-description-style)[check-not-empty-description, check-texinfo-markup,
check-trademarks, check-quotes, check-proper-start,
check-end-of-sentence-space]: Switch to generating a list of warnings, and
using make-warning, rather than emit-warning.
(check-inputs-should-be-native, check-inputs-should-not-be-an-input-at-all):
Switch to generating a list of warnings, and using make-warning, rather than
emit-warning.
(check-synopsis): Switch to generating a list of warnings, and using
make-warning, rather than emit-warning.
[check-not-empty]: Remove, this is handled in the match clause
to avoid other warnings being emitted.
[check-final-period, check-start-article, check-synopsis-length,
check-proper-start, check-start-with-package-name, check-texinfo-markup]:
Switch to generating a list of warnings, and using make-warning, rather than
emit-warning.
[checks]: Remove check-not-empty.
(validate-uri, check-home-page, check-patch-file-names,
check-gnu-synopsis+description): Switch to generating a list of warnings, and
using make-warning, rather than emit-warning.
(check-source): Switch to generating a list of warnings, and using
make-warning, rather than emit-warning.
[try-uris]: Remove.
[warnings-for-uris]: New procedure, replacing try-uris.
(check-source-file-name, check-source-unstable-tarball, check-mirror-url,
check-github-url, check-derivation, check-vulnerabilities, check-for-updates,
report-tabulations, report-trailing-white-space, report-long-line,
report-lone-parentheses, report-formatting-issues, check-formatting): Switch
to generating a list of warnings, and using make-warning, rather than
emit-warning.
(run-checkers): Call emit-warnings on the warnings returned from the checker.
* tests/lint.scm (string-match-or-error, single-lint-warning-message): New
procedures.
(call-with-warnings, with-warnings): Remove.
("description: not a string", "description: not empty", "description: invalid
Texinfo markup", "description: does not start with an upper-case letter",
"description: may start with a digit", "description: may start with lower-case
package name", "description: two spaces after end of sentence", "description:
end-of-sentence detection with abbreviations", "description: may not contain
trademark signs: ™", "description: may not contain trademark signs: ®",
"description: suggest ornament instead of quotes", "synopsis: not a string",
"synopsis: not empty", "synopsis: valid Texinfo markup", "synopsis: does not
start with an upper-case letter", "synopsis: may start with a digit",
"synopsis: ends with a period", "synopsis: ends with 'etc.'", "synopsis:
starts with 'A'", "synopsis: starts with 'a'", "synopsis: starts with 'an'",
"synopsis: too long", "synopsis: start with package name", "synopsis: start
with package name prefix", "synopsis: start with abbreviation", "inputs:
pkg-config is probably a native input", "inputs: glib:bin is probably a native
input", "inputs: python-setuptools should not be an input at all (input)",
"inputs: python-setuptools should not be an input at all (native-input)",
"inputs: python-setuptools should not be an input at all (propagated-input)",
"patches: file names", "patches: file name too long", "patches: not found",
"derivation: invalid arguments", "license: invalid license", "home-page: wrong
home-page", "home-page: invalid URI", "home-page: host not found", "home-page:
Connection refused", "home-page: 200", "home-page: 200 but short length",
"home-page: 404", "home-page: 301, invalid", "home-page: 301 -> 200",
"home-page: 301 -> 404", "source-file-name", "source-file-name: v prefix",
"source-file-name: bad checkout", "source-file-name: good checkout",
"source-file-name: valid", "source-unstable-tarball",
"source-unstable-tarball: source #f", "source-unstable-tarball: valid",
"source-unstable-tarball: package named archive", "source-unstable-tarball:
not-github", "source-unstable-tarball: git-fetch", "source: 200", "source: 200
but short length", "source: 404", "source: 301 -> 200", "source: 301 -> 404",
"mirror-url", "mirror-url: one suggestion", "github-url", "github-url: one
suggestion", "github-url: already the correct github url", "cve", "cve: one
vulnerability", "cve: one patched vulnerability", "cve: known safe from
vulnerability", "cve: vulnerability fixed in replacement version", "cve:
patched vulnerability in replacement", "formatting: lonely parentheses",
"formatting: alright"): Change test-assert to test-equal, and adjust to work
with the changes above.
("formatting: tabulation", "formatting: trailing white space", "formatting:
long line"): Use string-match-or-error rather than string-contains.
---
guix/scripts/lint.scm | 757 +++++++++++----------
tests/lint.scm | 1453 +++++++++++++++++++----------------------
2 files changed, 1102 insertions(+), 1108 deletions(-)

Toggle diff (366 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index dc338a1d7b..1b08068669 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -84,6 +84,12 @@
check-formatting
run-checkers
+ lint-warning
+ lint-warning?
+ lint-warning-package
+ lint-warning-message
+ lint-warning-location
+
%checkers
lint-checker
lint-checker?
@@ -93,42 +99,48 @@
;;;
-;;; 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-location
+ (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)))
+ warnings))
;;;
;;; Checkers
;;;
+
(define-record-type* <lint-checker>
lint-checker make-lint-checker
lint-checker?
@@ -163,10 +175,12 @@ monad."
(define (check-description-style package)
;; 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
- (G_ "description should not be empty")
- 'description)))
+ (if (string-null? description)
+ (list
+ (make-warning package
+ (G_ "description should not be empty")
+ #:field 'description))
+ '()))
(define (check-texinfo-markup description)
"Check that DESCRIPTION can be parsed as a Texinfo fragment. If the
@@ -174,39 +188,44 @@ 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
- (format #f (G_ "description should not contain ~
+ (list
+ (make-warning package
+ (format #f (G_ "description should not contain ~
trademark sign '~a' at ~d")
- (string-ref description index) index)
- 'description))
- (else #t)))
+ (string-ref description index) index)
+ #:field 'description)))
+ (else '())))
(define (check-quotes description)
"Check whether DESCRIPTION contains single quotes and suggest @code."
- (when (regexp-exec %quoted-identifier-rx description)
- (emit-warning package
-
- ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
- ;; as is.
- (G_ "use @code or similar ornament instead of quotes")
- 'description)))
+ (if (regexp-exec %quoted-identifier-rx description)
+ (list
+ (make-warning package
+ ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
+ ;; as is.
+ (G_ "use @code or similar ornament instead of quotes")
+ #: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)))
+ (if (or (string-null? description)
+ (properly-starts-sentence? description)
+ (string-prefix-ci? (package-name package) description))
+ '()
+ (list
+ (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."
@@ -219,28 +238,33 @@ trademark sign '~a' at ~d")
(string-suffix-ci? s (match:prefix m)))
'("i.e" "e.g" "a.k.a" "resp"))
r (cons (match:start m) r)))))))
- (unless (null? infractions)
- (emit-warning package
- (format #f (G_ "sentences in description should be followed ~
+ (if (null? infractions)
+ '()
+ (list
+ (make-warning package
+ (format #f (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
- (length infractions)
- infractions)
- 'description))))
+ (length infractions)
+ infractions)
+ #: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
- (format #f (G_ "invalid description: ~s") description)
- 'description))))
+ (append
+ (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)
+ (match (check-texinfo-markup description)
+ ((and warning (? lint-warning?)) (list warning))
+ (plain-description
+ (check-proper-start plain-description))))
+ (list
+ (make-warning package
+ (format #f (G_ "invalid description: ~s") 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 +305,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 +320,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
@@ -314,66 +339,71 @@ line."
(define (check-synopsis-style package)
;; 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
- (G_ "synopsis should not be empty")
- '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
- (G_ "no period allowed at the end of the synopsis")
- 'synopsis)))
+ (if (and (string-suffix? "." synopsis)
+ (not (string-suffix? "etc." synopsis)))
+ (list
+ (make-warning package
+ (G_ "no period allowed at the end of the synopsis")
+ #:field 'synopsis))
+ '()))
(define check-start-article
;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
;; <http://lists.gnu.org/archive/html/bug-womb/2014-11/msg00000.html>.
(if (false-if-exception (gnu-package? package))
- (const #t)
+ (const '())
(lambda (synopsis)
- (when (or (string-prefix-ci? "A " synopsis)
- (string-prefix-ci? "An " synopsis))
- (emit-warning package
- (G_ "no article allowed at the beginning of \
+ (if (or (string-prefix-ci? "A " synopsis)
+ (string-prefix-ci? "An " synopsis))
+ (list
+ (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
- (G_ "synopsis should be less than 80 characters long")
- 'synopsis)))
+ (if (>= (string-length synopsis) 80)
+ (list
+ (make-warning package
+ (G_ "synopsis should be less than 80 characters long")
+ #:field 'synopsis))
+ '()))
(define (check-proper-start synopsis)
- (unless (properly-starts-sentence? synopsis)
- (emit-warning package
- (G_ "synopsis should start with an upper-case letter or digit")
- 'synopsis)))
+ (if (properly-starts-sentence? synopsis)
+ '()
+ (list
+ (make-warning package
+ (G_ "synopsis should start with an upper-case letter or digit")
+ #:field 'synopsis))))
(define (check-start-with-package-name synopsis)
- (when (and (regexp-exec (package-name-regexp package) synopsis)
+ (if (and (regexp-exec (package-name-regexp package) synopsis)
(not (starts-with-abbreviation? synopsis)))
- (emit-warning package
- (G_ "synopsis should not start with the package name")
- 'synopsis)))
+ (list
+ (make-warning package
+ (G_ "synopsis should not start with the package name")
+ #:field 'synopsis))
+ '()))
(define (check-texinfo-markup synopsis)
"Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
(catch #t
- (lambda () (texi->plain-text synopsis))
+ (lambda ()
+ (texi->plain-text synopsis)
+ '())
(lambda (keys . args)
- (emit-warning package
-
This message was truncated. Download the full message here.
Christopher Baines wrote 6 years ago
[PATCH 2/2] scripts: lint: Separate the message warning text and data.
(address . 35790@debbugs.gnu.org)
20190629112552.8261-2-mail@cbaines.net
So that translations can be handled more flexibly, rather than having to
translate the message text within the checker.

* guix/scripts/lint.scm (lint-warning-message-text,
lint-warning-message-data): New procedures.
(lint-warning-message): Remove record field accessor, replace with procedure
that handles the lint warning data and translating the message.
(make-warning): Rename to %make-warning.
(make-warning): New macro.
(emit-warnings): Handle the message-text and message-data fields.
(check-description-style): Adjust for changes to make-warning.
[check-trademarks, check-end-of-sentence-space): Adjust for changes to
make-warning.
(check-inputs-should-be-native, check-inputs-should-not-be-an-input-at-all,
check-synopsis-style, validate-uri, check-home-page, check-patch-file-names,
check-gnu-synopsis+description, check-mirror-url, check-github-url,
check-derivation, check-vulnerabilities, check-for-updates,
report-tabulations, report-trailing-white-space, report-long-line,
report-lone-parentheses): Adjust for changes to make-warning.
---
guix/scripts/lint.scm | 198 ++++++++++++++++++++++--------------------
1 file changed, 106 insertions(+), 92 deletions(-)

Toggle diff (429 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 1b08068669..4eb7e0e200 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -88,6 +88,8 @@
lint-warning?
lint-warning-package
lint-warning-message
+ lint-warning-message-text
+ lint-warning-message-data
lint-warning-location
%checkers
@@ -105,35 +107,49 @@
(define-record-type* <lint-warning>
lint-warning make-lint-warning
lint-warning?
- (package lint-warning-package)
- (message lint-warning-message)
- (location lint-warning-location
- (default #f)))
+ (package lint-warning-package)
+ (message-text lint-warning-message-text)
+ (message-data lint-warning-message-data
+ (default '()))
+ (location lint-warning-location
+ (default #f)))
+
+(define (lint-warning-message warning)
+ (apply format #f
+ (G_ (lint-warning-message-text warning))
+ (lint-warning-message-data warning)))
(define (package-file package)
(location-file
(package-location package)))
-(define* (make-warning package message
- #:key field location)
+(define* (%make-warning package message-text
+ #:optional (message-data '())
+ #:key field location)
(make-lint-warning
package
- message
+ message-text
+ message-data
(or location
(package-field-location package field)
(package-location package))))
+(define-syntax make-warning
+ (syntax-rules (G_)
+ ((_ package (G_ message) rest ...)
+ (%make-warning package message rest ...))))
+
(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.
(for-each
(match-lambda
- (($ <lint-warning> package message loc)
+ (($ <lint-warning> package message-text message-data loc)
(format (guix-warning-port) "~a: ~a@~a: ~a~%"
(location->string loc)
(package-name package) (package-version package)
- message)))
+ (apply format #f (G_ message-text) message-data))))
warnings))
@@ -199,9 +215,9 @@ http://www.gnu.org/prep/standards/html_node/Trademarks.html."
((and (? number?) index)
(list
(make-warning package
- (format #f (G_ "description should not contain ~
+ (G_ "description should not contain ~
trademark sign '~a' at ~d")
- (string-ref description index) index)
+ (list (string-ref description index) index)
#:field 'description)))
(else '())))
@@ -242,10 +258,10 @@ trademark sign '~a' at ~d")
'()
(list
(make-warning package
- (format #f (G_ "sentences in description should be followed ~
+ (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
- (length infractions)
- infractions)
+ (list (length infractions)
+ infractions)
#:field 'description)))))
(let ((description (package-description package)))
@@ -263,7 +279,8 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
(check-proper-start plain-description))))
(list
(make-warning package
- (format #f (G_ "invalid description: ~s") description)
+ (G_ "invalid description: ~s")
+ (list description)
#:field 'description)))))
(define (package-input-intersection inputs-to-check input-names)
@@ -308,8 +325,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(map (lambda (input)
(make-warning
package
- (format #f (G_ "'~a' should probably be a native input")
- input)
+ (G_ "'~a' should probably be a native input")
+ (list input)
#:field 'inputs))
(package-input-intersection inputs input-names))))
@@ -323,9 +340,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(map (lambda (input)
(make-warning
package
- (format #f
- (G_ "'~a' should probably not be an input at all")
- input)
+ (G_ "'~a' should probably not be an input at all")
+ (list input)
#:field 'inputs))
(package-input-intersection (package-direct-inputs package)
input-names))))
@@ -423,7 +439,9 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
checks))
(invalid
(list
- (make-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
+ (make-warning package
+ (G_ "invalid synopsis: ~s")
+ (list invalid)
#:field 'synopsis)))))
(define* (probe-uri uri #:key timeout)
@@ -540,64 +558,59 @@ PACKAGE mentionning the FIELD."
;; such malicious behavior.
(or (> length 1000)
(make-warning package
- (format #f
- (G_ "URI ~a returned \
+ (G_ "URI ~a returned \
suspiciously small file (~a bytes)")
- (uri->string uri)
- length)
+ (list (uri->string uri)
+ length)
#:field field)))
(_ #t)))
((= 301 (response-code argument))
(if (response-location argument)
(make-warning package
- (format #f (G_ "permanent redirect from ~a to ~a")
- (uri->string uri)
- (uri->string
- (response-location argument)))
+ (G_ "permanent redirect from ~a to ~a")
+ (list (uri->string uri)
+ (uri->string
+ (response-location argument)))
#:field field)
(make-warning package
- (format #f (G_ "invalid permanent redirect \
+ (G_ "invalid permanent redirect \
from ~a")
- (uri->string uri))
+ (list (uri->string uri))
#:field field)))
(else
(make-warning package
- (format #f
- (G_ "URI ~a not reachable: ~a (~s)")
- (uri->string uri)
- (response-code argument)
- (response-reason-phrase argument))
+ (G_ "URI ~a not reachable: ~a (~s)")
+ (list (uri->string uri)
+ (response-code argument)
+ (response-reason-phrase argument))
#:field field))))
((ftp-response)
(match argument
(('ok) #t)
(('error port command code message)
(make-warning package
- (format #f
- (G_ "URI ~a not reachable: ~a (~s)")
- (uri->string uri)
- code (string-trim-both message))
+ (G_ "URI ~a not reachable: ~a (~s)")
+ (list (uri->string uri)
+ code (string-trim-both message))
#:field field))))
((getaddrinfo-error)
(make-warning package
- (format #f
- (G_ "URI ~a domain not found: ~a")
- (uri->string uri)
- (gai-strerror (car argument)))
+ (G_ "URI ~a domain not found: ~a")
+ (list (uri->string uri)
+ (gai-strerror (car argument)))
#:field field))
((system-error)
(make-warning package
- (format #f
- (G_ "URI ~a unreachable: ~a")
- (uri->string uri)
- (strerror
- (system-error-errno
- (cons status argument))))
+ (G_ "URI ~a unreachable: ~a")
+ (list (uri->string uri)
+ (strerror
+ (system-error-errno
+ (cons status argument))))
#:field field))
((tls-certificate-error)
(make-warning package
- (format #f (G_ "TLS certificate error: ~a")
- (tls-certificate-error-string argument))
+ (G_ "TLS certificate error: ~a")
+ (list (tls-certificate-error-string argument))
#:field field))
((invalid-http-response gnutls-error)
;; Probably a misbehaving server; ignore.
@@ -627,8 +640,9 @@ from ~a")
#:field 'home-page))))
(else
(list
- (make-warning package (format #f (G_ "invalid home page URL: ~s")
- (package-home-page package))
+ (make-warning package
+ (G_ "invalid home page URL: ~s")
+ (list (package-home-page package))
#:field 'home-page))))))
(define %distro-directory
@@ -640,8 +654,10 @@ from ~a")
patch could not be found."
(guard (c ((message-condition? c) ;raised by 'search-patch'
(list
- (make-warning package (condition-message c)
- #:field 'patch-file-names))))
+ ;; Use %make-warning, as condition-mesasge is already
+ ;; translated.
+ (%make-warning package (condition-message c)
+ #:field 'patch-file-names))))
(define patches
(or (and=> (package-source package) origin-patches)
'()))
@@ -674,8 +690,8 @@ patch could not be found."
max)
(make-warning
package
- (format #f (G_ "~a: file name is too long")
- (basename patch))
+ (G_ "~a: file name is too long")
+ (list (basename patch))
#:field 'patch-file-names)
#f))
(_ #f))
@@ -716,8 +732,8 @@ descriptions maintained upstream."
(not (string=? upstream downstream))))
(list
(make-warning package
- (format #f (G_ "proposed synopsis: ~s~%")
- upstream)
+ (G_ "proposed synopsis: ~s~%")
+ (list upstream)
#:field 'synopsis))
'()))
@@ -730,9 +746,8 @@ descriptions maintained upstream."
(list
(make-warning
package
- (format #f
- (G_ "proposed description:~% \"~a\"~%")
- (fill-paragraph (escape-quotes upstream) 77 7))
+ (G_ "proposed description:~% \"~a\"~%")
+ (list (fill-paragraph (escape-quotes upstream) 77 7))
#:field 'description))
'()))))))
@@ -831,10 +846,10 @@ descriptions maintained upstream."
(loop rest))
(prefix
(make-warning package
- (format #f (G_ "URL should be \
+ (G_ "URL should be \
'mirror://~a/~a'")
- mirror-id
- (string-drop uri (string-length prefix)))
+ (list mirror-id
+ (string-drop uri (string-length prefix)))
#:field 'source)))))))
(let ((origin (package-source package)))
@@ -876,7 +891,8 @@ descriptions maintained upstream."
#f
(make-warning
package
- (format #f (G_ "URL should be '~a'") github-uri)
+ (G_ "URL should be '~a'")
+ (list github-uri)
#:field 'source)))))
(origin-uris origin))
'())))
@@ -888,14 +904,14 @@ descriptions maintained upstream."
(lambda ()
(guard (c ((store-protocol-error? c)
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~a")
- system
- (store-protocol-error-message c))))
+ (G_ "failed to create ~a derivation: ~a")
+ (list system
+ (store-protocol-error-message c))))
((message-condition? c)
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~a")
- system
- (condition-message c)))))
+ (G_ "failed to create ~a derivation: ~a")
+ (list system
+ (condition-message c)))))
(with-store store
;; Disable grafts since it can entail rebuilds.
(parameterize ((%graft? #f))
@@ -910,8 +926,8 @@ descriptions maintained upstream."
#:graft? #f)))))))
(lambda args
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~s")
- system args)))))
+ (G_ "failed to create ~a derivation: ~s")
+ (list system args)))))
(filter lint-warning?
(map try (package-supported-systems package))))
@@ -1001,15 +1017,15 @@ the NIST server non-fatal."
(list
(make-warning
package
- (format #f (G_ "probably vulnerable to ~a")
- (string-join (map vulnerability-id unpatched)
- ", "))))))))))
+ (G_ "probably vulnerable to ~a")
+ (list (string-join (map vulnerability-id unpatched)
+ ", "))))))))))
(define (check-for-updates package)
"Check if there is an update available for PACKAGE."
(match (with-networking-fail-safe
- (format #f (G_ "while retrieving upstream info for '~a'")
- (package-name package))
+ (G_ "while retrieving upstream info for '~a'")
+ (list (package-name package))
#f
(package-latest-release* package (force %updaters)))
((? upstream-source? source)
@@ -1017,8 +1033,8 @@ the NIST server non-fatal."
(package-version package))
(list
(make-warning package
- (format #f (G_ "can be upgraded to ~a")
- (upstream-source-version source))
+ (G_ "can be upgraded to ~a")
+ (list (upstream-source-version source))
#:field 'version))
'()))
(#f '()))) ; cannot find newer upstream release
@@ -1034,8 +1050,8 @@ the NIST server non-fatal."
(#f #t)
(index
(make-warning package
- (format #f (G_ "tabulation on line ~a, column ~a")
- line-number index)
+ (G_ "tabulation on line ~a, column ~a")
+ (list line-number index)
#:location
(location (package-file package)
line-number
@@ -1046,9 +1062,8 @@ the NIST server non-fatal."
(unless (or (string=? line (string-trim-right line))
(string=? line (string #\page)))
(make-warning package
- (format #f
- (G_ "trailing white space on line ~a")
- line-number)
+ (G_ "trailing white space on line ~a")
+ (list line-number)
#:location
(location (package-file package)
line-number
@@ -1061,8 +1076,8 @@ the NIST server non-fatal."
;; much noise.
(when (> (string-length line) 90)
(make-warning package
- (format #f (G_ "line ~a is way too long (~a characters)")
- line-number (string-length line))
+ (G_ "line ~a is way too long (~a characters)")
+ (list line-number (string-length line))
#:location
(location (package-file package)
line-number
@@ -1075,10 +1090,9 @@ the NIST server non-fatal."
"Emit a warning if LINE contains hanging parentheses."
(when (regexp-exec %hanging-paren-rx line)
(make-warning package
- (format #f
- (G_ "parentheses feel lonely, \
+ (G_ "parentheses feel lonely, \
move to the previous or next line")
- line-number)
+ (list line-number)
#:location
(location (package-file package)
line-number
--
2.22.0
Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH] scripts: lint: Handle warnings with a record type.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87y31kli4q.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (15 lines)
> Hi Chris,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Thanks, so if I set the bindtextdomain, things do indeed work
>> better. So, regarding these two patches, I've got the following things
>> on my mind...
>>
>> - As they change so many things, I'm not sure what to add for the GNU
>> changelog at the end of the commit message?
>
> I think you should try to write the commit log the usual way, by
> listing every changed entity. It’s a bit tedious, but it’s also a good
> way to review everything (and Magit makes it relatively easy.)

Ok, I've now made an initial attempt at this, and sent some updated
patches.
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0XUfVfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9Xc88Q//UL8IyGSje241shndq9UNY1fVHSGXMepA3kUZuZ+Dkep43HDevhDzelis
xdKWngXcQPZFp9GtyHlL5dle+q+laJdZhnWN2VehpIyz8RnGMxMQXKH4kIQkikp8
TciWhGehctQdP1g71EMk8LwxPgFw48JRFjiH5/BO34pspbBKANh3+PCv7OPuObid
M5JyeNvhZAXT0b8TgCnztTVGgYS9Wvt7tJSCzej+v/JN5hR9+fgtqO7163V/h//S
5cu77CS67xXEp35a6VKDsYDt5q6XxUyMf5pimCsaUr1AxZgH47wDws1gXKiUqsmy
BIJxhF/fRpU8mA1Rb1Hu7DkMdECTBJ2IbXjBn+lUZWHxeBgU5aNA3viAxkUDedQP
PVhOgGwBJAohzIN3m3qP8j4zS7sGVhOab66nar4tQokr2lt4rb6dfLZHYL2ZSHD5
wq7RyeUdqUOheRvEFLZuu6i3IILSU6cPigD78LrFg9/i3DzdZzc6Smbn4E+0nDWE
nLEeJt8aUSH9HyPEtDt3lBcf9rSuUceCpfql8lQQT+bUyegdduCZy0O6pnTyL/Sc
0TC7o1TBqq57V4pNWxX9Omircu3Asr9ysCD+bu1I1dKTckxhizTHY8avzprQbDDv
cXW7M82IqKEtq4UTQlRrtg2OouVNG3mSnqTC/8EfrxN/qMWezho=
=1FV9
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87a7dyoryh.fsf@gnu.org
Hi!

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (20 lines)
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi Chris,
>>
>> Christopher Baines <mail@cbaines.net> skribis:
>>
>>> Thanks, so if I set the bindtextdomain, things do indeed work
>>> better. So, regarding these two patches, I've got the following things
>>> on my mind...
>>>
>>> - As they change so many things, I'm not sure what to add for the GNU
>>> changelog at the end of the commit message?
>>
>> I think you should try to write the commit log the usual way, by
>> listing every changed entity. It’s a bit tedious, but it’s also a good
>> way to review everything (and Magit makes it relatively easy.)
>
> Ok, I've now made an initial attempt at this, and sent some updated
> patches.

Perfect, thanks for taking the time to do it.

Time to push! :-)

Thanks,
Ludo’.
Christopher Baines wrote 6 years ago
[PATCH 2/2] lint: Separate checkers by dependence on the internet.
(address . 35790@debbugs.gnu.org)
20190702192542.16179-2-mail@cbaines.net
I think there are a couple of potential uses for this. It's somewhat a
separation in to what checkers are just checking the contents of the
repository (line length for example), and other checkers which are bringing in
external information which could change.

I'm thinking particularly, about treating network dependant checkers
differently when automatically running them, but this commit also adds a
--no-network flag to guix lint, which selects the checkers that don't access
the network, which could be useful if no network access is available.

* guix/lint.scm (%checkers): Rename to %all-checkers.
(%local-checkers, %network-dependant-checkers): New variables.
* guix/scripts/lint.scm (run-checkers): Make the checkers argument mandatory.
(list-checkers-and-exit): Handle the checkers as an argument.
(%options): Adjust for changes to %checkers, add a --no-network option, and
change how the --list-checkers option is handled.
(guix-lint): Adjust indentation, and update how the checkers are handled.
---
guix/lint.scm | 64 +++++++++++++++++++++++++------------------
guix/scripts/lint.scm | 49 ++++++++++++++++++++-------------
2 files changed, 67 insertions(+), 46 deletions(-)

Toggle diff (220 lines)
diff --git a/guix/lint.scm b/guix/lint.scm
index f86e494be5..2cc0d34440 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -91,7 +91,10 @@
emit-warnings
- %checkers
+ %local-checkers
+ %network-dependant-checkers
+ %all-checkers
+
lint-checker
lint-checker?
lint-checker-name
@@ -1158,16 +1161,12 @@ them for PACKAGE."
;;; List of checkers.
;;;
-(define %checkers
+(define %local-checkers
(list
(lint-checker
(name 'description)
(description "Validate package descriptions")
(check check-description-style))
- (lint-checker
- (name 'gnu-description)
- (description "Validate synopsis & description of GNU packages")
- (check check-gnu-synopsis+description))
(lint-checker
(name 'inputs-should-be-native)
(description "Identify inputs that should be native inputs")
@@ -1176,14 +1175,6 @@ them for PACKAGE."
(name 'inputs-should-not-be-input)
(description "Identify inputs that shouldn't be inputs at all")
(check check-inputs-should-not-be-an-input-at-all))
- (lint-checker
- (name 'patch-file-names)
- (description "Validate file names and availability of patches")
- (check check-patch-file-names))
- (lint-checker
- (name 'home-page)
- (description "Validate home-page URLs")
- (check check-home-page))
(lint-checker
(name 'license)
;; TRANSLATORS: <license> is the name of a data type and must not be
@@ -1191,18 +1182,10 @@ them for PACKAGE."
(description "Make sure the 'license' field is a <license> \
or a list thereof")
(check check-license))
- (lint-checker
- (name 'source)
- (description "Validate source URLs")
- (check check-source))
(lint-checker
(name 'mirror-url)
(description "Suggest 'mirror://' URLs")
(check check-mirror-url))
- (lint-checker
- (name 'github-url)
- (description "Suggest GitHub URLs")
- (check check-github-url))
(lint-checker
(name 'source-file-name)
(description "Validate file names of sources")
@@ -1215,10 +1198,37 @@ or a list thereof")
(name 'derivation)
(description "Report failure to compile a package to a derivation")
(check check-derivation))
+ (lint-checker
+ (name 'patch-file-names)
+ (description "Validate file names and availability of patches")
+ (check check-patch-file-names))
+ (lint-checker
+ (name 'formatting)
+ (description "Look for formatting issues in the source")
+ (check check-formatting))))
+
+(define %network-dependant-checkers
+ (list
(lint-checker
(name 'synopsis)
(description "Validate package synopses")
(check check-synopsis-style))
+ (lint-checker
+ (name 'gnu-description)
+ (description "Validate synopsis & description of GNU packages")
+ (check check-gnu-synopsis+description))
+ (lint-checker
+ (name 'home-page)
+ (description "Validate home-page URLs")
+ (check check-home-page))
+ (lint-checker
+ (name 'source)
+ (description "Validate source URLs")
+ (check check-source))
+ (lint-checker
+ (name 'github-url)
+ (description "Suggest GitHub URLs")
+ (check check-github-url))
(lint-checker
(name 'cve)
(description "Check the Common Vulnerabilities and Exposures\
@@ -1227,8 +1237,8 @@ or a list thereof")
(lint-checker
(name 'refresh)
(description "Check the package for new upstream releases")
- (check check-for-updates))
- (lint-checker
- (name 'formatting)
- (description "Look for formatting issues in the source")
- (check check-formatting))))
+ (check check-for-updates))))
+
+(define %all-checkers
+ (append %local-checkers
+ %network-dependant-checkers))
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 8a8ffc8f28..c2e022cf94 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -38,7 +38,7 @@
#:export (guix-lint
run-checkers))
-(define* (run-checkers package #:optional (checkers %checkers))
+(define (run-checkers package checkers)
"Run the given CHECKERS on PACKAGE."
(let ((tty? (isatty? (current-error-port))))
(for-each (lambda (checker)
@@ -54,14 +54,14 @@
(format (current-error-port) "\x1b[K")
(force-output (current-error-port)))))
-(define (list-checkers-and-exit)
+(define (list-checkers-and-exit checkers)
;; Print information about all available checkers and exit.
(format #t (G_ "Available checkers:~%"))
(for-each (lambda (checker)
(format #t "- ~a: ~a~%"
(lint-checker-name checker)
(G_ (lint-checker-description checker))))
- %checkers)
+ checkers)
(exit 0))
@@ -97,26 +97,33 @@ run the checkers on all packages.\n"))
;; 'certainty'.
(list (option '(#\c "checkers") #t #f
(lambda (opt name arg result)
- (let ((names (map string->symbol (string-split arg #\,))))
+ (let ((names (map string->symbol (string-split arg #\,)))
+ (checker-names (map lint-checker-name %all-checkers)))
(for-each (lambda (c)
- (unless (memq c
- (map lint-checker-name
- %checkers))
+ (unless (memq c checker-names)
(leave (G_ "~a: invalid checker~%") c)))
names)
(alist-cons 'checkers
(filter (lambda (checker)
(member (lint-checker-name checker)
names))
- %checkers)
+ %all-checkers)
result))))
+ (option '(#\n "no-network") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'checkers
+ %local-checkers
+ (alist-delete 'checkers
+ result))))
(option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\l "list-checkers") #f #f
- (lambda args
- (list-checkers-and-exit)))
+ (lambda (opt name arg result)
+ (alist-cons 'list?
+ #t
+ result)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix lint")))))
@@ -134,13 +141,17 @@ run the checkers on all packages.\n"))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
- (('argument . value)
- value)
- (_ #f))
+ (('argument . value)
+ value)
+ (_ #f))
(reverse opts)))
- (checkers (or (assoc-ref opts 'checkers) %checkers)))
- (if (null? args)
- (fold-packages (lambda (p r) (run-checkers p checkers)) '())
- (for-each (lambda (spec)
- (run-checkers (specification->package spec) checkers))
- args))))
+ (checkers (or (assoc-ref opts 'checkers) %all-checkers)))
+ (cond
+ ((assoc-ref opts 'list?)
+ (list-checkers-and-exit checkers))
+ ((null? args)
+ (fold-packages (lambda (p r) (run-checkers p checkers)) '()))
+ (else
+ (for-each (lambda (spec)
+ (run-checkers (specification->package spec) checkers))
+ args)))))
--
2.22.0
Christopher Baines wrote 6 years ago
[PATCH 1/2] lint: Move the linting code to a different module.
(address . 35790@debbugs.gnu.org)
20190702192542.16179-1-mail@cbaines.net
To try and move towards making programatic access to the linting code easier,
this commit separates out the linting script, from the linting functionality
that it uses.
---
Makefile.am | 1 +
guix/lint.scm | 1234 +++++++++++++++++++++++++++++++++++++++++
guix/scripts/lint.scm | 1220 +---------------------------------------
tests/lint.scm | 2 +-
4 files changed, 1248 insertions(+), 1209 deletions(-)
create mode 100644 guix/lint.scm

Toggle diff (514 lines)
diff --git a/Makefile.am b/Makefile.am
index 80be73e4bf..0baadcde9c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -97,6 +97,7 @@ MODULES = \
guix/self.scm \
guix/upstream.scm \
guix/licenses.scm \
+ guix/lint.scm \
guix/glob.scm \
guix/git.scm \
guix/graph.scm \
diff --git a/guix/lint.scm b/guix/lint.scm
new file mode 100644
index 0000000000..f86e494be5
--- /dev/null
+++ b/guix/lint.scm
@@ -0,0 +1,1234 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
+;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix lint)
+ #:use-module ((guix store) #:hide (close-connection))
+ #:use-module (guix base32)
+ #:use-module (guix download)
+ #:use-module (guix ftp-client)
+ #:use-module (guix http-client)
+ #:use-module (guix packages)
+ #:use-module (guix licenses)
+ #:use-module (guix records)
+ #:use-module (guix grafts)
+ #:use-module (guix ui)
+ #:use-module (guix upstream)
+ #:use-module (guix utils)
+ #:use-module (guix memoization)
+ #:use-module (guix scripts)
+ #:use-module (guix gnu-maintenance)
+ #:use-module (guix monads)
+ #:use-module (guix cve)
+ #:use-module (gnu packages)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 format)
+ #:use-module (web client)
+ #:use-module (web uri)
+ #:use-module ((guix build download)
+ #:select (maybe-expand-mirrors
+ (open-connection-for-uri
+ . guix:open-connection-for-uri)
+ close-connection))
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-6) ;Unicode string ports
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (ice-9 rdelim)
+ #:export (check-description-style
+ check-inputs-should-be-native
+ check-inputs-should-not-be-an-input-at-all
+ check-patch-file-names
+ check-synopsis-style
+ check-derivation
+ check-home-page
+ check-source
+ check-source-file-name
+ check-source-unstable-tarball
+ check-mirror-url
+ check-github-url
+ check-license
+ check-vulnerabilities
+ check-for-updates
+ check-formatting
+
+ lint-warning
+ lint-warning?
+ lint-warning-package
+ lint-warning-message
+ lint-warning-message-text
+ lint-warning-message-data
+ lint-warning-location
+
+ emit-warnings
+
+ %checkers
+ lint-checker
+ lint-checker?
+ lint-checker-name
+ lint-checker-description
+ lint-checker-check))
+
+
+;;;
+;;; Warnings
+;;;
+
+(define-record-type* <lint-warning>
+ lint-warning make-lint-warning
+ lint-warning?
+ (package lint-warning-package)
+ (message-text lint-warning-message-text)
+ (message-data lint-warning-message-data
+ (default '()))
+ (location lint-warning-location
+ (default #f)))
+
+(define (lint-warning-message warning)
+ (apply format #f
+ (G_ (lint-warning-message-text warning))
+ (lint-warning-message-data warning)))
+
+(define (package-file package)
+ (location-file
+ (package-location package)))
+
+(define* (%make-warning package message-text
+ #:optional (message-data '())
+ #:key field location)
+ (make-lint-warning
+ package
+ message-text
+ message-data
+ (or location
+ (package-field-location package field)
+ (package-location package))))
+
+(define-syntax make-warning
+ (syntax-rules (G_)
+ ((_ package (G_ message) rest ...)
+ (%make-warning package message rest ...))))
+
+(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.
+ (for-each
+ (match-lambda
+ (($ <lint-warning> package message-text message-data loc)
+ (format (guix-warning-port) "~a: ~a@~a: ~a~%"
+ (location->string loc)
+ (package-name package) (package-version package)
+ (apply format #f (G_ message-text) message-data))))
+ warnings))
+
+
+;;;
+;;; Checkers
+;;;
+
+(define-record-type* <lint-checker>
+ lint-checker make-lint-checker
+ lint-checker?
+ ;; TODO: add a 'certainty' field that shows how confident we are in the
+ ;; checker. Then allow users to only run checkers that have a certain
+ ;; 'certainty' level.
+ (name lint-checker-name)
+ (description lint-checker-description)
+ (check lint-checker-check))
+
+(define (properly-starts-sentence? s)
+ (string-match "^[(\"'`[:upper:][:digit:]]" s))
+
+(define (starts-with-abbreviation? s)
+ "Return #t if S starts with what looks like an abbreviation or acronym."
+ (string-match "^[A-Z][A-Z0-9]+\\>" s))
+
+(define %quoted-identifier-rx
+ ;; A quoted identifier, like 'this'.
+ (make-regexp "['`][[:graph:]]+'"))
+
+(define (check-description-style package)
+ ;; Emit a warning if stylistic issues are found in the description of PACKAGE.
+ (define (check-not-empty description)
+ (if (string-null? description)
+ (list
+ (make-warning package
+ (G_ "description should not be empty")
+ #:field 'description))
+ '()))
+
+ (define (check-texinfo-markup description)
+ "Check that DESCRIPTION can be parsed as a Texinfo fragment. If the
+markup is valid return a plain-text version of DESCRIPTION, otherwise #f."
+ (catch #t
+ (lambda () (texi->plain-text description))
+ (lambda (keys . args)
+ (make-warning package
+ (G_ "Texinfo markup in description is invalid")
+ #: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)
+ (list
+ (make-warning package
+ (G_ "description should not contain ~
+trademark sign '~a' at ~d")
+ (list (string-ref description index) index)
+ #:field 'description)))
+ (else '())))
+
+ (define (check-quotes description)
+ "Check whether DESCRIPTION contains single quotes and suggest @code."
+ (if (regexp-exec %quoted-identifier-rx description)
+ (list
+ (make-warning package
+ ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
+ ;; as is.
+ (G_ "use @code or similar ornament instead of quotes")
+ #:field 'description))
+ '()))
+
+ (define (check-proper-start description)
+ (if (or (string-null? description)
+ (properly-starts-sentence? description)
+ (string-prefix-ci? (package-name package) description))
+ '()
+ (list
+ (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."
+ (let ((infractions
+ (reverse (fold-matches
+ "\\. [A-Z]" description '()
+ (lambda (m r)
+ ;; Filter out matches of common abbreviations.
+ (if (find (lambda (s)
+ (string-suffix-ci? s (match:prefix m)))
+ '("i.e" "e.g" "a.k.a" "resp"))
+ r (cons (match:start m) r)))))))
+ (if (null? infractions)
+ '()
+ (list
+ (make-warning package
+ (G_ "sentences in description should be followed ~
+by two spaces; possible infraction~p at ~{~a~^, ~}")
+ (list (length infractions)
+ infractions)
+ #:field 'description)))))
+
+ (let ((description (package-description package)))
+ (if (string? description)
+ (append
+ (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)
+ (match (check-texinfo-markup description)
+ ((and warning (? lint-warning?)) (list warning))
+ (plain-description
+ (check-proper-start plain-description))))
+ (list
+ (make-warning package
+ (G_ "invalid description: ~s")
+ (list description)
+ #:field 'description)))))
+
+(define (package-input-intersection inputs-to-check input-names)
+ "Return the intersection between INPUTS-TO-CHECK, the list of input tuples
+of a package, and INPUT-NAMES, a list of package specifications such as
+\"glib:bin\"."
+ (match inputs-to-check
+ (((labels packages . outputs) ...)
+ (filter-map (lambda (package output)
+ (and (package? package)
+ (let ((input (string-append
+ (package-name package)
+ (if (> (length output) 0)
+ (string-append ":" (car output))
+ ""))))
+ (and (member input input-names)
+ input))))
+ packages outputs))))
+
+(define (check-inputs-should-be-native package)
+ ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
+ ;; native inputs.
+ (let ((inputs (package-inputs package))
+ (input-names
+ '("pkg-config"
+ "cmake"
+ "extra-cmake-modules"
+ "glib:bin"
+ "intltool"
+ "itstool"
+ "qttools"
+ "python-coverage" "python2-coverage"
+ "python-cython" "python2-cython"
+ "python-docutils" "python2-docutils"
+ "python-mock" "python2-mock"
+ "python-nose" "python2-nose"
+ "python-pbr" "python2-pbr"
+ "python-pytest" "python2-pytest"
+ "python-pytest-cov" "python2-pytest-cov"
+ "python-setuptools-scm" "python2-setuptools-scm"
+ "python-sphinx" "python2-sphinx")))
+ (map (lambda (input)
+ (make-warning
+ package
+ (G_ "'~a' should probably be a native input")
+ (list 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
+ ;; an input at all.
+ (let ((input-names '("python-setuptools"
+ "python2-setuptools"
+ "python-pip"
+ "python2-pip")))
+ (map (lambda (input)
+ (make-warning
+ package
+ (G_ "'~a' should probably not be an input at all")
+ (list 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
+line."
+ (make-regexp (string-append "^" (regexp-quote (package-name package))
+ "\\>")
+ regexp/icase))
+
+(define (check-synopsis-style package)
+ ;; Emit a warning if stylistic issues are found in the synopsis of PACKAGE.
+ (define (check-final-period synopsis)
+ ;; Synopsis should not end with a period, except for some special cases.
+ (if (and (string-suffix? "." synopsis)
+ (not (string-suffix? "etc." synopsis)))
+ (list
+ (make-warning package
+ (G_ "no period allowed at the end of the synopsis")
+ #:field 'synopsis))
+ '()))
+
+ (define check-start-article
+ ;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
+ ;; <http://lists.gnu.org/archive/html/bug-womb/2014-11/msg00000.html>.
+ (if (false-if-exception (gnu-package? package))
+ (const '())
+ (lambda (synopsis)
+ (if (or (string-prefix-ci? "A " synopsis)
+ (string-prefix-ci? "An " synopsis))
+ (list
+ (make-warning package
+ (G_ "no article allowed at the beginning of \
+the synopsis")
+ #:field 'synopsis))
+ '()))))
+
+ (define (check-synopsis-length synopsis)
+ (if (>= (string-length synopsis) 80)
+ (list
+ (make-warning package
+ (G_ "synopsis should be less than 80 characters long")
+ #:field 'synopsis))
+ '()))
+
+ (define (check-proper-start synopsis)
+ (if (properly-starts-sentence? synopsis)
+ '()
+ (list
+ (make-warning package
+ (G_ "synopsis should start with an upper-case letter or digit")
+ #:field 'synopsis))))
+
+ (define (check-start-with-package-name synopsis)
+ (if (and (regexp-exec (package-name-regexp package) synopsis)
+ (not (starts-with-abbreviation? synopsis)))
+ (list
+ (make-warning package
+ (G_ "synopsis should not start with the package name")
+ #:field 'synopsis))
+ '()))
+
+ (define (check-texinfo-markup synopsis)
+ "Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
+markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
+ (catch #t
+ (lambda ()
+ (texi->plain-text synopsis)
+ '())
+ (lambda (keys . args)
+ (list
+ (make-warning package
+ (G_ "Texinfo markup in synopsis is invalid")
+ #:field 'synopsis)))))
+
+ (define checks
+ (list check-proper-start
+ check-final-period
+ check-start-article
+ check-start-with-package-name
+ check-synopsis-length
+ check-texinfo-markup))
+
+ (match (package-synopsis package)
+ (""
+ (list
+ (make-warning package
+ (G_ "synopsis should not be empty")
+ #:field 'synopsis)))
+ ((? string? synopsis)
+ (append-map
+ (lambda (proc)
+ (proc synopsis))
+ checks))
+ (invalid
+ (list
+ (make-warning package
+ (G_ "invalid synopsis: ~s")
+ (list invalid)
+ #:field 'synopsis)))))
+
+(define* (probe-uri uri #:key timeout)
+ "Probe URI, a URI object, and return two values: a symbol denoting the
+probing status, such as 'http-response' when we managed to get an HTTP
+response from URI, and additional details, such as the actual HTTP response.
+
+TIMEOUT is the maximum number of seconds (possibly an inexact number) to wait
+for connections to complete; when TIMEOUT is #f, wait as long as needed."
+ (define headers
+ '((User-Agent . "GNU Guile")
+ (Accept . "*/*")))
+
+ (let loop ((uri uri)
+ (visited '()))
+ (match (uri-scheme uri)
+ ((or 'http 'https)
+ (catch #t
+ (lambda ()
+ (let ((port (guix:open-connection-for-uri
+ uri #:timeout timeout))
+ (request (build-request uri #:headers headers)))
+ (define response
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (write-request request port)
+ (force-output port)
+ (read-response port))
+ (lambda ()
+ (close-connection port))))
+
+ (case (response-code response)
+ ((302 ; found (redirection)
+ 303 ; see other
+ 307 ; temporary redirection
+ 308) ; permanent redirection
+ (let ((location (response-location response)))
+ (if (or (not location) (member location visited))
+ (values 'http-response response)
+ (loop location (cons location visited))))) ;follow the redirect
+ ((301) ; moved permanently
+ (let ((location (response-location response)))
+ ;; Return RESPONSE, unless the final response as we follow
+ ;; redirects is not 200.
+ (if location
+ (let-values (((status response2)
+ (loop location (cons location visited))))
+ (case status
+ ((http-response)
+ (values 'http-response
+ (if (= 200 (response-code response2))
+ response
+ response2)))
+ (else
+ (values status response2))))
+ (values 'http-response response)))) ;invalid redirect
+ (else
+ (values 'http-response response)))))
+ (lambda (key . args)
+ (case key
+ ((bad-header bad-header-component)
+ ;; This can happen if
This message was truncated. Download the full message here.
Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH] scripts: lint: Handle warnings with a record type.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87v9wkkxbf.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (26 lines)
> Hi!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> Hi Chris,
>>>
>>> Christopher Baines <mail@cbaines.net> skribis:
>>>
>>>> Thanks, so if I set the bindtextdomain, things do indeed work
>>>> better. So, regarding these two patches, I've got the following things
>>>> on my mind...
>>>>
>>>> - As they change so many things, I'm not sure what to add for the GNU
>>>> changelog at the end of the commit message?
>>>
>>> I think you should try to write the commit log the usual way, by
>>> listing every changed entity. It’s a bit tedious, but it’s also a good
>>> way to review everything (and Magit makes it relatively easy.)
>>
>> Ok, I've now made an initial attempt at this, and sent some updated
>> patches.
>
> Perfect, thanks for taking the time to do it.

Great :)

Toggle quote (2 lines)
> Time to push! :-)

Well... I'm happy to push these patches to master, but I've got some
more related changes in mind. It might be good to merge these all
together, to avoid churning up the codebase more than necessary.

I've sent another couple of patches, the first to move most of the
functionality from (guix scripts lint) to a new (guix lint) module.

The second patch then splits the checkers in to two groups, based on
whether they attempt to access the network.

This is still moving towards being able to easily lint all the packages
and store this information in the Guix Data Serivce.
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0bu1RfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XeqyRAAk/eqbAMa9gZviwrL7niIvHV8BrTSIIMNr0z0fPZTFXPHCso45DTZ5GPx
FJ3uGS1l73QmYT76LbKszCE5q1BRLuUeQKVIK4wAUQuykq5pEP38OHMwFC4YDrcB
36J+kkD0UoPLq67QyK99QYj+WJxDZv0AV5UueIOFQGylMbpM+2uaK6lNcxeTA7Pu
cS0ql6l5k9/QQokfkqIGFK//OA4oZvZhjTwFfa6CNixvFjYLK2R7Ey1DvOCY00Rm
fp9M87MrNv1l9AV9++9A2cGMKrrczUqku98N/MOwtI+LtRUuAdLjwDfZvz9WaKp2
FW9lFAewoM80M7HVgFs/YYoJS28kSOFHyzfK4B+PyPEHznlwwN6usN6vqWYo9yLj
516Fqnh9u+91Irq3DjANKYAfS2lJ92sI3/Heix9BsLbQBWuzZbqrIGl7/bLcckdJ
Yh+3+fkJlja2aQUA2SohHHsZq4vtGIwKlVL2kcYOSWUecTNCFtl4AzPXZpvEFBh1
HziabV/nfkIblbuIhifHJh983XhVf7Jor5KzP8rc4/x7qtbmVXq2BmUx6SAPJa+G
H9A9b63PVfU8vP5wC717xaMaAy4hz9IvwA4H/01rMNl8LZWg9hEUO7zbbxVl6Pf1
SemtwEkOysgQKnJ6z11+rGG4YkA6OzIGiFeu8PLI3mOOz5lu8t4=
=n67x
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
Re: [bug#35790] [PATCH 1/2] lint: Move the linting code to a different module.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87pnmfgw03.fsf@gnu.org
Hi,

I think this could have come as a subsequent patch, but regardless, this
is a welcome move.

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (4 lines)
> To try and move towards making programatic access to the linting code easier,
> this commit separates out the linting script, from the linting functionality
> that it uses.

For the final version, please write a change log.

Toggle quote (12 lines)
> +(define-module (guix lint)
> + #:use-module ((guix store) #:hide (close-connection))
> + #:use-module (guix base32)
> + #:use-module (guix download)
> + #:use-module (guix ftp-client)
> + #:use-module (guix http-client)
> + #:use-module (guix packages)
> + #:use-module (guix licenses)
> + #:use-module (guix records)
> + #:use-module (guix grafts)
> + #:use-module (guix ui)

The principle that’s mostly followed for Guix modules is that they are
UI-independent: they might throw ‘&message’ error conditions, they might
even use (guix i18n), but they usually don’t depend on (guix ui).

The idea is separation of concerns: the actual UI implementation details
(TUI, GUI, etc.) remain separate from the API.

At first sight (guix ui) is not necessary here, and it’s enough to use
(guix i18n), isn’t it?

Last thing: please add this new file to po/guix/POTFILES.in.

Thanks for working on it!

Ludo’.
Ludovic Courtès wrote 6 years ago
Re: [bug#35790] [PATCH 2/2] lint: Separate checkers by dependence on the internet.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87lfx3gvxf.fsf@gnu.org
Hi,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (18 lines)
> I think there are a couple of potential uses for this. It's somewhat a
> separation in to what checkers are just checking the contents of the
> repository (line length for example), and other checkers which are bringing in
> external information which could change.
>
> I'm thinking particularly, about treating network dependant checkers
> differently when automatically running them, but this commit also adds a
> --no-network flag to guix lint, which selects the checkers that don't access
> the network, which could be useful if no network access is available.
>
> * guix/lint.scm (%checkers): Rename to %all-checkers.
> (%local-checkers, %network-dependant-checkers): New variables.
> * guix/scripts/lint.scm (run-checkers): Make the checkers argument mandatory.
> (list-checkers-and-exit): Handle the checkers as an argument.
> (%options): Adjust for changes to %checkers, add a --no-network option, and
> change how the --list-checkers option is handled.
> (guix-lint): Adjust indentation, and update how the checkers are handled.

Nice.

Toggle quote (1 lines)
> +(define %network-dependant-checkers
^
Shouldn’t it be “dependent” with an ‘e’?

Otherwise LGTM, thanks!

Ludo’.
Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH 1/2] lint: Move the linting code to a different module.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87wogkh4s0.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (8 lines)
> Christopher Baines <mail@cbaines.net> skribis:
>
>> To try and move towards making programatic access to the linting code easier,
>> this commit separates out the linting script, from the linting functionality
>> that it uses.
>
> For the final version, please write a change log.

Sure, any suggestions about how to write it? I wasn't sure whether to
list everything that had been moved from (guix scripts lint) to (guix
lint), or say that the file has moved, and list the things that have
been moved back.

Toggle quote (22 lines)
>> +(define-module (guix lint)
>> + #:use-module ((guix store) #:hide (close-connection))
>> + #:use-module (guix base32)
>> + #:use-module (guix download)
>> + #:use-module (guix ftp-client)
>> + #:use-module (guix http-client)
>> + #:use-module (guix packages)
>> + #:use-module (guix licenses)
>> + #:use-module (guix records)
>> + #:use-module (guix grafts)
>> + #:use-module (guix ui)
>
> The principle that’s mostly followed for Guix modules is that they are
> UI-independent: they might throw ‘&message’ error conditions, they might
> even use (guix i18n), but they usually don’t depend on (guix ui).
>
> The idea is separation of concerns: the actual UI implementation details
> (TUI, GUI, etc.) remain separate from the API.
>
> At first sight (guix ui) is not necessary here, and it’s enough to use
> (guix i18n), isn’t it?

I do remember looking at this, but I think I got stuck. I've just had
another look though, and I think if I import (guix diagnostics) and
(guix i18n) modules, then (guix ui) isn't required.

Toggle quote (4 lines)
> Last thing: please add this new file to po/guix/POTFILES.in.
>
> Thanks for working on it!

No problem, thanks for taking a look :)
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0rbo9fFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XdhORAAluYMBY+/GzHOVk3F3AUPzEQbkzAE3qXXAgVL7nZq3AZpRqcI4dgIlkXZ
vycXTblVLIN2y5kRNu1ADQFs93cn93l1ap8fcr2jeUbaO9srpeN7J9OJvNvvR9RD
vX3DlB7OJ/4BDiRZA9fDYoyafF8QBHNwfAyTUWRfS1lQZsvxmpJxqUCMKcOEvpLS
/LiyxCmTfDezMufLoBtD7WHGmXxN+WINlQyq8qKcXHGngifcL9WBXTWNjFwueKbV
pCtuQX2mNDTiRuSmDURS6ke0zM+EC5qfMgZ0du+Eb8SRmq/yqmD7OIQt+Y3q5kXp
6LMxdnw7QCmTAt3ubDY8yar076sR50J4+XVD1vKJLVPRcYG6MA8SGKaTC/mhZYMS
mF4GX81D/qubU9px/32foeggH5s5tmYIqxiSTKN+jdO/ap/fQrUDBHzG8BFJNm19
FEAQxDwQZA1k8jkMJYzPhVsKb7q1rujpSocya5Zx+xzlA0RAin1vvVfZY/DUV4gJ
jlY49zG3BZNncRFuAJu/+Vryj7bg1H4XlPGECm8LBk6iQX4utQI/LVoJfg5JWP26
tA/LL5TBOLaXNMdc2b1zkJLOALIOdUx4KxQlLc8uufMzEUdtPT+kcR26KqeCASUh
hEUTW9tDLd9EP3rr7afG+dl2+9tVD7/gnLOW+ZDT2sPHj/oCFp0=
=j6e4
-----END PGP SIGNATURE-----

Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH 2/2] lint: Separate checkers by dependence on the internet.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87v9w4h44s.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (28 lines)
> Hi,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> I think there are a couple of potential uses for this. It's somewhat a
>> separation in to what checkers are just checking the contents of the
>> repository (line length for example), and other checkers which are bringing in
>> external information which could change.
>>
>> I'm thinking particularly, about treating network dependant checkers
>> differently when automatically running them, but this commit also adds a
>> --no-network flag to guix lint, which selects the checkers that don't access
>> the network, which could be useful if no network access is available.
>>
>> * guix/lint.scm (%checkers): Rename to %all-checkers.
>> (%local-checkers, %network-dependant-checkers): New variables.
>> * guix/scripts/lint.scm (run-checkers): Make the checkers argument mandatory.
>> (list-checkers-and-exit): Handle the checkers as an argument.
>> (%options): Adjust for changes to %checkers, add a --no-network option, and
>> change how the --list-checkers option is handled.
>> (guix-lint): Adjust indentation, and update how the checkers are handled.
>
> Nice.
>
>> +(define %network-dependant-checkers
> ^
> Shouldn’t it be “dependent” with an ‘e’?

I'm definitely not an authority on spelling, but yeah, it seems like
dependent is preferred as the adjective, especially in American English.

Toggle quote (2 lines)
> Otherwise LGTM, thanks!

Great :)
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0rcdNfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XfvJhAAucGfOBkdvlC8Zrxbhpv+7L2dIowpxNGCdnCVLSGfwFzFQKM7yKsK1MLj
LcGPONjYjdk80Cii2+iEwG2gdNemG/e8821FQNlKglWaduvPIAww/q+z9ulWe9ia
FGLRVHVOmXgIcxcFohjq9wwL5LKu44VQrl+HHU6BvY8Uo7h7pDHRaPKaqTBWhhf9
S8khh1Yq7wO09O07F0lzRudjUHUlIqAJjAdSLpgGGGhM3vt8xH9yHE+bqywOf+4C
rc9qYyh4BkMSvHpJiS6OtmgmgkY6c2M5TR7JlFcPOlXutEtC3h9ycOVnQsQ2SO6f
DDVyZNtLPFVY8Ellx3w+cptOf/jjnGqEBD0EZ/MkpfnIBQZ5FIBq7m0If48gAJbC
xltZgxgripyovUeQQ3C3TEVxZQhSzxw/ZRBvVQx2ysDNntfRURKsiORV3js+Utc9
4HRYr+d8OliOp3KvxmCRO4FiLgTve8TsRVGoK7VAzAfnVxyngR8yrGeAjAHLoE3a
HBDVW68Zgffwn4aVeItagJw4+L5cJ9ytTzJCC+HlRnfzYib3p4yBsO+amAqNjz8w
d0KzeAQg1qS/F+XAK/xgJLrS7uW1V3a1KOPgY45imgT1xA1QxpycTIT/qMZzphhi
hRPe5jG/n5vyrP/D582lbLYAPcqTIhyEhLLZnBwmSnFaJyYGWNg=
=sKPD
-----END PGP SIGNATURE-----

Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH 1/2] lint: Move the linting code to a different module.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87tvboh3vi.fsf@cbaines.net
Christopher Baines <mail@cbaines.net> writes:

Toggle quote (15 lines)
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Christopher Baines <mail@cbaines.net> skribis:
>>
>>> To try and move towards making programatic access to the linting code easier,
>>> this commit separates out the linting script, from the linting functionality
>>> that it uses.
>>
>> For the final version, please write a change log.
>
> Sure, any suggestions about how to write it? I wasn't sure whether to
> list everything that had been moved from (guix scripts lint) to (guix
> lint), or say that the file has moved, and list the things that have
> been moved back.

Actually, now that I've run make, that's spotted some problems in some
checks.

guix/lint.scm:198:17: warning: possibly unbound variable `texi->plain-text'
guix/lint.scm:406:8: warning: possibly unbound variable `texi->plain-text'
guix/lint.scm:737:36: warning: possibly unbound variable `fill-paragraph'
guix/lint.scm:738:36: warning: possibly unbound variable `fill-paragraph'
guix/lint.scm:743:20: warning: possibly unbound variable `fill-paragraph'

I don't think these are as easy to solve, as these functions come from
(guix ui).
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0rcyFfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9Xfdew//WiTScSUFcgIhLiSbLJGI0aMcXq65NB/naDNfy/bl9nhRTX/shzj4gwCL
HG2QnEZEsXmk0tK0XW62BWIT1GSiR/2+f/U7Z2p+aa6sjU1xdsZrWv8GiEb3PbZt
FLR48M7AXrJ+MV6YKWOBM8ruMNv3z+eybRYbqh1SLkTyPfvuhtg9rcPRKZJB3k9i
/3F50xl/gT9JPNQv3beb895x7dRkVMVofvPFMN5BOfXFp4BZz8Gi8VJaMI0i4bmV
nFsS+k9xBC+gBCHU6av2n1/0xIuVft86c7QOV5TcRkQS7zSywfpN5nlYlk7Oshoq
opo+sabRa3d5/rwK3D2pLZ1fjyY0Yo1mMNaGuBpqeY+jZYgjMJpK6o++Vzo9Zh/t
Ygk+vz+LQbteprTc6f4ay8Q8cTIzVNN5oTDxyeYaktjiAyJEMxSWCxCATsivlny0
UKfBMneQUFSgmiDQUxEDx8vJS+IMXwmu3SAfcH1SNfK++UDNulZTGQ4yZURoU9OS
hjgfSOBIcwUGtetXNK/qIS8JHioHwHL5RutDHmsAL89bMSjeJoy3UuO3IQGN7fOs
vICJ0FTwCht/CfbtsKLax/ZJtKS1cXHz0uJZyT0YLvlHZYkEytHPbJK7ATFk5cw6
cC1KsJVUZX0yfu9ThX+9G1oouqkl83S3xd9eK+P1NE7zSgjFQWM=
=yfsP
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87k1cjr6vv.fsf@gnu.org
Hi Chris!

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (15 lines)
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Christopher Baines <mail@cbaines.net> skribis:
>>
>>> To try and move towards making programatic access to the linting code easier,
>>> this commit separates out the linting script, from the linting functionality
>>> that it uses.
>>
>> For the final version, please write a change log.
>
> Sure, any suggestions about how to write it? I wasn't sure whether to
> list everything that had been moved from (guix scripts lint) to (guix
> lint), or say that the file has moved, and list the things that have
> been moved back.

Maybe something like:

* guix/scripts/lint.scm (check-foo, check-bar): Move to…
* guix/lint.scm: … here.

and also mention things that go beyond simply moving things around (if
applicable).

But again, don’t spend a whole day on this, it’s mostly so the future us
have an easily searchable log.

Toggle quote (12 lines)
> Actually, now that I've run make, that's spotted some problems in some
> checks.
>
> guix/lint.scm:198:17: warning: possibly unbound variable `texi->plain-text'
> guix/lint.scm:406:8: warning: possibly unbound variable `texi->plain-text'
> guix/lint.scm:737:36: warning: possibly unbound variable `fill-paragraph'
> guix/lint.scm:738:36: warning: possibly unbound variable `fill-paragraph'
> guix/lint.scm:743:20: warning: possibly unbound variable `fill-paragraph'
>
> I don't think these are as easy to solve, as these functions come from
> (guix ui).

Ah yes, indeed.

In that case it’s OK because (guix ui) is used as part of the linter’s
job. Perhaps for clarity we should write:

#:use-module ((guix ui) #:select (texi->plain-text fill-paragraph))

Uses of the ‘warning’ procedure or similar UI functionality should be
left to (guix scripts lint), though.

Thanks,
Ludo’.
Christopher Baines wrote 6 years ago
[PATCH 1/4] scripts: lint: Handle warnings with a record type.
(address . 35790@debbugs.gnu.org)
20190715194558.13804-1-mail@cbaines.net
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 (<lint-warning>): New record type.
(lint-warning): New macro.
(lint-warning?, lint-warning-package, lint-warning-message,
lint-warning-location, package-file, make-warning): New procedures.
(call-with-accumulated-warnings, with-accumulated-warnings): Remove.
(emit-warning): Rename to emit-warnings, and switch to displaying multiple
warnings.
(check-description-style)[check-not-empty-description, check-texinfo-markup,
check-trademarks, check-quotes, check-proper-start,
check-end-of-sentence-space]: Switch to generating a list of warnings, and
using make-warning, rather than emit-warning.
(check-inputs-should-be-native, check-inputs-should-not-be-an-input-at-all):
Switch to generating a list of warnings, and using make-warning, rather than
emit-warning.
(check-synopsis): Switch to generating a list of warnings, and using
make-warning, rather than emit-warning.
[check-not-empty]: Remove, this is handled in the match clause
to avoid other warnings being emitted.
[check-final-period, check-start-article, check-synopsis-length,
check-proper-start, check-start-with-package-name, check-texinfo-markup]:
Switch to generating a list of warnings, and using make-warning, rather than
emit-warning.
[checks]: Remove check-not-empty.
(validate-uri, check-home-page, check-patch-file-names,
check-gnu-synopsis+description): Switch to generating a list of warnings, and
using make-warning, rather than emit-warning.
(check-source): Switch to generating a list of warnings, and using
make-warning, rather than emit-warning.
[try-uris]: Remove.
[warnings-for-uris]: New procedure, replacing try-uris.
(check-source-file-name, check-source-unstable-tarball, check-mirror-url,
check-github-url, check-derivation, check-vulnerabilities, check-for-updates,
report-tabulations, report-trailing-white-space, report-long-line,
report-lone-parentheses, report-formatting-issues, check-formatting): Switch
to generating a list of warnings, and using make-warning, rather than
emit-warning.
(run-checkers): Call emit-warnings on the warnings returned from the checker.
* tests/lint.scm (string-match-or-error, single-lint-warning-message): New
procedures.
(call-with-warnings, with-warnings): Remove.
("description: not a string", "description: not empty", "description: invalid
Texinfo markup", "description: does not start with an upper-case letter",
"description: may start with a digit", "description: may start with lower-case
package name", "description: two spaces after end of sentence", "description:
end-of-sentence detection with abbreviations", "description: may not contain
trademark signs: ™", "description: may not contain trademark signs: ®",
"description: suggest ornament instead of quotes", "synopsis: not a string",
"synopsis: not empty", "synopsis: valid Texinfo markup", "synopsis: does not
start with an upper-case letter", "synopsis: may start with a digit",
"synopsis: ends with a period", "synopsis: ends with 'etc.'", "synopsis:
starts with 'A'", "synopsis: starts with 'a'", "synopsis: starts with 'an'",
"synopsis: too long", "synopsis: start with package name", "synopsis: start
with package name prefix", "synopsis: start with abbreviation", "inputs:
pkg-config is probably a native input", "inputs: glib:bin is probably a native
input", "inputs: python-setuptools should not be an input at all (input)",
"inputs: python-setuptools should not be an input at all (native-input)",
"inputs: python-setuptools should not be an input at all (propagated-input)",
"patches: file names", "patches: file name too long", "patches: not found",
"derivation: invalid arguments", "license: invalid license", "home-page: wrong
home-page", "home-page: invalid URI", "home-page: host not found", "home-page:
Connection refused", "home-page: 200", "home-page: 200 but short length",
"home-page: 404", "home-page: 301, invalid", "home-page: 301 -> 200",
"home-page: 301 -> 404", "source-file-name", "source-file-name: v prefix",
"source-file-name: bad checkout", "source-file-name: good checkout",
"source-file-name: valid", "source-unstable-tarball",
"source-unstable-tarball: source #f", "source-unstable-tarball: valid",
"source-unstable-tarball: package named archive", "source-unstable-tarball:
not-github", "source-unstable-tarball: git-fetch", "source: 200", "source: 200
but short length", "source: 404", "source: 301 -> 200", "source: 301 -> 404",
"mirror-url", "mirror-url: one suggestion", "github-url", "github-url: one
suggestion", "github-url: already the correct github url", "cve", "cve: one
vulnerability", "cve: one patched vulnerability", "cve: known safe from
vulnerability", "cve: vulnerability fixed in replacement version", "cve:
patched vulnerability in replacement", "formatting: lonely parentheses",
"formatting: alright"): Change test-assert to test-equal, and adjust to work
with the changes above.
("formatting: tabulation", "formatting: trailing white space", "formatting:
long line"): Use string-match-or-error rather than string-contains.
---
guix/scripts/lint.scm | 757 +++++++++++----------
tests/lint.scm | 1453 +++++++++++++++++++----------------------
2 files changed, 1102 insertions(+), 1108 deletions(-)

Toggle diff (366 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index dc338a1d7b..1b08068669 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -84,6 +84,12 @@
check-formatting
run-checkers
+ lint-warning
+ lint-warning?
+ lint-warning-package
+ lint-warning-message
+ lint-warning-location
+
%checkers
lint-checker
lint-checker?
@@ -93,42 +99,48 @@
;;;
-;;; 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-location
+ (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)))
+ warnings))
;;;
;;; Checkers
;;;
+
(define-record-type* <lint-checker>
lint-checker make-lint-checker
lint-checker?
@@ -163,10 +175,12 @@ monad."
(define (check-description-style package)
;; 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
- (G_ "description should not be empty")
- 'description)))
+ (if (string-null? description)
+ (list
+ (make-warning package
+ (G_ "description should not be empty")
+ #:field 'description))
+ '()))
(define (check-texinfo-markup description)
"Check that DESCRIPTION can be parsed as a Texinfo fragment. If the
@@ -174,39 +188,44 @@ 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
- (format #f (G_ "description should not contain ~
+ (list
+ (make-warning package
+ (format #f (G_ "description should not contain ~
trademark sign '~a' at ~d")
- (string-ref description index) index)
- 'description))
- (else #t)))
+ (string-ref description index) index)
+ #:field 'description)))
+ (else '())))
(define (check-quotes description)
"Check whether DESCRIPTION contains single quotes and suggest @code."
- (when (regexp-exec %quoted-identifier-rx description)
- (emit-warning package
-
- ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
- ;; as is.
- (G_ "use @code or similar ornament instead of quotes")
- 'description)))
+ (if (regexp-exec %quoted-identifier-rx description)
+ (list
+ (make-warning package
+ ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
+ ;; as is.
+ (G_ "use @code or similar ornament instead of quotes")
+ #: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)))
+ (if (or (string-null? description)
+ (properly-starts-sentence? description)
+ (string-prefix-ci? (package-name package) description))
+ '()
+ (list
+ (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."
@@ -219,28 +238,33 @@ trademark sign '~a' at ~d")
(string-suffix-ci? s (match:prefix m)))
'("i.e" "e.g" "a.k.a" "resp"))
r (cons (match:start m) r)))))))
- (unless (null? infractions)
- (emit-warning package
- (format #f (G_ "sentences in description should be followed ~
+ (if (null? infractions)
+ '()
+ (list
+ (make-warning package
+ (format #f (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
- (length infractions)
- infractions)
- 'description))))
+ (length infractions)
+ infractions)
+ #: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
- (format #f (G_ "invalid description: ~s") description)
- 'description))))
+ (append
+ (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)
+ (match (check-texinfo-markup description)
+ ((and warning (? lint-warning?)) (list warning))
+ (plain-description
+ (check-proper-start plain-description))))
+ (list
+ (make-warning package
+ (format #f (G_ "invalid description: ~s") 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 +305,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 +320,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
@@ -314,66 +339,71 @@ line."
(define (check-synopsis-style package)
;; 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
- (G_ "synopsis should not be empty")
- '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
- (G_ "no period allowed at the end of the synopsis")
- 'synopsis)))
+ (if (and (string-suffix? "." synopsis)
+ (not (string-suffix? "etc." synopsis)))
+ (list
+ (make-warning package
+ (G_ "no period allowed at the end of the synopsis")
+ #:field 'synopsis))
+ '()))
(define check-start-article
;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
;; <http://lists.gnu.org/archive/html/bug-womb/2014-11/msg00000.html>.
(if (false-if-exception (gnu-package? package))
- (const #t)
+ (const '())
(lambda (synopsis)
- (when (or (string-prefix-ci? "A " synopsis)
- (string-prefix-ci? "An " synopsis))
- (emit-warning package
- (G_ "no article allowed at the beginning of \
+ (if (or (string-prefix-ci? "A " synopsis)
+ (string-prefix-ci? "An " synopsis))
+ (list
+ (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
- (G_ "synopsis should be less than 80 characters long")
- 'synopsis)))
+ (if (>= (string-length synopsis) 80)
+ (list
+ (make-warning package
+ (G_ "synopsis should be less than 80 characters long")
+ #:field 'synopsis))
+ '()))
(define (check-proper-start synopsis)
- (unless (properly-starts-sentence? synopsis)
- (emit-warning package
- (G_ "synopsis should start with an upper-case letter or digit")
- 'synopsis)))
+ (if (properly-starts-sentence? synopsis)
+ '()
+ (list
+ (make-warning package
+ (G_ "synopsis should start with an upper-case letter or digit")
+ #:field 'synopsis))))
(define (check-start-with-package-name synopsis)
- (when (and (regexp-exec (package-name-regexp package) synopsis)
+ (if (and (regexp-exec (package-name-regexp package) synopsis)
(not (starts-with-abbreviation? synopsis)))
- (emit-warning package
- (G_ "synopsis should not start with the package name")
- 'synopsis)))
+ (list
+ (make-warning package
+ (G_ "synopsis should not start with the package name")
+ #:field 'synopsis))
+ '()))
(define (check-texinfo-markup synopsis)
"Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
(catch #t
- (lambda () (texi->plain-text synopsis))
+ (lambda ()
+ (texi->plain-text synopsis)
+ '())
(lambda (keys . args)
- (emit-warning package
-
This message was truncated. Download the full message here.
Christopher Baines wrote 6 years ago
[PATCH 2/4] scripts: lint: Separate the message warning text and data.
(address . 35790@debbugs.gnu.org)
20190715194558.13804-2-mail@cbaines.net
So that translations can be handled more flexibly, rather than having to
translate the message text within the checker.

* guix/scripts/lint.scm (lint-warning-message-text,
lint-warning-message-data): New procedures.
(lint-warning-message): Remove record field accessor, replace with procedure
that handles the lint warning data and translating the message.
(make-warning): Rename to %make-warning.
(make-warning): New macro.
(emit-warnings): Handle the message-text and message-data fields.
(check-description-style): Adjust for changes to make-warning.
[check-trademarks, check-end-of-sentence-space): Adjust for changes to
make-warning.
(check-inputs-should-be-native, check-inputs-should-not-be-an-input-at-all,
check-synopsis-style, validate-uri, check-home-page, check-patch-file-names,
check-gnu-synopsis+description, check-mirror-url, check-github-url,
check-derivation, check-vulnerabilities, check-for-updates,
report-tabulations, report-trailing-white-space, report-long-line,
report-lone-parentheses): Adjust for changes to make-warning.
---
guix/scripts/lint.scm | 198 ++++++++++++++++++++++--------------------
1 file changed, 106 insertions(+), 92 deletions(-)

Toggle diff (429 lines)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 1b08068669..4eb7e0e200 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -88,6 +88,8 @@
lint-warning?
lint-warning-package
lint-warning-message
+ lint-warning-message-text
+ lint-warning-message-data
lint-warning-location
%checkers
@@ -105,35 +107,49 @@
(define-record-type* <lint-warning>
lint-warning make-lint-warning
lint-warning?
- (package lint-warning-package)
- (message lint-warning-message)
- (location lint-warning-location
- (default #f)))
+ (package lint-warning-package)
+ (message-text lint-warning-message-text)
+ (message-data lint-warning-message-data
+ (default '()))
+ (location lint-warning-location
+ (default #f)))
+
+(define (lint-warning-message warning)
+ (apply format #f
+ (G_ (lint-warning-message-text warning))
+ (lint-warning-message-data warning)))
(define (package-file package)
(location-file
(package-location package)))
-(define* (make-warning package message
- #:key field location)
+(define* (%make-warning package message-text
+ #:optional (message-data '())
+ #:key field location)
(make-lint-warning
package
- message
+ message-text
+ message-data
(or location
(package-field-location package field)
(package-location package))))
+(define-syntax make-warning
+ (syntax-rules (G_)
+ ((_ package (G_ message) rest ...)
+ (%make-warning package message rest ...))))
+
(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.
(for-each
(match-lambda
- (($ <lint-warning> package message loc)
+ (($ <lint-warning> package message-text message-data loc)
(format (guix-warning-port) "~a: ~a@~a: ~a~%"
(location->string loc)
(package-name package) (package-version package)
- message)))
+ (apply format #f (G_ message-text) message-data))))
warnings))
@@ -199,9 +215,9 @@ http://www.gnu.org/prep/standards/html_node/Trademarks.html."
((and (? number?) index)
(list
(make-warning package
- (format #f (G_ "description should not contain ~
+ (G_ "description should not contain ~
trademark sign '~a' at ~d")
- (string-ref description index) index)
+ (list (string-ref description index) index)
#:field 'description)))
(else '())))
@@ -242,10 +258,10 @@ trademark sign '~a' at ~d")
'()
(list
(make-warning package
- (format #f (G_ "sentences in description should be followed ~
+ (G_ "sentences in description should be followed ~
by two spaces; possible infraction~p at ~{~a~^, ~}")
- (length infractions)
- infractions)
+ (list (length infractions)
+ infractions)
#:field 'description)))))
(let ((description (package-description package)))
@@ -263,7 +279,8 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
(check-proper-start plain-description))))
(list
(make-warning package
- (format #f (G_ "invalid description: ~s") description)
+ (G_ "invalid description: ~s")
+ (list description)
#:field 'description)))))
(define (package-input-intersection inputs-to-check input-names)
@@ -308,8 +325,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(map (lambda (input)
(make-warning
package
- (format #f (G_ "'~a' should probably be a native input")
- input)
+ (G_ "'~a' should probably be a native input")
+ (list input)
#:field 'inputs))
(package-input-intersection inputs input-names))))
@@ -323,9 +340,8 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(map (lambda (input)
(make-warning
package
- (format #f
- (G_ "'~a' should probably not be an input at all")
- input)
+ (G_ "'~a' should probably not be an input at all")
+ (list input)
#:field 'inputs))
(package-input-intersection (package-direct-inputs package)
input-names))))
@@ -423,7 +439,9 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
checks))
(invalid
(list
- (make-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
+ (make-warning package
+ (G_ "invalid synopsis: ~s")
+ (list invalid)
#:field 'synopsis)))))
(define* (probe-uri uri #:key timeout)
@@ -540,64 +558,59 @@ PACKAGE mentionning the FIELD."
;; such malicious behavior.
(or (> length 1000)
(make-warning package
- (format #f
- (G_ "URI ~a returned \
+ (G_ "URI ~a returned \
suspiciously small file (~a bytes)")
- (uri->string uri)
- length)
+ (list (uri->string uri)
+ length)
#:field field)))
(_ #t)))
((= 301 (response-code argument))
(if (response-location argument)
(make-warning package
- (format #f (G_ "permanent redirect from ~a to ~a")
- (uri->string uri)
- (uri->string
- (response-location argument)))
+ (G_ "permanent redirect from ~a to ~a")
+ (list (uri->string uri)
+ (uri->string
+ (response-location argument)))
#:field field)
(make-warning package
- (format #f (G_ "invalid permanent redirect \
+ (G_ "invalid permanent redirect \
from ~a")
- (uri->string uri))
+ (list (uri->string uri))
#:field field)))
(else
(make-warning package
- (format #f
- (G_ "URI ~a not reachable: ~a (~s)")
- (uri->string uri)
- (response-code argument)
- (response-reason-phrase argument))
+ (G_ "URI ~a not reachable: ~a (~s)")
+ (list (uri->string uri)
+ (response-code argument)
+ (response-reason-phrase argument))
#:field field))))
((ftp-response)
(match argument
(('ok) #t)
(('error port command code message)
(make-warning package
- (format #f
- (G_ "URI ~a not reachable: ~a (~s)")
- (uri->string uri)
- code (string-trim-both message))
+ (G_ "URI ~a not reachable: ~a (~s)")
+ (list (uri->string uri)
+ code (string-trim-both message))
#:field field))))
((getaddrinfo-error)
(make-warning package
- (format #f
- (G_ "URI ~a domain not found: ~a")
- (uri->string uri)
- (gai-strerror (car argument)))
+ (G_ "URI ~a domain not found: ~a")
+ (list (uri->string uri)
+ (gai-strerror (car argument)))
#:field field))
((system-error)
(make-warning package
- (format #f
- (G_ "URI ~a unreachable: ~a")
- (uri->string uri)
- (strerror
- (system-error-errno
- (cons status argument))))
+ (G_ "URI ~a unreachable: ~a")
+ (list (uri->string uri)
+ (strerror
+ (system-error-errno
+ (cons status argument))))
#:field field))
((tls-certificate-error)
(make-warning package
- (format #f (G_ "TLS certificate error: ~a")
- (tls-certificate-error-string argument))
+ (G_ "TLS certificate error: ~a")
+ (list (tls-certificate-error-string argument))
#:field field))
((invalid-http-response gnutls-error)
;; Probably a misbehaving server; ignore.
@@ -627,8 +640,9 @@ from ~a")
#:field 'home-page))))
(else
(list
- (make-warning package (format #f (G_ "invalid home page URL: ~s")
- (package-home-page package))
+ (make-warning package
+ (G_ "invalid home page URL: ~s")
+ (list (package-home-page package))
#:field 'home-page))))))
(define %distro-directory
@@ -640,8 +654,10 @@ from ~a")
patch could not be found."
(guard (c ((message-condition? c) ;raised by 'search-patch'
(list
- (make-warning package (condition-message c)
- #:field 'patch-file-names))))
+ ;; Use %make-warning, as condition-mesasge is already
+ ;; translated.
+ (%make-warning package (condition-message c)
+ #:field 'patch-file-names))))
(define patches
(or (and=> (package-source package) origin-patches)
'()))
@@ -674,8 +690,8 @@ patch could not be found."
max)
(make-warning
package
- (format #f (G_ "~a: file name is too long")
- (basename patch))
+ (G_ "~a: file name is too long")
+ (list (basename patch))
#:field 'patch-file-names)
#f))
(_ #f))
@@ -716,8 +732,8 @@ descriptions maintained upstream."
(not (string=? upstream downstream))))
(list
(make-warning package
- (format #f (G_ "proposed synopsis: ~s~%")
- upstream)
+ (G_ "proposed synopsis: ~s~%")
+ (list upstream)
#:field 'synopsis))
'()))
@@ -730,9 +746,8 @@ descriptions maintained upstream."
(list
(make-warning
package
- (format #f
- (G_ "proposed description:~% \"~a\"~%")
- (fill-paragraph (escape-quotes upstream) 77 7))
+ (G_ "proposed description:~% \"~a\"~%")
+ (list (fill-paragraph (escape-quotes upstream) 77 7))
#:field 'description))
'()))))))
@@ -831,10 +846,10 @@ descriptions maintained upstream."
(loop rest))
(prefix
(make-warning package
- (format #f (G_ "URL should be \
+ (G_ "URL should be \
'mirror://~a/~a'")
- mirror-id
- (string-drop uri (string-length prefix)))
+ (list mirror-id
+ (string-drop uri (string-length prefix)))
#:field 'source)))))))
(let ((origin (package-source package)))
@@ -876,7 +891,8 @@ descriptions maintained upstream."
#f
(make-warning
package
- (format #f (G_ "URL should be '~a'") github-uri)
+ (G_ "URL should be '~a'")
+ (list github-uri)
#:field 'source)))))
(origin-uris origin))
'())))
@@ -888,14 +904,14 @@ descriptions maintained upstream."
(lambda ()
(guard (c ((store-protocol-error? c)
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~a")
- system
- (store-protocol-error-message c))))
+ (G_ "failed to create ~a derivation: ~a")
+ (list system
+ (store-protocol-error-message c))))
((message-condition? c)
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~a")
- system
- (condition-message c)))))
+ (G_ "failed to create ~a derivation: ~a")
+ (list system
+ (condition-message c)))))
(with-store store
;; Disable grafts since it can entail rebuilds.
(parameterize ((%graft? #f))
@@ -910,8 +926,8 @@ descriptions maintained upstream."
#:graft? #f)))))))
(lambda args
(make-warning package
- (format #f (G_ "failed to create ~a derivation: ~s")
- system args)))))
+ (G_ "failed to create ~a derivation: ~s")
+ (list system args)))))
(filter lint-warning?
(map try (package-supported-systems package))))
@@ -1001,15 +1017,15 @@ the NIST server non-fatal."
(list
(make-warning
package
- (format #f (G_ "probably vulnerable to ~a")
- (string-join (map vulnerability-id unpatched)
- ", "))))))))))
+ (G_ "probably vulnerable to ~a")
+ (list (string-join (map vulnerability-id unpatched)
+ ", "))))))))))
(define (check-for-updates package)
"Check if there is an update available for PACKAGE."
(match (with-networking-fail-safe
- (format #f (G_ "while retrieving upstream info for '~a'")
- (package-name package))
+ (G_ "while retrieving upstream info for '~a'")
+ (list (package-name package))
#f
(package-latest-release* package (force %updaters)))
((? upstream-source? source)
@@ -1017,8 +1033,8 @@ the NIST server non-fatal."
(package-version package))
(list
(make-warning package
- (format #f (G_ "can be upgraded to ~a")
- (upstream-source-version source))
+ (G_ "can be upgraded to ~a")
+ (list (upstream-source-version source))
#:field 'version))
'()))
(#f '()))) ; cannot find newer upstream release
@@ -1034,8 +1050,8 @@ the NIST server non-fatal."
(#f #t)
(index
(make-warning package
- (format #f (G_ "tabulation on line ~a, column ~a")
- line-number index)
+ (G_ "tabulation on line ~a, column ~a")
+ (list line-number index)
#:location
(location (package-file package)
line-number
@@ -1046,9 +1062,8 @@ the NIST server non-fatal."
(unless (or (string=? line (string-trim-right line))
(string=? line (string #\page)))
(make-warning package
- (format #f
- (G_ "trailing white space on line ~a")
- line-number)
+ (G_ "trailing white space on line ~a")
+ (list line-number)
#:location
(location (package-file package)
line-number
@@ -1061,8 +1076,8 @@ the NIST server non-fatal."
;; much noise.
(when (> (string-length line) 90)
(make-warning package
- (format #f (G_ "line ~a is way too long (~a characters)")
- line-number (string-length line))
+ (G_ "line ~a is way too long (~a characters)")
+ (list line-number (string-length line))
#:location
(location (package-file package)
line-number
@@ -1075,10 +1090,9 @@ the NIST server non-fatal."
"Emit a warning if LINE contains hanging parentheses."
(when (regexp-exec %hanging-paren-rx line)
(make-warning package
- (format #f
- (G_ "parentheses feel lonely, \
+ (G_ "parentheses feel lonely, \
move to the previous or next line")
- line-number)
+ (list line-number)
#:location
(location (package-file package)
line-number
--
2.22.0
Christopher Baines wrote 6 years ago
[PATCH 4/4] lint: Separate checkers by dependence on the internet.
(address . 35790@debbugs.gnu.org)
20190715194558.13804-4-mail@cbaines.net
I think there are a couple of potential uses for this. It's somewhat a
separation in to what checkers are just checking the contents of the
repository (line length for example), and other checkers which are bringing in
external information which could change.

I'm thinking particularly, about treating network dependent checkers
differently when automatically running them, but this commit also adds a
--no-network flag to guix lint, which selects the checkers that don't access
the network, which could be useful if no network access is available.

* guix/lint.scm (%checkers): Rename to %all-checkers.
(%local-checkers, %network-dependent-checkers): New variables.
* guix/scripts/lint.scm (run-checkers): Make the checkers argument mandatory.
(list-checkers-and-exit): Handle the checkers as an argument.
(%options): Adjust for changes to %checkers, add a --no-network option, and
change how the --list-checkers option is handled.
(guix-lint): Adjust indentation, and update how the checkers are handled.
---
guix/lint.scm | 63 ++++++++++++++++++++++++-------------------
guix/scripts/lint.scm | 49 ++++++++++++++++++++-------------
2 files changed, 66 insertions(+), 46 deletions(-)

Toggle diff (219 lines)
diff --git a/guix/lint.scm b/guix/lint.scm
index c2c0914958..2542a81a2d 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -91,7 +91,9 @@
lint-warning-message-data
lint-warning-location
- %checkers
+ %local-checkers
+ %network-dependent-checkers
+ %all-checkers
lint-checker
lint-checker?
@@ -1146,16 +1148,12 @@ them for PACKAGE."
;;; List of checkers.
;;;
-(define %checkers
+(define %local-checkers
(list
(lint-checker
(name 'description)
(description "Validate package descriptions")
(check check-description-style))
- (lint-checker
- (name 'gnu-description)
- (description "Validate synopsis & description of GNU packages")
- (check check-gnu-synopsis+description))
(lint-checker
(name 'inputs-should-be-native)
(description "Identify inputs that should be native inputs")
@@ -1164,14 +1162,6 @@ them for PACKAGE."
(name 'inputs-should-not-be-input)
(description "Identify inputs that shouldn't be inputs at all")
(check check-inputs-should-not-be-an-input-at-all))
- (lint-checker
- (name 'patch-file-names)
- (description "Validate file names and availability of patches")
- (check check-patch-file-names))
- (lint-checker
- (name 'home-page)
- (description "Validate home-page URLs")
- (check check-home-page))
(lint-checker
(name 'license)
;; TRANSLATORS: <license> is the name of a data type and must not be
@@ -1179,18 +1169,10 @@ them for PACKAGE."
(description "Make sure the 'license' field is a <license> \
or a list thereof")
(check check-license))
- (lint-checker
- (name 'source)
- (description "Validate source URLs")
- (check check-source))
(lint-checker
(name 'mirror-url)
(description "Suggest 'mirror://' URLs")
(check check-mirror-url))
- (lint-checker
- (name 'github-url)
- (description "Suggest GitHub URLs")
- (check check-github-url))
(lint-checker
(name 'source-file-name)
(description "Validate file names of sources")
@@ -1203,10 +1185,37 @@ or a list thereof")
(name 'derivation)
(description "Report failure to compile a package to a derivation")
(check check-derivation))
+ (lint-checker
+ (name 'patch-file-names)
+ (description "Validate file names and availability of patches")
+ (check check-patch-file-names))
+ (lint-checker
+ (name 'formatting)
+ (description "Look for formatting issues in the source")
+ (check check-formatting))))
+
+(define %network-dependent-checkers
+ (list
(lint-checker
(name 'synopsis)
(description "Validate package synopses")
(check check-synopsis-style))
+ (lint-checker
+ (name 'gnu-description)
+ (description "Validate synopsis & description of GNU packages")
+ (check check-gnu-synopsis+description))
+ (lint-checker
+ (name 'home-page)
+ (description "Validate home-page URLs")
+ (check check-home-page))
+ (lint-checker
+ (name 'source)
+ (description "Validate source URLs")
+ (check check-source))
+ (lint-checker
+ (name 'github-url)
+ (description "Suggest GitHub URLs")
+ (check check-github-url))
(lint-checker
(name 'cve)
(description "Check the Common Vulnerabilities and Exposures\
@@ -1215,8 +1224,8 @@ or a list thereof")
(lint-checker
(name 'refresh)
(description "Check the package for new upstream releases")
- (check check-for-updates))
- (lint-checker
- (name 'formatting)
- (description "Look for formatting issues in the source")
- (check check-formatting))))
+ (check check-for-updates))))
+
+(define %all-checkers
+ (append %local-checkers
+ %network-dependent-checkers))
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 1c46fba16b..98ee469501 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -52,7 +52,7 @@
(lint-warning-message lint-warning))))
warnings))
-(define* (run-checkers package #:optional (checkers %checkers))
+(define (run-checkers package checkers)
"Run the given CHECKERS on PACKAGE."
(let ((tty? (isatty? (current-error-port))))
(for-each (lambda (checker)
@@ -68,14 +68,14 @@
(format (current-error-port) "\x1b[K")
(force-output (current-error-port)))))
-(define (list-checkers-and-exit)
+(define (list-checkers-and-exit checkers)
;; Print information about all available checkers and exit.
(format #t (G_ "Available checkers:~%"))
(for-each (lambda (checker)
(format #t "- ~a: ~a~%"
(lint-checker-name checker)
(G_ (lint-checker-description checker))))
- %checkers)
+ checkers)
(exit 0))
@@ -111,26 +111,33 @@ run the checkers on all packages.\n"))
;; 'certainty'.
(list (option '(#\c "checkers") #t #f
(lambda (opt name arg result)
- (let ((names (map string->symbol (string-split arg #\,))))
+ (let ((names (map string->symbol (string-split arg #\,)))
+ (checker-names (map lint-checker-name %all-checkers)))
(for-each (lambda (c)
- (unless (memq c
- (map lint-checker-name
- %checkers))
+ (unless (memq c checker-names)
(leave (G_ "~a: invalid checker~%") c)))
names)
(alist-cons 'checkers
(filter (lambda (checker)
(member (lint-checker-name checker)
names))
- %checkers)
+ %all-checkers)
result))))
+ (option '(#\n "no-network") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'checkers
+ %local-checkers
+ (alist-delete 'checkers
+ result))))
(option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\l "list-checkers") #f #f
- (lambda args
- (list-checkers-and-exit)))
+ (lambda (opt name arg result)
+ (alist-cons 'list?
+ #t
+ result)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix lint")))))
@@ -148,13 +155,17 @@ run the checkers on all packages.\n"))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
- (('argument . value)
- value)
- (_ #f))
+ (('argument . value)
+ value)
+ (_ #f))
(reverse opts)))
- (checkers (or (assoc-ref opts 'checkers) %checkers)))
- (if (null? args)
- (fold-packages (lambda (p r) (run-checkers p checkers)) '())
- (for-each (lambda (spec)
- (run-checkers (specification->package spec) checkers))
- args))))
+ (checkers (or (assoc-ref opts 'checkers) %all-checkers)))
+ (cond
+ ((assoc-ref opts 'list?)
+ (list-checkers-and-exit checkers))
+ ((null? args)
+ (fold-packages (lambda (p r) (run-checkers p checkers)) '()))
+ (else
+ (for-each (lambda (spec)
+ (run-checkers (specification->package spec) checkers))
+ args)))))
--
2.22.0
Christopher Baines wrote 6 years ago
[PATCH 3/4] lint: Move the linting code to a different module.
(address . 35790@debbugs.gnu.org)
20190715194558.13804-3-mail@cbaines.net
To try and move towards making programatic access to the linting code easier,
this commit separates out the linting script, from the linting functionality
that it uses.

* guix/scripts/lint.scm (emit-warnings): Alter to to not use match-lambda, as
<lint-warning> isn't accessible.
(<lint-warning>, lint-warning, make-lint-warning, lint-warning?,
lint-warning-message, lint-warning-message-text, lint-warning-message-data,
lint-warning-location, package-file, %make-warning make-warning,
<lint-checker>, lint-checker, make-lint-checker, lint-checker?,
lint-checker-name, lint-checker-description, lint-checker-check,
properly-starts-sentance?, starts-with-abbreviation?, %quoted-identifier-rx,
check-description-style, package-input-intersection,
check-inputs-should-be-native, check-inputs-should-not-be-an-input-at-all,
package-name-regexp, check-synopsis-style, probe-uri,
tls-certificate-error-string, validate-uri, check-home-page,
%distro-directory, check-patch-file-names, escape-quotes,
official-gnu-packages*, check-gnu-synopsis+description, origin-uris,
check-source, check-source-file-name, check-source-unstable-tarball,
check-mirror-url, check-github-url, check-derivation, check-license,
call-with-networking-fail-safe, with-networking-fail-safe,
current-vulnerabilities*, package-vulnerabilities, check-vulnerabilities,
check-for-updates, report-tabulations, report-trailing-white-space,
report-long-line, %hanging-paren-rx, report-lone-parantheses,
%formatting-reporters, report-formatting-issues, check-formatting, %checkers):
Move to…
* guix/lint.scm: … here
* po/guix/POTFILES.in: Add guix/lint.scm.
* Makefile.am: Add guix/lint.scm.
* tests/lint.scm: Change to import (guix lint), rather than (guix scripts lint).
---
Makefile.am | 1 +
guix/lint.scm | 1222 +++++++++++++++++++++++++++++++++++++++++
guix/scripts/lint.scm | 1220 +---------------------------------------
po/guix/POTFILES.in | 1 +
tests/lint.scm | 2 +-
5 files changed, 1244 insertions(+), 1202 deletions(-)
create mode 100644 guix/lint.scm

Toggle diff (480 lines)
diff --git a/Makefile.am b/Makefile.am
index bb7156458c..b63c55d784 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -98,6 +98,7 @@ MODULES = \
guix/self.scm \
guix/upstream.scm \
guix/licenses.scm \
+ guix/lint.scm \
guix/glob.scm \
guix/git.scm \
guix/graph.scm \
diff --git a/guix/lint.scm b/guix/lint.scm
new file mode 100644
index 0000000000..c2c0914958
--- /dev/null
+++ b/guix/lint.scm
@@ -0,0 +1,1222 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
+;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
+;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix lint)
+ #:use-module ((guix store) #:hide (close-connection))
+ #:use-module (guix base32)
+ #:use-module (guix diagnostics)
+ #:use-module (guix download)
+ #:use-module (guix ftp-client)
+ #:use-module (guix http-client)
+ #:use-module (guix packages)
+ #:use-module (guix i18n)
+ #:use-module (guix licenses)
+ #:use-module (guix records)
+ #:use-module (guix grafts)
+ #:use-module (guix upstream)
+ #:use-module (guix utils)
+ #:use-module (guix memoization)
+ #:use-module (guix scripts)
+ #:use-module ((guix ui) #:select (texi->plain-text fill-paragraph))
+ #:use-module (guix gnu-maintenance)
+ #:use-module (guix monads)
+ #:use-module (guix cve)
+ #:use-module (gnu packages)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 format)
+ #:use-module (web client)
+ #:use-module (web uri)
+ #:use-module ((guix build download)
+ #:select (maybe-expand-mirrors
+ (open-connection-for-uri
+ . guix:open-connection-for-uri)
+ close-connection))
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-6) ;Unicode string ports
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (ice-9 rdelim)
+ #:export (check-description-style
+ check-inputs-should-be-native
+ check-inputs-should-not-be-an-input-at-all
+ check-patch-file-names
+ check-synopsis-style
+ check-derivation
+ check-home-page
+ check-source
+ check-source-file-name
+ check-source-unstable-tarball
+ check-mirror-url
+ check-github-url
+ check-license
+ check-vulnerabilities
+ check-for-updates
+ check-formatting
+
+ lint-warning
+ lint-warning?
+ lint-warning-package
+ lint-warning-message
+ lint-warning-message-text
+ lint-warning-message-data
+ lint-warning-location
+
+ %checkers
+
+ lint-checker
+ lint-checker?
+ lint-checker-name
+ lint-checker-description
+ lint-checker-check))
+
+
+;;;
+;;; Warnings
+;;;
+
+(define-record-type* <lint-warning>
+ lint-warning make-lint-warning
+ lint-warning?
+ (package lint-warning-package)
+ (message-text lint-warning-message-text)
+ (message-data lint-warning-message-data
+ (default '()))
+ (location lint-warning-location
+ (default #f)))
+
+(define (lint-warning-message warning)
+ (apply format #f
+ (G_ (lint-warning-message-text warning))
+ (lint-warning-message-data warning)))
+
+(define (package-file package)
+ (location-file
+ (package-location package)))
+
+(define* (%make-warning package message-text
+ #:optional (message-data '())
+ #:key field location)
+ (make-lint-warning
+ package
+ message-text
+ message-data
+ (or location
+ (package-field-location package field)
+ (package-location package))))
+
+(define-syntax make-warning
+ (syntax-rules (G_)
+ ((_ package (G_ message) rest ...)
+ (%make-warning package message rest ...))))
+
+
+;;;
+;;; Checkers
+;;;
+
+(define-record-type* <lint-checker>
+ lint-checker make-lint-checker
+ lint-checker?
+ ;; TODO: add a 'certainty' field that shows how confident we are in the
+ ;; checker. Then allow users to only run checkers that have a certain
+ ;; 'certainty' level.
+ (name lint-checker-name)
+ (description lint-checker-description)
+ (check lint-checker-check))
+
+(define (properly-starts-sentence? s)
+ (string-match "^[(\"'`[:upper:][:digit:]]" s))
+
+(define (starts-with-abbreviation? s)
+ "Return #t if S starts with what looks like an abbreviation or acronym."
+ (string-match "^[A-Z][A-Z0-9]+\\>" s))
+
+(define %quoted-identifier-rx
+ ;; A quoted identifier, like 'this'.
+ (make-regexp "['`][[:graph:]]+'"))
+
+(define (check-description-style package)
+ ;; Emit a warning if stylistic issues are found in the description of PACKAGE.
+ (define (check-not-empty description)
+ (if (string-null? description)
+ (list
+ (make-warning package
+ (G_ "description should not be empty")
+ #:field 'description))
+ '()))
+
+ (define (check-texinfo-markup description)
+ "Check that DESCRIPTION can be parsed as a Texinfo fragment. If the
+markup is valid return a plain-text version of DESCRIPTION, otherwise #f."
+ (catch #t
+ (lambda () (texi->plain-text description))
+ (lambda (keys . args)
+ (make-warning package
+ (G_ "Texinfo markup in description is invalid")
+ #: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)
+ (list
+ (make-warning package
+ (G_ "description should not contain ~
+trademark sign '~a' at ~d")
+ (list (string-ref description index) index)
+ #:field 'description)))
+ (else '())))
+
+ (define (check-quotes description)
+ "Check whether DESCRIPTION contains single quotes and suggest @code."
+ (if (regexp-exec %quoted-identifier-rx description)
+ (list
+ (make-warning package
+ ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
+ ;; as is.
+ (G_ "use @code or similar ornament instead of quotes")
+ #:field 'description))
+ '()))
+
+ (define (check-proper-start description)
+ (if (or (string-null? description)
+ (properly-starts-sentence? description)
+ (string-prefix-ci? (package-name package) description))
+ '()
+ (list
+ (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."
+ (let ((infractions
+ (reverse (fold-matches
+ "\\. [A-Z]" description '()
+ (lambda (m r)
+ ;; Filter out matches of common abbreviations.
+ (if (find (lambda (s)
+ (string-suffix-ci? s (match:prefix m)))
+ '("i.e" "e.g" "a.k.a" "resp"))
+ r (cons (match:start m) r)))))))
+ (if (null? infractions)
+ '()
+ (list
+ (make-warning package
+ (G_ "sentences in description should be followed ~
+by two spaces; possible infraction~p at ~{~a~^, ~}")
+ (list (length infractions)
+ infractions)
+ #:field 'description)))))
+
+ (let ((description (package-description package)))
+ (if (string? description)
+ (append
+ (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)
+ (match (check-texinfo-markup description)
+ ((and warning (? lint-warning?)) (list warning))
+ (plain-description
+ (check-proper-start plain-description))))
+ (list
+ (make-warning package
+ (G_ "invalid description: ~s")
+ (list description)
+ #:field 'description)))))
+
+(define (package-input-intersection inputs-to-check input-names)
+ "Return the intersection between INPUTS-TO-CHECK, the list of input tuples
+of a package, and INPUT-NAMES, a list of package specifications such as
+\"glib:bin\"."
+ (match inputs-to-check
+ (((labels packages . outputs) ...)
+ (filter-map (lambda (package output)
+ (and (package? package)
+ (let ((input (string-append
+ (package-name package)
+ (if (> (length output) 0)
+ (string-append ":" (car output))
+ ""))))
+ (and (member input input-names)
+ input))))
+ packages outputs))))
+
+(define (check-inputs-should-be-native package)
+ ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
+ ;; native inputs.
+ (let ((inputs (package-inputs package))
+ (input-names
+ '("pkg-config"
+ "cmake"
+ "extra-cmake-modules"
+ "glib:bin"
+ "intltool"
+ "itstool"
+ "qttools"
+ "python-coverage" "python2-coverage"
+ "python-cython" "python2-cython"
+ "python-docutils" "python2-docutils"
+ "python-mock" "python2-mock"
+ "python-nose" "python2-nose"
+ "python-pbr" "python2-pbr"
+ "python-pytest" "python2-pytest"
+ "python-pytest-cov" "python2-pytest-cov"
+ "python-setuptools-scm" "python2-setuptools-scm"
+ "python-sphinx" "python2-sphinx")))
+ (map (lambda (input)
+ (make-warning
+ package
+ (G_ "'~a' should probably be a native input")
+ (list 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
+ ;; an input at all.
+ (let ((input-names '("python-setuptools"
+ "python2-setuptools"
+ "python-pip"
+ "python2-pip")))
+ (map (lambda (input)
+ (make-warning
+ package
+ (G_ "'~a' should probably not be an input at all")
+ (list 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
+line."
+ (make-regexp (string-append "^" (regexp-quote (package-name package))
+ "\\>")
+ regexp/icase))
+
+(define (check-synopsis-style package)
+ ;; Emit a warning if stylistic issues are found in the synopsis of PACKAGE.
+ (define (check-final-period synopsis)
+ ;; Synopsis should not end with a period, except for some special cases.
+ (if (and (string-suffix? "." synopsis)
+ (not (string-suffix? "etc." synopsis)))
+ (list
+ (make-warning package
+ (G_ "no period allowed at the end of the synopsis")
+ #:field 'synopsis))
+ '()))
+
+ (define check-start-article
+ ;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
+ ;; <http://lists.gnu.org/archive/html/bug-womb/2014-11/msg00000.html>.
+ (if (false-if-exception (gnu-package? package))
+ (const '())
+ (lambda (synopsis)
+ (if (or (string-prefix-ci? "A " synopsis)
+ (string-prefix-ci? "An " synopsis))
+ (list
+ (make-warning package
+ (G_ "no article allowed at the beginning of \
+the synopsis")
+ #:field 'synopsis))
+ '()))))
+
+ (define (check-synopsis-length synopsis)
+ (if (>= (string-length synopsis) 80)
+ (list
+ (make-warning package
+ (G_ "synopsis should be less than 80 characters long")
+ #:field 'synopsis))
+ '()))
+
+ (define (check-proper-start synopsis)
+ (if (properly-starts-sentence? synopsis)
+ '()
+ (list
+ (make-warning package
+ (G_ "synopsis should start with an upper-case letter or digit")
+ #:field 'synopsis))))
+
+ (define (check-start-with-package-name synopsis)
+ (if (and (regexp-exec (package-name-regexp package) synopsis)
+ (not (starts-with-abbreviation? synopsis)))
+ (list
+ (make-warning package
+ (G_ "synopsis should not start with the package name")
+ #:field 'synopsis))
+ '()))
+
+ (define (check-texinfo-markup synopsis)
+ "Check that SYNOPSIS can be parsed as a Texinfo fragment. If the
+markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
+ (catch #t
+ (lambda ()
+ (texi->plain-text synopsis)
+ '())
+ (lambda (keys . args)
+ (list
+ (make-warning package
+ (G_ "Texinfo markup in synopsis is invalid")
+ #:field 'synopsis)))))
+
+ (define checks
+ (list check-proper-start
+ check-final-period
+ check-start-article
+ check-start-with-package-name
+ check-synopsis-length
+ check-texinfo-markup))
+
+ (match (package-synopsis package)
+ (""
+ (list
+ (make-warning package
+ (G_ "synopsis should not be empty")
+ #:field 'synopsis)))
+ ((? string? synopsis)
+ (append-map
+ (lambda (proc)
+ (proc synopsis))
+ checks))
+ (invalid
+ (list
+ (make-warning package
+ (G_ "invalid synopsis: ~s")
+ (list invalid)
+ #:field 'synopsis)))))
+
+(define* (probe-uri uri #:key timeout)
+ "Probe URI, a URI object, and return two values: a symbol denoting the
+probing status, such as 'http-response' when we managed to get an HTTP
+response from URI, and additional details, such as the actual HTTP response.
+
+TIMEOUT is the maximum number of seconds (possibly an inexact number) to wait
+for connections to complete; when TIMEOUT is #f, wait as long as needed."
+ (define headers
+ '((User-Agent . "GNU Guile")
+ (Accept . "*/*")))
+
+ (let loop ((uri uri)
+ (visited '()))
+ (match (uri-scheme uri)
+ ((or 'http 'https)
+ (catch #t
+ (lambda ()
+ (let ((port (guix:open-connection-for-uri
+ uri #:timeout timeout))
+ (request (build-request uri #:headers headers)))
+ (define response
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (write-request request port)
+ (force-output port)
+ (read-response port))
+ (lambda ()
+ (close-connection port))))
+
+ (case (response-code response)
+ ((302 ; found (redirection)
+ 303 ; see other
+ 307 ; temporary redirection
+ 308) ; permanent redirection
+ (let ((location (response-location response)))
+ (if (or (not location) (member location visited))
+ (values 'http-response response)
+ (loop location (cons location visited))))
This message was truncated. Download the full message here.
Christopher Baines wrote 6 years ago
Re: [bug#35790] [PATCH 1/2] lint: Move the linting code to a different module.
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790@debbugs.gnu.org)
87pnmbgjp4.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (30 lines)
> Hi Chris!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> Christopher Baines <mail@cbaines.net> skribis:
>>>
>>>> To try and move towards making programatic access to the linting code easier,
>>>> this commit separates out the linting script, from the linting functionality
>>>> that it uses.
>>>
>>> For the final version, please write a change log.
>>
>> Sure, any suggestions about how to write it? I wasn't sure whether to
>> list everything that had been moved from (guix scripts lint) to (guix
>> lint), or say that the file has moved, and list the things that have
>> been moved back.
>
> Maybe something like:
>
> * guix/scripts/lint.scm (check-foo, check-bar): Move to…
> * guix/lint.scm: … here.
>
> and also mention things that go beyond simply moving things around (if
> applicable).
>
> But again, don’t spend a whole day on this, it’s mostly so the future us
> have an easily searchable log.

Ok, I've made an initial attempt at this, and re-sent the patches.

Toggle quote (22 lines)
>> Actually, now that I've run make, that's spotted some problems in some
>> checks.
>>
>> guix/lint.scm:198:17: warning: possibly unbound variable `texi->plain-text'
>> guix/lint.scm:406:8: warning: possibly unbound variable `texi->plain-text'
>> guix/lint.scm:737:36: warning: possibly unbound variable `fill-paragraph'
>> guix/lint.scm:738:36: warning: possibly unbound variable `fill-paragraph'
>> guix/lint.scm:743:20: warning: possibly unbound variable `fill-paragraph'
>>
>> I don't think these are as easy to solve, as these functions come from
>> (guix ui).
>
> Ah yes, indeed.
>
> In that case it’s OK because (guix ui) is used as part of the linter’s
> job. Perhaps for clarity we should write:
>
> #:use-module ((guix ui) #:select (texi->plain-text fill-paragraph))
>
> Uses of the ‘warning’ procedure or similar UI functionality should be
> left to (guix scripts lint), though.

I've made this #:use-module change, and also moved emit-warnings to the
(guix scripts lint) module.

I've re-sent all 4 patches now.

Thanks,

Chris
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0s2UdfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9XfEBg/+LoK0HkkCGLgoXXkQGcuBfRdlw2FsZjT7KLp9wTa3LSpl4n6dE+aHmfqv
YnCXwDwASagb6KoILw4apYF5FreTcl+bgjwUkcTWZNoSYJaoWlPVKQ6SXN/RoTUC
SfxEtC1XXOhRV4vVkzT86Plj/+xWcvPZBm5IoRO8yPSmdQf4Mo6lder9ISGvwxSw
wPRWhnepO926ouE+OKARIYFTmAnUyFpRaLUWU8QlCxdaFAk/51gQnJvD/L/ZLAws
Ypw/haY23Ij8VOWtw5ACtz+W1GTI3L6MANxmgF+anv1Lb5WQ8QBfhrzIxaHYempx
1pgnRRPXeV1I/CBqhL6R00PxnK2hpVQxjjbGBvNKBCJrh4zwcTWQNUR5NXvHzvmX
eCD9HIGQd9URJVsI9S9PHSRoXhe8ALZz3L4FcBogT4wy9EwyCbGjf14QjnvyFhcE
eTzDDXdrjDTOQPbiWyzAxUthRZSZwjf+H2m8SJJtI/w/C5u7BwFjvgdZo9B2j1Hp
u4QFkpUCPy/kQEFFc8N/ufjDbiL4lc710FYMF6USQ0Pwzf7wtKPg8+oNEUJIaUof
NFNPrL0Q8X4r9D1uYKkaBfeawVCJzWwg9YXUU/7Z89k4SdmBm+Bwfzu5x1xAC8p9
6qnReY9J/04etHdNnUWTDuLV1uDe2hf/2t0/bv3SLK9GMIC+1L8=
=kCVm
-----END PGP SIGNATURE-----

Ludovic Courtès wrote 6 years ago
Re: [bug#35790] [PATCH 4/4] lint: Separate checkers by dependence on the internet.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790@debbugs.gnu.org)
87o91vhx2m.fsf@gnu.org
Hi!

It seems to me we’re all set now.

Thanks a lot for all the work and for your patience!

Ludo’.
Christopher Baines wrote 6 years ago
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 35790-done@debbugs.gnu.org)
87o91vgco8.fsf@cbaines.net
Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (4 lines)
> Hi!
>
> It seems to me we’re all set now.

Great, I've pushed these to master now.

Toggle quote (2 lines)
> Thanks a lot for all the work and for your patience!

No problem :)

In terms of next steps, I think this is a big bit of the work needed to
get lint warnings in to the Guix Data Service done, but there's still a
big chunk to do.

I hope to start looking at actually trying to load in the lint warnings
soon. This might involve extending the inferior API if that's helpful. I
also want to attempt to store translations for the lint warnings in one
way or another, as that'll begin to address the lack of localisation in
the Guix Data Service.

There's also some thinking about how to manage the network dependent
checkers. I'd like to get that information in anyway, but also, I think
it might be possible to maybe separate out the network independant parts
of the checkers that are currently in the network dependent list. For
example, the synopsis checker is only in there as it attempts to connect
to the network to check if packages are a GNU package, and I'm wondering
if that can be avoided.

Anyway, hopefully the code refactoring is generally helpful, and maybe
the --no-network option for guix lint will come in useful as well.

Chris
-----BEGIN PGP SIGNATURE-----

iQKTBAEBCgB9FiEEPonu50WOcg2XVOCyXiijOwuE9XcFAl0s/NhfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcACgkQXiijOwuE
9Xfe1RAAhkXJ7HF1MeKGHtxGW9Fy6L1DZFTaylcZ40/CnXHY3RZHHJIqR/54L/nN
AmuG196EAjfLOuyWPS7am4EXs0uUeAPnF0F1iKh0FDFc6Sw1F4PD4DSh2pnTREmj
fFnHEh65V10OKsmCW3ZcfIf35D/dzQW0mXNcO6Z9qwTpZmbJ0VPdMEwZPK7l3ZsU
qOXu56hqTgc7RigsWMxKYnrrrr1lPSVVcw9qDGp4Z7dz73PAYO0U9ILsBI2Odtti
ucTJxHnWHUASYR/DLN07kM4dk83sorqaYQuIcIXU30JzbBf2h/F+iVti5CSUH4kB
LBkeOcwxzzrcUKH0VgrmvB5gVWzSDVLCx/+82LdBygurgPC7vTuuPLp3FeWvO3GZ
VUG7o/Hv3lu3jLYsMJEGYoFqueomlB8vRFVO3M3wsKSebH4680lf07zeiQr8BbdK
OW6PtJs1UY+tyztT0qirkPXAWzGc0L5IotD6BiSsZydl/DA9bS6uy7uaTf4x89zT
WKRde9WXwCxzzHKtxQkk/f1ulm7U2noB6uxCH6+LofzysfZRE2I0nBSy1EbhkRsn
zVeoFAVuOK5kgSLDgSpg/lLrys2R+pivU5/34XPIeBy7Z+q82gxdEcMW7w1VvBvk
6fj3IgrR6IQDPjXmJK75ZxdfWidSUHCR2oiIyyP927NF1MxWssA=
=siiW
-----END PGP SIGNATURE-----

Closed
Ludovic Courtès wrote 6 years ago
(name . Christopher Baines)(address . mail@cbaines.net)(address . 35790-done@debbugs.gnu.org)
87ftn5ek9k.fsf@gnu.org
Hi!

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (2 lines)
> Great, I've pushed these to master now.

Yay! \o/

Toggle quote (6 lines)
> I hope to start looking at actually trying to load in the lint warnings
> soon. This might involve extending the inferior API if that's helpful. I
> also want to attempt to store translations for the lint warnings in one
> way or another, as that'll begin to address the lack of localisation in
> the Guix Data Service.

Regarding inferiors, you could always build up an “inferior lint
warning” API, similar to what’s done for <inferior-package>, and
likewise for l10n.

It needs some thought because we don’t want to mirror every single Guix
API with an inferior equivalent. So perhaps you can run a large part of
the processing in the inferior.

Toggle quote (8 lines)
> There's also some thinking about how to manage the network dependent
> checkers. I'd like to get that information in anyway, but also, I think
> it might be possible to maybe separate out the network independant parts
> of the checkers that are currently in the network dependent list. For
> example, the synopsis checker is only in there as it attempts to connect
> to the network to check if packages are a GNU package, and I'm wondering
> if that can be avoided.

Dunno, but I don’t think it’s super important either.

What might be more useful is to indicate how critical a warning is: lack
of source code is critical, but missing-space-after-period less so.

Toggle quote (3 lines)
> Anyway, hopefully the code refactoring is generally helpful, and maybe
> the --no-network option for guix lint will come in useful as well.

Definitely.

Thanks!

Ludo’.
Closed
?
Your comment

This issue is archived.

To comment on this conversation send an email to 35790@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 35790
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch
You may also tag this issue. See list of standard tags. For example, to set the confirmed and easy tags
mumi command -t +confirmed -t +easy
Or, remove the moreinfo tag and set the help tag
mumi command -t -moreinfo -t +help