1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
20 ;;; Validate 'etc/news.scm'.
30 ;; XXX: These two things are currently private.
31 (define read-channel-news (@@ (guix channels) read-channel-news))
32 (define channel-news-entries (cut struct-ref <> 0))
34 (define (all-the-news directory)
35 "Return the <channel-news> read from DIRECTORY, a checkout of the 'guix'
37 (call-with-input-file (string-append directory "/etc/news.scm")
40 (define (validate-texinfo str type language)
41 "Parse STR as a Texinfo fragment and raise an error if that fails."
44 (texi->plain-text str))
46 (print-exception (current-error-port) #f key args)
47 (report-error (G_ "the Texinfo snippet below is invalid (~a, ~a):~%")
49 (display str (current-error-port))
52 (define (validate-news-entry repository entry)
53 "Validate ENTRY, a <channel-news-entry>, making sure it refers to an
54 existent commit of REPOSITORY and contains only valid Texinfo."
57 (let ((commit (commit-lookup repository
59 (channel-news-entry-commit entry)))))
60 (for-each (match-lambda
62 (validate-texinfo title 'title language)))
63 (channel-news-entry-title entry))
64 (for-each (match-lambda
66 (validate-texinfo body 'body language)))
67 (channel-news-entry-body entry))))
68 (lambda (key error . rest)
69 (if (= GIT_ENOTFOUND (git-error-code error))
70 (leave (G_ "commit '~a' of entry '~a' does not exist~%")
71 (channel-news-entry-commit entry)
72 (channel-news-entry-title entry))
73 (apply throw key error rest)))))
75 (let* ((this-directory (dirname (current-filename)))
76 (top-directory (string-append this-directory "/.."))
77 (entries (channel-news-entries (all-the-news top-directory))))
78 (with-repository top-directory repository
79 (for-each (cut validate-news-entry repository <>)
81 (info (G_ "All ~a channel news entries are valid.~%")