10/104: guix: Add lint-checker for packages which should be no inputs at all.

[Hartmut Goebel]

htgoebel pushed a commit to branch python-build-system
in repository guix.

commit 891a843d5184f696618af6fcbb9791ef6b574504
Author: Hartmut Goebel <address@hidden>
Date:   Wed Sep 28 11:36:35 2016 +0200

    guix: Add lint-checker for packages which should be no inputs at all.
    
    Also refactor some common code into a new function.
    
    Examples for these pacakges are python(2)-setuptools and python(2)-pip, 
which
    are installed together with python itself.
    
    * guix/scripts/lint.scm (warn-if-package-has-input): New procedure.
      (check-inputs-should-be-native package): Use it; rename and clean-up
      variables. (check-inputs-should-not-be-an-input-at-all): New procedure.
      (%checkers) Add it.
    * doc/guix.texi (Python Modules): Document it.
    * tests/lint.scm: ("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)"): Add tests.
---
 doc/guix.texi         |    3 ++-
 guix/scripts/lint.scm |   63 +++++++++++++++++++++++++++++++++++--------------
 tests/lint.scm        |   34 ++++++++++++++++++++++++++
 3 files changed, 81 insertions(+), 19 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5f28076..40a1a87 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13602,7 +13602,8 @@ following check list to determine which dependency goes 
where.
 @item
 We currently package Python 2 with @code{setuptools} and @code{pip}
 installed like Python 3.4 has per default.  Thus you don't need to
-specify either of these as an input.
+specify either of these as an input.  @command{guix lint} will warn you
+if you do.
 
 @item
 Python dependencies required at run time go into
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 6e6f550..e68ee29 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <address@hidden>
 ;;; Copyright © 2016 Danny Milosavljevic <address@hidden>
+;;; Copyright © 2016 Hartmut Goebel <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -59,6 +60,7 @@
   #:export (guix-lint
             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
@@ -228,34 +230,55 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
                       (format #f (_ "invalid description: ~s") description)
                       'description))))
 
+(define (warn-if-package-has-input linted inputs-to-check input-names message)
+  ;; Emit a warning MESSAGE if some of the inputs named in INPUT-NAMES are
+  ;; contained in INPUTS-TO-CHECK, which are assumed to be inputs of package
+  ;; LINTED.
+  (match inputs-to-check
+    (((labels packages . outputs) ...)
+     (for-each (lambda (package output)
+                 (when (package? package)
+                   (let ((input (string-append
+                                 (package-name package)
+                                 (if (> (length output) 0)
+                                     (string-append ":" (car output))
+                                     ""))))
+                     (when (member input input-names)
+                       (emit-warning linted
+                                     (format #f (_ message) input)
+                                     'inputs-to-check)))))
+               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 ((linted package)
+  (let ((message "'~a' should probably be a native input")
         (inputs (package-inputs package))
-        (native-inputs
+        (input-names
           '("pkg-config"
             "extra-cmake-modules"
             "glib:bin"
             "intltool"
             "itstool"
             "qttools")))
-    (match inputs
-      (((labels packages . outputs) ...)
-       (for-each (lambda (package output)
-                   (when (package? package)
-                     (let ((input (string-append
-                                   (package-name package)
-                                   (if (> (length output) 0)
-                                       (string-append ":" (car output))
-                                       ""))))
-                       (when (member input native-inputs)
-                         (emit-warning linted
-                                       (format #f (_ "'~a' should probably \
-be a native input")
-                                               input)
-                                       'inputs)))))
-                 packages outputs)))))
+    (warn-if-package-has-input package inputs input-names message)))
+
+(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 ((message "'~a' should probably not be an input at all")
+        (inputs (package-inputs package))
+        (input-names
+          '("python-setuptools"
+            "python2-setuptools"
+            "python-pip"
+            "python2-pip")))
+    (warn-if-package-has-input package (package-inputs package)
+                               input-names message)
+    (warn-if-package-has-input package (package-native-inputs package)
+                               input-names message)
+    (warn-if-package-has-input package (package-propagated-inputs package)
+                               input-names message)))
 
 (define (package-name-regexp package)
   "Return a regexp that matches PACKAGE's name as a word at the beginning of a
@@ -845,6 +868,10 @@ them for PACKAGE."
      (description "Identify inputs that should be native inputs")
      (check       check-inputs-should-be-native))
    (lint-checker
+     (name        'inputs-should-not-be-input)
+     (description "Identify inputs that should 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))
diff --git a/tests/lint.scm b/tests/lint.scm
index fa2d19b..b66cd29 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <address@hidden>
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <address@hidden>
+;;; Copyright © 2016 Hartmut Goebel <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
+  #:use-module (gnu packages python)
   #:use-module (web server)
   #:use-module (web server http)
   #:use-module (web response)
@@ -354,6 +356,38 @@ string) on HTTP requests."
           (check-inputs-should-be-native pkg)))
           "'glib:bin' should probably be a native input")))
 
+(test-assert
+    "inputs: python-setuptools should not be an input at all (input)"
+  (->bool
+   (string-contains
+     (with-warnings
+       (let ((pkg (dummy-package "x"
+                    (inputs `(("python-setuptools" ,python-setuptools))))))
+         (check-inputs-should-not-be-an-input-at-all pkg)))
+         "'python-setuptools' should probably not be an input at all")))
+
+(test-assert
+    "inputs: python-setuptools should not be an input at all (native-input)"
+  (->bool
+   (string-contains
+     (with-warnings
+       (let ((pkg (dummy-package "x"
+                    (native-inputs
+                     `(("python-setuptools" ,python-setuptools))))))
+         (check-inputs-should-not-be-an-input-at-all pkg)))
+         "'python-setuptools' should probably not be an input at all")))
+
+(test-assert
+    "inputs: python-setuptools should not be an input at all 
(propagated-input)"
+  (->bool
+   (string-contains
+     (with-warnings
+       (let ((pkg (dummy-package "x"
+                    (propagated-inputs
+                     `(("python-setuptools" ,python-setuptools))))))
+         (check-inputs-should-not-be-an-input-at-all pkg)))
+         "'python-setuptools' should probably not be an input at all")))
+
 (test-assert "patches: file names"
   (->bool
    (string-contains