[PATCH] guix: lint: Check for version-only origin file names.

[ericbavier@openmailbox.org]

From: Eric Bavier <bavier@member.fsf.org>

* guix/scripts/lint.scm (check-source): Emit warning if source filename
  contains only the version of the package.
---
 guix/scripts/lint.scm | 64 +++++++++++++++++++++++++++++++--------------------
 1 file changed, 39 insertions(+), 25 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 14ac8cb..c0300bc 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
-;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,6 +20,7 @@
 
 (define-module (guix scripts lint)
   #:use-module (guix store)
+  #:use-module (guix derivations)
   #:use-module (guix base32)
   #:use-module (guix download)
   #:use-module (guix ftp-client)
@@ -466,31 +467,44 @@ descriptions maintained upstream."
                           uris))
       '()))
 
+  (define (origin-version-name? origin)
+    ;; Return #t if the source file name contains only a version; indicates
+    ;; that the origin needs a 'file-name' field.
+    (string-prefix? (package-version package)
+                    (store-path-package-name
+                     (with-store store
+                       (derivation->output-path
+                        (package-source-derivation store origin))))))
+
   (let ((origin (package-source package)))
-    (when (and origin
-               (eqv? (origin-method origin) url-fetch))
-      (let* ((strings (origin-uri origin))
-             (uris (if (list? strings)
-                       (map string->uri strings)
-                       (list (string->uri strings)))))
-
-        ;; Just make sure that at least one of the URIs is valid.
-        (call-with-values
-            (lambda () (try-uris uris))
-          (lambda (success? warnings)
-            ;; When everything fails, report all of WARNINGS, otherwise don't
-            ;; report anything.
-            ;;
-            ;; XXX: Ideally we'd still allow warnings to be raised if *some*
-            ;; URIs are unreachable, but distinguish that from the error case
-            ;; where *all* the URIs are unreachable.
-            (unless success?
-              (emit-warning package
-                            (_ "all the source URIs are unreachable:")
-                            'source)
-              (for-each (lambda (warning)
-                          (display warning (guix-warning-port)))
-                        (reverse warnings)))))))))
+    (when origin
+      (if (eqv? (origin-method origin) url-fetch)
+          (let* ((strings (origin-uri origin))
+                 (uris (if (list? strings)
+                           (map string->uri strings)
+                           (list (string->uri strings)))))
+
+            ;; Just make sure that at least one of the URIs is valid.
+            (call-with-values
+                (lambda () (try-uris uris))
+              (lambda (success? warnings)
+                ;; When everything fails, report all of WARNINGS, otherwise don't
+                ;; report anything.
+                ;;
+                ;; XXX: Ideally we'd still allow warnings to be raised if *some*
+                ;; URIs are unreachable, but distinguish that from the error case
+                ;; where *all* the URIs are unreachable.
+                (unless success?
+                  (emit-warning package
+                                (_ "all the source URIs are unreachable:")
+                                'source)
+                  (for-each (lambda (warning)
+                              (display warning (guix-warning-port)))
+                            (reverse warnings)))))))
+      (if (origin-version-name? origin)
+          (emit-warning package
+                        (_ "the source filename should contain the package name")
+                        'source)))))
 
 (define (check-derivation package)
   "Emit a warning if we fail to compile PACKAGE to a derivation."
-- 
2.4.3