From 1ad5209d904d471ded6cf53b4e29b64e963dea3f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 May 2020 23:25:23 +0200 Subject: maint: Add "make check-channel-news". * build-aux/check-channel-news.scm: New file. * Makefile.am (EXTRA_DIST): Add it. (check-channel-news): New phony rule. * doc/contributing.texi (Commit Access): Mention "make check-channel-news". --- build-aux/check-channel-news.scm | 82 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) create mode 100644 build-aux/check-channel-news.scm (limited to 'build-aux') diff --git a/build-aux/check-channel-news.scm b/build-aux/check-channel-news.scm new file mode 100644 index 0000000000..eb7b89e437 --- /dev/null +++ b/build-aux/check-channel-news.scm @@ -0,0 +1,82 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +;;; +;;; Validate 'etc/news.scm'. +;;; + +(use-modules (git) + (guix git) + (guix ui) + (guix channels) + (srfi srfi-26) + (ice-9 match)) + +;; XXX: These two things are currently private. +(define read-channel-news (@@ (guix channels) read-channel-news)) +(define channel-news-entries (cut struct-ref <> 0)) + +(define (all-the-news directory) + "Return the read from DIRECTORY, a checkout of the 'guix' +channel." + (call-with-input-file (string-append directory "/etc/news.scm") + read-channel-news)) + +(define (validate-texinfo str type language) + "Parse STR as a Texinfo fragment and raise an error if that fails." + (catch #t + (lambda () + (texi->plain-text str)) + (lambda (key . args) + (print-exception (current-error-port) #f key args) + (report-error (G_ "the Texinfo snippet below is invalid (~a, ~a):~%") + type language) + (display str (current-error-port)) + (exit 1)))) + +(define (validate-news-entry repository entry) + "Validate ENTRY, a , making sure it refers to an +existent commit of REPOSITORY and contains only valid Texinfo." + (catch 'git-error + (lambda () + (let ((commit (commit-lookup repository + (string->oid + (channel-news-entry-commit entry))))) + (for-each (match-lambda + ((language . title) + (validate-texinfo title 'title language))) + (channel-news-entry-title entry)) + (for-each (match-lambda + ((language . body) + (validate-texinfo body 'body language))) + (channel-news-entry-body entry)))) + (lambda (key error . rest) + (if (= GIT_ENOTFOUND (git-error-code error)) + (leave (G_ "commit '~a' of entry '~a' does not exist~%") + (channel-news-entry-commit entry) + (channel-news-entry-title entry)) + (apply throw key error rest))))) + +(let* ((this-directory (dirname (current-filename))) + (top-directory (string-append this-directory "/..")) + (entries (channel-news-entries (all-the-news top-directory)))) + (with-repository top-directory repository + (for-each (cut validate-news-entry repository <>) + entries) + (info (G_ "All ~a channel news entries are valid.~%") + (length entries)))) -- cgit 1.4.1