You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

214 lines
7.2 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (guix scripts lint)
  19. #:use-module (guix base32)
  20. #:use-module (guix packages)
  21. #:use-module (guix records)
  22. #:use-module (guix ui)
  23. #:use-module (guix utils)
  24. #:use-module (gnu packages)
  25. #:use-module (ice-9 match)
  26. #:use-module (srfi srfi-1)
  27. #:use-module (srfi srfi-9)
  28. #:use-module (srfi srfi-11)
  29. #:use-module (srfi srfi-37)
  30. #:export (guix-lint
  31. check-inputs-should-be-native
  32. check-patches
  33. check-synopsis-style))
  34. ;;;
  35. ;;; Command-line options.
  36. ;;;
  37. (define %default-options
  38. ;; Alist of default option values.
  39. '())
  40. (define (show-help)
  41. (display (_ "Usage: guix lint [OPTION]... [PACKAGE]...
  42. Run a set of checkers on the specified package; if none is specified, run the checkers on all packages.\n"))
  43. (display (_ "
  44. -h, --help display this help and exit"))
  45. (display (_ "
  46. -l, --list-checkers display the list of available lint checkers"))
  47. (display (_ "
  48. -V, --version display version information and exit"))
  49. (newline)
  50. (show-bug-report-information))
  51. (define %options
  52. ;; Specification of the command-line options.
  53. ;; TODO: add some options:
  54. ;; * --checkers=checker1,checker2...: only run the specified checkers
  55. ;; * --certainty=[low,medium,high]: only run checkers that have at least this
  56. ;; 'certainty'.
  57. (list (option '(#\h "help") #f #f
  58. (lambda args
  59. (show-help)
  60. (exit 0)))
  61. (option '(#\l "list-checkers") #f #f
  62. (lambda args
  63. (list-checkers-and-exit)))
  64. (option '(#\V "version") #f #f
  65. (lambda args
  66. (show-version-and-exit "guix lint")))))
  67. ;;;
  68. ;;; Helpers
  69. ;;;
  70. (define* (emit-warning package message #:optional field)
  71. ;; Emit a warning about PACKAGE, printing the location of FIELD if it is
  72. ;; given, the location of PACKAGE otherwise, the full name of PACKAGE and the
  73. ;; provided MESSAGE.
  74. (let ((loc (or (package-field-location package field)
  75. (package-location package))))
  76. (format (guix-warning-port) (_ "~a: ~a: ~a~%")
  77. (location->string loc)
  78. (package-full-name package)
  79. message)))
  80. ;;;
  81. ;;; Checkers
  82. ;;;
  83. (define-record-type* <lint-checker>
  84. lint-checker make-lint-checker
  85. lint-checker?
  86. ;; TODO: add a 'certainty' field that shows how confident we are in the
  87. ;; checker. Then allow users to only run checkers that have a certain
  88. ;; 'certainty' level.
  89. (name lint-checker-name)
  90. (description lint-checker-description)
  91. (check lint-checker-check))
  92. (define (list-checkers-and-exit)
  93. ;; Print information about all available checkers and exit.
  94. (format #t (_ "Available checkers:~%"))
  95. (for-each (lambda (checker)
  96. (format #t "- ~a: ~a~%"
  97. (lint-checker-name checker)
  98. (lint-checker-description checker)))
  99. %checkers)
  100. (exit 0))
  101. (define (check-inputs-should-be-native package)
  102. ;; Emit a warning if some inputs of PACKAGE are likely to belong to its
  103. ;; native inputs.
  104. (let ((inputs (package-inputs package)))
  105. (match inputs
  106. (((labels packages . _) ...)
  107. (when (member "pkg-config"
  108. (map package-name (filter package? packages)))
  109. (emit-warning package
  110. "pkg-config should probably be a native input"
  111. 'inputs))))))
  112. (define (check-synopsis-style package)
  113. ;; Emit a warning if stylistic issues are found in the synopsis of PACKAGE.
  114. (define (check-final-period synopsis)
  115. ;; Synopsis should not end with a period, except for some special cases.
  116. (if (and (string=? (string-take-right synopsis 1) ".")
  117. (not (string=? (string-take-right synopsis 4) "etc.")))
  118. (emit-warning package
  119. "no period allowed at the end of the synopsis"
  120. 'synopsis)))
  121. (define (check-start-article synopsis)
  122. (if (or (string=? (string-take synopsis 2) "A ")
  123. (string=? (string-take synopsis 3) "An "))
  124. (emit-warning package
  125. "no article allowed at the beginning of the synopsis"
  126. 'synopsis)))
  127. (let ((synopsis (package-synopsis package)))
  128. (if (string? synopsis)
  129. (begin
  130. (check-final-period synopsis)
  131. (check-start-article synopsis)))))
  132. (define (check-patches package)
  133. ;; Emit a warning if the patches requires by PACKAGE are badly named.
  134. (let ((patches (and=> (package-source package) origin-patches))
  135. (name (package-name package))
  136. (full-name (package-full-name package)))
  137. (if (and patches
  138. (any (lambda (patch)
  139. (let ((filename (basename patch)))
  140. (not (or (eq? (string-contains filename name) 0)
  141. (eq? (string-contains filename full-name) 0)))))
  142. patches))
  143. (emit-warning package
  144. "file names of patches should start with the package name"
  145. 'patches))))
  146. (define %checkers
  147. (list
  148. (lint-checker
  149. (name "inputs-should-be-native")
  150. (description "Identify inputs that should be native inputs")
  151. (check check-inputs-should-be-native))
  152. (lint-checker
  153. (name "patch-filenames")
  154. (description "Validate filenames of patches")
  155. (check check-patches))
  156. (lint-checker
  157. (name "synopsis")
  158. (description "Validate package synopsis")
  159. (check check-synopsis-style))))
  160. (define (run-checkers package)
  161. ;; Run all the checkers on PACKAGE.
  162. (for-each (lambda (checker)
  163. ((lint-checker-check checker) package))
  164. %checkers))
  165. ;;;
  166. ;;; Entry Point
  167. ;;;
  168. (define (guix-lint . args)
  169. (define (parse-options)
  170. ;; Return the alist of option values.
  171. (args-fold* args %options
  172. (lambda (opt name arg result)
  173. (leave (_ "~A: unrecognized option~%") name))
  174. (lambda (arg result)
  175. (alist-cons 'argument arg result))
  176. %default-options))
  177. (let* ((opts (parse-options))
  178. (args (filter-map (match-lambda
  179. (('argument . value)
  180. value)
  181. (_ #f))
  182. (reverse opts))))
  183. (if (null? args)
  184. (fold-packages (lambda (p r) (run-checkers p)) '())
  185. (for-each
  186. (lambda (spec)
  187. (run-checkers spec))
  188. (map specification->package args)))))