summaryrefslogtreecommitdiff
path: root/website
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-13 13:56:20 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-13 14:03:49 +0100
commitda3edd193269fdbdf264aa4362e3f9155649a428 (patch)
treef5b65734a0d9f513864460d128bf43bc15223c26 /website
parent4c01f5d1782c46dbe2796bd5ab92d2ce0b81db62 (diff)
downloadguix-artwork-da3edd193269fdbdf264aa4362e3f9155649a428.tar
guix-artwork-da3edd193269fdbdf264aa4362e3f9155649a428.tar.gz
website: Add /packages/issues.html page.
* website/www/packages.scm (location-url, source-url): New procedures, moved from... (package->sxml): ... here. (%fast-issue-checkers, %issue-checkers): New variables. (lint-checker-report, package-issues, issues->sxml, package->issue-sxml, packages->issue-sxml, all-packages): New procedures. (packages-page): Use 'all-packages'. (issues-page): New procedure. * website/www.scm (%web-pages): Add ISSUES-PAGE in a comment.
Diffstat (limited to 'website')
-rw-r--r--website/www.scm1
-rw-r--r--website/www/packages.scm138
2 files changed, 125 insertions, 14 deletions
diff --git a/website/www.scm b/website/www.scm
index 415e5b6..c4d7fcf 100644
--- a/website/www.scm
+++ b/website/www.scm
@@ -333,6 +333,7 @@ Distribution.")
("download/index.html" ,download-page)
("help/index.html" ,help-page)
;; ("packages/index.html" ,packages-page) ; Need Guix
+ ;; ("packages/issues.html" ,issues-page)
))
(define (mkdir* directory)
diff --git a/website/www/packages.scm b/website/www/packages.scm
index e576f92..4b76bfe 100644
--- a/website/www/packages.scm
+++ b/website/www/packages.scm
@@ -23,12 +23,14 @@
(define-module (www packages)
#:use-module (www utils)
#:use-module (www shared)
+ #:use-module ((guix ui) #:select (guix-warning-port))
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix gnu-maintenance)
#:use-module ((guix download) #:select (%mirrors))
#:use-module ((guix build download) #:select (maybe-expand-mirrors))
+ #:use-module (guix scripts lint)
#:use-module (gnu packages)
#:use-module (sxml simple)
#:use-module (sxml fold)
@@ -37,6 +39,7 @@
#:use-module (ice-9 i18n)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-26)
#:use-module (texinfo)
#:use-module (texinfo html)
#:export (packages-page))
@@ -64,6 +67,15 @@
(loop tail
(cons* head item result))))))
+(define (location-url loc)
+ (string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
+ (location-file loc) "#n"
+ (number->string (location-line loc))))
+
+(define (source-url package)
+ (let ((loc (package-location package)))
+ (and loc (location-url loc))))
+
(define (package->sxml package previous description-ids remaining)
"Return 3 values: the SXML for PACKAGE added to all previously collected
package output in PREVIOUS, a list of DESCRIPTION-IDS and the number of
@@ -71,15 +83,6 @@ packages still to be processed in REMAINING. Also Introduces a call to the
JavaScript prep_pkg_descs function as part of the output of PACKAGE, every
time the length of DESCRIPTION-IDS, increasing, is 15 or when REMAINING,
decreasing, is 1."
- (define (location-url loc)
- (string-append "http://git.savannah.gnu.org/cgit/guix.git/tree/"
- (location-file loc) "#n"
- (number->string (location-line loc))))
-
- (define (source-url package)
- (let ((loc (package-location package)))
- (and loc (location-url loc))))
-
(define (license package)
(define ->sxml
(match-lambda
@@ -268,6 +271,92 @@ description-ids as formal parameters."
(make-locale LC_ALL "en_US.UTF-8"))))
+;;;
+;;; Issues reported by 'lint'.
+;;;
+
+(define %fast-issue-checkers
+ ;; Runs in less than a minute for all the packages.
+ (remove (lambda (checker)
+ (case (lint-checker-name checker)
+ ((home-page source derivation) #t)
+ (else #f)))
+ %checkers))
+
+(define %issue-checkers
+ ;; List of checkers used by default.
+ %fast-issue-checkers)
+
+(define (lint-checker-report checker package)
+ "Return the report generated by CHECKER for PACKAGE as a string. If the
+result is the empty string, it means that CHECKER had nothing to complain about."
+ (call-with-output-string
+ (lambda (port)
+ (parameterize ((guix-warning-port port))
+ ((lint-checker-check checker) package)))))
+
+(define (package-issues package checkers)
+ "Report issues for PACKAGE based on reports generated by CHECKERS. Each
+issue is a CHECKER/REPORT tuple."
+ (let ((reports (map (cut lint-checker-report <> package)
+ checkers)))
+ (remove (match-lambda
+ ((_ "") #t)
+ (_ #f))
+ (zip checkers reports))))
+
+(define (issues->sxml package issues)
+ "Return an SXML tree representing ISSUES for PACKAGE, where ISSUES is a
+list of checker/report tuples."
+ (if (null? issues)
+ "Nothing to declare!"
+ (let ((count (length issues)))
+ `(div
+ (div (b ,(number->string count)
+ ,(if (= count 1) " issue" " issues")))
+ (table
+ ,@(map (match-lambda
+ ((checker report)
+ `(tr (td ,(lint-checker-name checker))
+ (td (pre ,report)))))
+ issues))))))
+
+(define* (package->issue-sxml package #:key (checkers %issue-checkers))
+ "Return an SXML table row for PACKAGE containing all the reports generated
+by CHECKERS."
+ (let ((issues (package-issues package checkers)))
+ (define name+version
+ (string-append (package-name package) " "
+ (package-version package)))
+
+ `(tr (td (a (@ (name ,(package-full-name package))))
+ (a (@ (href ,(source-url package))
+ (title "Link to the Guix package source code"))
+ ,(if (null? issues)
+ name+version
+ `(b ,name+version))))
+ (td ,(issues->sxml package issues)))))
+
+(define* (packages->issue-sxml packages #:key (checkers %issue-checkers))
+ "Return an SXML tree representing the reports generated by CHECKERS for
+PACKAGES."
+ `(table
+ ,@(map (lambda (package)
+ (package->issue-sxml package #:checkers checkers))
+ packages)))
+
+
+;;;
+;;; Pages.
+;;;
+
+(define (all-packages)
+ "Return the list of all package objects, sorted by name."
+ (sort (fold-packages cons '())
+ (lambda (p1 p2)
+ (string<? (package-name p1)
+ (package-name p2)))))
+
(define (packages-page)
`(html (@ (lang "en"))
,(html-page-header "Packages" #:css "packages.css" #:js "packages.js")
@@ -287,11 +376,32 @@ description-ids as formal parameters."
(a (@ (href "http://hydra.gnu.org/jobset/gnu/master"))
"continuous integration system")
" shows their current build status.")
- ,(let ((packages (sort (fold-packages cons '())
- (lambda (p1 p2)
- (string<? (package-name p1)
- (package-name p2))))))
- (packages->sxml packages))
+ ,(packages->sxml (all-packages))
+
+ (p "Updated " ,(date->string (current-date) "~B ~e, ~Y")
+ ".")))
+
+ ,(html-page-footer))))
+
+(define* (issues-page #:key (checkers %issue-checkers))
+ `(html (@ (lang "en"))
+ ,(html-page-header "Package Issues" #:css "packages.css" #:js "packages.js")
+ (body
+ ,(html-page-description)
+ ,(html-page-links)
+
+ (div (@ (id "content-box"))
+ (article
+ (h1 "Package Issues")
+
+ (p "Everybody's got issues! This page lists problems
+reported by "
+ (a (@ (href ,(base-url
+ "manual/html_node/Invoking-guix-lint.html")))
+ (code "guix lint")) ".")
+
+ ,(packages->issue-sxml (all-packages)
+ #:checkers checkers)
(p "Updated " ,(date->string (current-date) "~B ~e, ~Y")
".")))