[PATCH] guix lint: add the --checkers option.

[Cyril Roelandt]

* guix/scripts/lint.scm: add the "--checkers" option.
* doc/guix.texi: Update "Invoking guix lint".
* tests/guix-lint.sh: New file
* Makefile.am (SCM_TESTS): Add it.
---
 Makefile.am           |   3 +-
 doc/guix.texi         |   5 +++
 guix/scripts/lint.scm | 122 +++++++++++++++++++++++++++++---------------------
 tests/guix-lint.sh    |  70 +++++++++++++++++++++++++++++
 4 files changed, 149 insertions(+), 51 deletions(-)
 create mode 100644 tests/guix-lint.sh

diff --git a/Makefile.am b/Makefile.am
index eba34af..34d2360 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -182,7 +182,8 @@ SH_TESTS =                                  \
   tests/guix-package.sh                                \
   tests/guix-system.sh                         \
   tests/guix-archive.sh                                \
-  tests/guix-authenticate.sh
+  tests/guix-authenticate.sh                   \
+  tests/guix-lint.sh
 
 if BUILD_DAEMON
 
diff --git a/doc/guix.texi b/doc/guix.texi
index 583bdbf..367972f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2781,6 +2781,11 @@ The @var{options} may be zero or more of the following:
 
 @table @code
 
address@hidden --checkers
address@hidden -c
+Only enable the checkers specified in a comma-separated list using the
+names returned by --list-checkers.
+
 @item --list-checkers
 @itemx -l
 List and describe all the available checkers that will be run on packages
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index fd9fd7b..31f0e47 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -36,44 +36,6 @@
 
 
 ;;;
-;;; 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)
@@ -223,11 +185,70 @@ Run a set of checkers on the specified package; if none 
is specified, run the ch
      (description "Validate package synopsis")
      (check       check-synopsis-style))))
 
-(define (run-checkers package)
-  ;; Run all the checkers on PACKAGE.
+(define (run-checkers package checkers)
+  ;; Run the given CHECKERS on PACKAGE.
   (for-each (lambda (checker)
               ((lint-checker-check checker) package))
-            %checkers))
+            checkers))
+
+
+;;;
+;;; 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 (_ "
+  -c, --checkers=CHECKER1,CHECKER2...
+                         only run the specificed checkers"))
+  (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:
+  ;; * --certainty=[low,medium,high]: only run checkers that have at least this
+  ;;                                  'certainty'.
+  (list (option '(#\c "checkers") #t #f
+                (lambda (opt name arg result arg-handler)
+                  (let ((names (string-split arg #\,)))
+                    (for-each (lambda (c)
+                                (when (not (member c (map lint-checker-name
+                                                          %checkers)))
+                                  (begin
+                                    (format (current-error-port)
+                                            "Invalid checker: ~a~%" c)
+                                    (exit 1))))
+                              names)
+                    (values (alist-cons 'checkers
+                             (filter (lambda (checker)
+                                       (member (lint-checker-name checker)
+                                               names))
+                                     %checkers)
+                             result)
+                            #f))))
+        (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")))))
 
 
 ;;;
@@ -238,11 +259,11 @@ Run a set of checkers on the specified package; if none 
is specified, run the ch
   (define (parse-options)
     ;; Return the alist of option values.
     (args-fold* args %options
-                (lambda (opt name arg result)
+                (lambda (opt name arg result arg-handler)
                   (leave (_ "~A: unrecognized option~%") name))
-                (lambda (arg result)
+                (lambda (arg result arg-handler)
                   (alist-cons 'argument arg result))
-                %default-options))
+                %default-options #f))
 
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
@@ -252,9 +273,10 @@ Run a set of checkers on the specified package; if none is 
specified, run the ch
                            (reverse opts))))
 
 
-   (if (null? args)
-        (fold-packages (lambda (p r) (run-checkers p)) '())
-        (for-each
-          (lambda (spec)
-            (run-checkers spec))
-          (map specification->package args)))))
+   (let ((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 spec checkers))
+            (map specification->package args))))))
diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh
new file mode 100644
index 0000000..3c6f780
--- /dev/null
+++ b/tests/guix-lint.sh
@@ -0,0 +1,70 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2014 Cyril Roelandt <address@hidden>
+#
+# 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/>.
+
+#
+# Test the `guix lint' command-line utility.
+#
+
+guix lint --version
+
+module_dir="t-guix-lint-$$"
+mkdir "$module_dir"
+trap "rm -rf $module_dir" EXIT
+
+
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+  #:use-module (guix packages)
+  #:use-module (gnu packages base))
+
+(define-public dummy
+  (package (inherit hello)
+    (name "dummy")
+    (version "42")
+    (synopsis "dummy package")
+    (description "dummy package only used for testing purposes.")))
+EOF
+
+export GUIX_PACKAGE_PATH=$module_dir
+
+grep_warning ()
+{
+    res=$(echo "$1" | grep -E -c "(synopsis|description) should")
+    echo $res
+}
+
+# Three issues with the dummy package:
+# 1) the synopsis starts with the package name;
+# 2) the synopsis starts with a lower-case letter;
+# 3) the description starts with a lower-case letter.
+
+if [ $(grep_warning "$(guix lint dummy 2>&1)") -ne 3 ]
+then false; else true; fi
+
+if [ $(grep_warning "$(guix lint -c synopsis dummy 2>&1)") -ne 2 ]
+then false; else true; fi
+
+if [ $(grep_warning "$(guix lint -c description dummy 2>&1)") -ne 1 ]
+then false; else true; fi
+
+if [ $(grep_warning "$(guix lint -c description,synopsis dummy 2>&1)") -ne 3 ]
+then false; else true; fi
+
+if guix lint -c synopsis,invalid-checker dummy 2>&1 | \
+   grep -q 'Invalid checker: invalid-checker'
+then true; else false; fi
-- 
1.8.4.rc3