M Makefile.am => Makefile.am +3 -1
@@ 89,6 89,7 @@ MODULES = \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
guix/scripts/system.scm \
+ guix/scripts/lint.scm \
guix.scm \
$(GNU_SYSTEM_MODULES)
@@ 159,7 160,8 @@ SCM_TESTS = \
tests/nar.scm \
tests/union.scm \
tests/profiles.scm \
- tests/syscalls.scm
+ tests/syscalls.scm \
+ tests/lint.scm
SH_TESTS = \
tests/guix-build.sh \
M doc/guix.texi => doc/guix.texi +28 -1
@@ 1459,7 1459,10 @@ definitions like the one above may be automatically converted from the
Nixpkgs distribution using the @command{guix import} command.}, the
package may actually be built using the @code{guix build} command-line
tool (@pxref{Invoking guix build}). @xref{Packaging Guidelines}, for
-more information on how to test package definitions.
+more information on how to test package definitions, and
+@ref{Invoking guix lint}, for information on how to check a definition
+for style conformance.
+
Eventually, updating the package definition to a new upstream version
can be partly automated by the @command{guix refresh} command
@@ 2328,6 2331,7 @@ programming interface of Guix in a convenient way.
* Invoking guix download:: Downloading a file and printing its hash.
* Invoking guix hash:: Computing the cryptographic hash of a file.
* Invoking guix refresh:: Updating package definitions.
+* Invoking guix lint:: Finding errors in package definitions.
@end menu
@node Invoking guix build
@@ 2705,6 2709,29 @@ for in @code{$PATH}.
@end table
+@node Invoking guix lint
+@section Invoking @command{guix lint}
+The @command{guix lint} is meant to help package developers avoid common
+errors and use a consistent style. It runs a few checks on a given set of
+packages in order to find common mistakes in their definitions.
+
+The general syntax is:
+
+@example
+guix lint @var{options} @var{package}@dots{}
+@end example
+
+If no package is given on the command line, then all packages are checked.
+The @var{options} may be zero or more of the following:
+
+@table @code
+
+@item --list-checkers
+@itemx -l
+List and describe all the available checkers that will be run on packages
+and exit.
+
+@end table
@c *********************************************************************
@node GNU Distribution
A guix/scripts/lint.scm => guix/scripts/lint.scm +213 -0
@@ 0,0 1,213 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
+;;;
+;;; 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 scripts lint)
+ #:use-module (guix base32)
+ #:use-module (guix packages)
+ #:use-module (guix records)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (gnu packages)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-37)
+ #:export (guix-lint
+ check-inputs-should-be-native
+ check-patches
+ check-synopsis-style))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ ;; Alist of default option values.
+ '())
+
+(define (show-help)
+ (display (_ "Usage: guix lint [OPTION]... [PACKAGE]...
+Run a set of checkers on the specified package; if none is specified, run the checkers on all packages.\n"))
+ (display (_ "
+ -h, --help display this help and exit"))
+ (display (_ "
+ -l, --list-checkers display the list of available lint checkers"))
+ (display (_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %options
+ ;; Specification of the command-line options.
+ ;; TODO: add some options:
+ ;; * --checkers=checker1,checker2...: only run the specified checkers
+ ;; * --certainty=[low,medium,high]: only run checkers that have at least this
+ ;; 'certainty'.
+ (list (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\l "list-checkers") #f #f
+ (lambda args
+ (list-checkers-and-exit)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix lint")))))
+
+
+;;;
+;;; Helpers
+;;;
+(define* (emit-warning package message #:optional field)
+ ;; 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))))
+ (warning (_ "~a: ~a: ~a~%")
+ (location->string loc)
+ (package-full-name package)
+ message)))
+
+
+;;;
+;;; 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 (list-checkers-and-exit)
+ ;; Print information about all available checkers and exit.
+ (format #t (_ "Available checkers:~%"))
+ (for-each (lambda (checker)
+ (format #t "- ~a: ~a~%"
+ (lint-checker-name checker)
+ (lint-checker-description checker)))
+ %checkers)
+ (exit 0))
+
+(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)))
+ (match inputs
+ (((labels packages . _) ...)
+ (when (member "pkg-config"
+ (map package-name (filter package? packages)))
+ (emit-warning package
+ "pkg-config should probably be a native input"
+ 'inputs))))))
+
+
+(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=? (string-take-right synopsis 1) ".")
+ (not (string=? (string-take-right synopsis 4) "etc.")))
+ (emit-warning package
+ "no period allowed at the end of the synopsis"
+ 'synopsis)))
+
+ (define (check-start-article synopsis)
+ (if (or (string=? (string-take synopsis 2) "A ")
+ (string=? (string-take synopsis 3) "An "))
+ (emit-warning package
+ "no article allowed at the beginning of the synopsis"
+ 'synopsis)))
+
+ (let ((synopsis (package-synopsis package)))
+ (if (string? synopsis)
+ (begin
+ (check-final-period synopsis)
+ (check-start-article synopsis)))))
+
+(define (check-patches package)
+ ;; Emit a warning if the patches requires by PACKAGE are badly named.
+ (let ((patches (and=> (package-source package) origin-patches))
+ (name (package-name package))
+ (full-name (package-full-name package)))
+ (if (and patches
+ (any (lambda (patch)
+ (let ((filename (basename patch)))
+ (not (or (eq? (string-contains filename name) 0)
+ (eq? (string-contains filename full-name) 0)))))
+ patches))
+ (emit-warning package
+ "file names of patches should start with the package name"
+ 'patches))))
+
+(define %checkers
+ (list
+ (lint-checker
+ (name "inputs-should-be-native")
+ (description "Identify inputs that should be native inputs")
+ (check check-inputs-should-be-native))
+ (lint-checker
+ (name "patch-filenames")
+ (description "Validate filenames of patches")
+ (check check-patches))
+ (lint-checker
+ (name "synopsis")
+ (description "Validate package synopsis")
+ (check check-synopsis-style))))
+
+(define (run-checkers package)
+ ;; Run all the checkers on PACKAGE.
+ (for-each (lambda (checker)
+ ((lint-checker-check checker) package))
+ %checkers))
+
+
+;;;
+;;; Entry Point
+;;;
+
+(define (guix-lint . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
+
+ (let* ((opts (parse-options))
+ (args (filter-map (match-lambda
+ (('argument . value)
+ value)
+ (_ #f))
+ (reverse opts))))
+
+
+ (if (null? args)
+ (fold-packages (lambda (p r) (run-checkers p)) '())
+ (for-each
+ (lambda (spec)
+ (run-checkers spec))
+ (map specification->package args)))))
M po/guix/Makevars => po/guix/Makevars +2 -1
@@ 10,7 10,8 @@ top_builddir = ../..
XGETTEXT_OPTIONS = \
--language=Scheme --from-code=UTF-8 \
--keyword=_ --keyword=N_ \
- --keyword=message
+ --keyword=message \
+ --keyword=description
COPYRIGHT_HOLDER = Ludovic Courtès
M po/guix/POTFILES.in => po/guix/POTFILES.in +1 -0
@@ 10,6 10,7 @@ guix/scripts/pull.scm
guix/scripts/substitute-binary.scm
guix/scripts/authenticate.scm
guix/scripts/system.scm
+guix/scripts/lint.scm
guix/gnu-maintenance.scm
guix/ui.scm
guix/http-client.scm
A tests/lint.scm => tests/lint.scm +110 -0
@@ 0,0 1,110 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
+;;;
+;;; 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 (test-packages)
+ #:use-module (guix build download)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix packages)
+ #:use-module (guix scripts lint)
+ #:use-module (guix ui)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages pkg-config)
+ #:use-module (srfi srfi-64))
+
+;; Test the linter.
+
+
+(test-begin "lint")
+
+(define-syntax-rule (dummy-package name* extra-fields ...)
+ (package extra-fields ... (name name*) (version "0") (source #f)
+ (build-system gnu-build-system)
+ (synopsis #f) (description #f)
+ (home-page #f) (license #f) ))
+
+(define (call-with-warnings thunk)
+ (let ((port (open-output-string)))
+ (parameterize ((guix-warning-port port))
+ (thunk))
+ (get-output-string port)))
+
+(test-assert "synopsis: ends with a period"
+ (->bool
+ (string-contains (call-with-warnings
+ (lambda ()
+ (let ((pkg (dummy-package "x"
+ (synopsis "Bad synopsis."))))
+ (check-synopsis-style pkg))))
+ "no period allowed at the end of the synopsis")))
+
+(test-assert "synopsis: ends with 'etc.'"
+ (->bool
+ (string-null? (call-with-warnings
+ (lambda ()
+ (let ((pkg (dummy-package "x"
+ (synopsis "Foo, bar, etc."))))
+ (check-synopsis-style pkg)))))))
+
+(test-assert "synopsis: starts with 'A'"
+ (->bool
+ (string-contains (call-with-warnings
+ (lambda ()
+ (let ((pkg (dummy-package "x"
+ (synopsis "A bad synopŝis"))))
+ (check-synopsis-style pkg))))
+ "no article allowed at the beginning of the synopsis")))
+
+(test-assert "synopsis: starts with 'An'"
+ (->bool
+ (string-contains (call-with-warnings
+ (lambda ()
+ (let ((pkg (dummy-package "x"
+ (synopsis "An awful synopsis"))))
+ (check-synopsis-style pkg))))
+ "no article allowed at the beginning of the synopsis")))
+
+(test-assert "inputs: pkg-config is probably a native input"
+ (->bool
+ (string-contains
+ (call-with-warnings
+ (lambda ()
+ (let ((pkg (dummy-package "x"
+ (inputs `(("pkg-config" ,pkg-config))))))
+ (check-inputs-should-be-native pkg))))
+ "pkg-config should probably be a native input")))
+
+(test-assert "patches: file names"
+ (->bool
+ (string-contains
+ (call-with-warnings
+ (lambda ()
+ (let ((pkg (dummy-package "x"
+ (source
+ (origin
+ (method url-fetch)
+ (uri "someurl")
+ (sha256 "somesha")
+ (patches (list "/path/to/y.patch")))))))
+ (check-patches pkg))))
+ "file names of patches should start with the package name")))
+
+(test-end "lint")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))