3 files changed, 111 insertions(+), 2 deletions(-)

M doc/guix.texi
M guix/scripts/lint.scm
M tests/lint.scm

@@ 4117,6 4117,10 @@ Identify inputs that should most likely be native inputs.
 @itemx home-page
 Probe @code{home-page} and @code{source} URLs and report those that are
 invalid.
+
+@item formatting
+Warn about obvious source code formatting issues: trailing white space,
+use of tabulations, etc.
 @end table
 
 The general syntax is:

@@ 47,6 47,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
+  #:use-module (ice-9 rdelim)
   #:export (guix-lint
             check-description-style
             check-inputs-should-be-native


@@ 54,7 55,8 @@
             check-synopsis-style
             check-derivation
             check-home-page
-            check-source))
+            check-source
+            check-formatting))
 
 
 ;;;


@@ 509,6 511,79 @@ descriptions maintained upstream."
                     (format #f (_ "failed to create derivation: ~s~%")
                             args)))))
 
+
+;;;
+;;; Source code formatting.
+;;;
+
+(define (report-tabulations package line line-number)
+  "Warn about tabulations found in LINE."
+  (match (string-index line #\tab)
+    (#f #t)
+    (index
+     (emit-warning package
+                   (format #f (_ "tabulation on line ~a, column ~a")
+                           line-number index)))))
+
+(define (report-trailing-white-space package line line-number)
+  "Warn about trailing white space in LINE."
+  (unless (or (string=? line (string-trim-right line))
+              (string=? line (string #\page)))
+    (emit-warning package
+                  (format #f
+                          (_ "trailing white space on line ~a")
+                          line-number))))
+
+(define (report-long-line package line line-number)
+  "Emit a warning if LINE is too long."
+  ;; Note: We don't warn at 80 characters because sometimes hashes and URLs
+  ;; make it hard to fit within that limit and we want to avoid making too
+  ;; much noise.
+  (when (> (string-length line) 90)
+    (emit-warning package
+                  (format #f (_ "line ~a is way too long (~a characters)")
+                          line-number (string-length line)))))
+
+(define %formatting-reporters
+  ;; List of procedures that report formatting issues.  These are not separate
+  ;; checkers because they would need to re-read the file.
+  (list report-tabulations
+        report-trailing-white-space
+        report-long-line))
+
+(define* (report-formatting-issues package file starting-line
+                                   #:key (reporters %formatting-reporters))
+  "Report white-space issues in FILE starting from STARTING-LINE, and report
+them for PACKAGE."
+  (define last-line
+    ;; Number of the presumed last line.
+    ;; XXX: Ideally we'd stop at the boundaries of the surrounding sexp, but
+    ;; for now just use this simple heuristic.
+    (+ starting-line 60))
+
+  (call-with-input-file file
+    (lambda (port)
+      (let loop ((line-number 1))
+        (let ((line (read-line port)))
+          (or (eof-object? line)
+              (> line-number last-line)
+              (begin
+                (unless (< line-number starting-line)
+                  (for-each (lambda (report)
+                              (report package line line-number))
+                            reporters))
+                (loop (+ 1 line-number)))))))))
+
+(define (check-formatting package)
+  "Check the formatting of the source code of PACKAGE."
+  (let ((location (package-location package)))
+    (when location
+      (and=> (search-path %load-path (location-file location))
+             (lambda (file)
+               ;; Report issues starting from the line before the 'package'
+               ;; form, which usually contains the 'define' form.
+               (report-formatting-issues package file
+                                         (- (location-line location) 1)))))))
 
 
 ;;;


@@ 548,7 623,11 @@ descriptions maintained upstream."
    (lint-checker
      (name        'synopsis)
      (description "Validate package synopses")
-     (check       check-synopsis-style))))
+     (check       check-synopsis-style))
+   (lint-checker
+     (name        'formatting)
+     (description "Look for formatting issues in the source")
+     (check       check-formatting))))
 
 (define (run-checkers package checkers)
   ;; Run the given CHECKERS on PACKAGE.

@@ 420,6 420,32 @@ requests."
           (check-source pkg))))
     "not reachable: 404")))
 
+(test-assert "formatting: tabulation"
+  (string-contains
+   (with-warnings
+     (check-formatting (dummy-package "leave the tab here:	")))
+   "tabulation"))
+
+(test-assert "formatting: trailing white space"
+  (string-contains
+   (with-warnings
+     ;; Leave the trailing white space on the next line!
+     (check-formatting (dummy-package "x")))            
+   "trailing white space"))
+
+(test-assert "formatting: long line"
+  (string-contains
+   (with-warnings
+     (check-formatting
+      (dummy-package "x"                          ;here is a stupid comment just to make a long line
+                     )))
+   "too long"))
+
+(test-assert "formatting: alright"
+  (string-null?
+   (with-warnings
+     (check-formatting (dummy-package "x")))))
+
 (test-end "lint")