diff options
| -rw-r--r-- | Makefile.am | 12 | ||||
| -rw-r--r-- | build-aux/update-NEWS.scm | 161 |
2 files changed, 172 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 5bfc9ca88c..e1c7cdd7fa 100644 --- a/Makefile.am +++ b/Makefile.am @@ -420,6 +420,7 @@ EXTRA_DIST = \ build-aux/generate-authors.scm \ build-aux/test-driver.scm \ build-aux/update-guix-package.scm \ + build-aux/update-NEWS.scm \ build-aux/run-system-tests.scm \ d3.v3.js \ graph.js \ @@ -641,6 +642,15 @@ update-guix-package: $(top_srcdir)/build-aux/update-guix-package.scm \ "`git rev-parse HEAD`" +# Location of a checkout of <git://git.savannah.gnu.org/guix/maintenance.git>. +# Package data from this checkout is used by 'update-NEWS.scm'. +GUIX_MAINTENANCE_DIRECTORY ?= $(top_srcdir)/../guix-maintenance + +update-NEWS: $(GOBJECTS) + $(top_builddir)/pre-inst-env "$(GUILE)" \ + $(top_srcdir)/build-aux/update-NEWS.scm \ + $(top_srcdir)/NEWS "$(GUIX_MAINTENANCE_DIRECTORY)/data" + # Make sure we're not shipping a file that embeds a local /gnu/store file name. assert-no-store-file-names: $(distdir)/ChangeLog $(AM_V_at)if grep -r --exclude=*.texi --exclude=*.info \ @@ -676,7 +686,7 @@ hydra-jobs.scm: $(GOBJECTS) .PHONY: assert-no-store-file-names assert-binaries-available .PHONY: assert-final-inputs-self-contained .PHONY: clean-go make-go -.PHONY: update-guix-package release +.PHONY: update-guix-package update-NEWS release ## -------------- ## ## Silent rules. ## diff --git a/build-aux/update-NEWS.scm b/build-aux/update-NEWS.scm new file mode 100644 index 0000000000..2e8f68c9a8 --- /dev/null +++ b/build-aux/update-NEWS.scm @@ -0,0 +1,161 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: +;;; +;;; This script updates the list of new and updated packages in 'NEWS'. +;;; +;;; Code: + +(use-modules (gnu) (guix) + (guix build utils) + ((guix ui) #:select (fill-paragraph)) + (srfi srfi-1) + (srfi srfi-11) + (ice-9 match) + (ice-9 rdelim) + (ice-9 regex) + (ice-9 pretty-print)) + +(define %header-rx + (make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)")) + +(define (NEWS->versions port) + "Return two values: the previous version and the current version as read +from PORT, which is an input port on the 'NEWS' file." + (let loop () + (let ((line (read-line port))) + (cond ((eof-object? line) + (error "failed to determine previous and current version" + port)) + ((regexp-exec %header-rx line) + => + (lambda (match) + (values (match:substring match 3) + (match:substring match 2)))) + (else + (loop)))))) + +(define (skip-to-org-heading port) + "Read from PORT until an Org heading is found." + (let loop () + (let ((next (peek-char port))) + (cond ((eqv? next #\*) + #t) + ((eof-object? next) + (error "next heading could not be found")) + (else + (read-line port) + (loop)))))) + +(define (rewrite-org-section input output heading-rx proc) + "Write to OUTPUT the text read from INPUT, but with the first Org section +matching HEADING-RX replaced by NEW-HEADING and CONTENTS." + (let loop () + (let ((line (read-line input))) + (cond ((eof-object? line) + (error "failed to match heading regexp" heading-rx)) + ((regexp-exec heading-rx line) + => + (lambda (match) + (proc match output) + (skip-to-org-heading input) + (dump-port input output) + #t)) + (else + (display line output) + (newline output) + (loop)))))) + +(define (enumeration->paragraph lst) + "Turn LST, a list of strings, into a single string that is a ready-to-print +paragraph." + (fill-paragraph (string-join (sort lst string<?) ", ") + 75)) + +(define (write-packages-added news-file old new) + "Write to NEWS-FILE the list of packages added between OLD and NEW." + (let ((added (lset-difference string=? (map car new) (map car old)))) + (with-atomic-file-replacement news-file + (lambda (input output) + (rewrite-org-section input output + (make-regexp "^(\\*+) (.*) new packages") + (lambda (match port) + (let ((stars (match:substring match 1))) + (format port + "~a ~a new packages~%~%~a~%~%" + stars (length added) + (enumeration->paragraph added))))))))) + +(define (write-packages-updates news-file old new) + "Write to NEWS-FILE the list of packages upgraded between OLD and NEW." + (let ((upgraded (filter-map (match-lambda + ((package . new-version) + (match (assoc package old) + ((_ . old-version) + (and (version>? new-version old-version) + (string-append package "@" + new-version))) + (_ #f)))) + new))) + (with-atomic-file-replacement news-file + (lambda (input output) + (rewrite-org-section input output + (make-regexp "^(\\*+) (.*) package updates") + (lambda (match port) + (let ((stars (match:substring match 1))) + (format port + "~a ~a package updates~%~%~a~%~%" + stars (length upgraded) + (enumeration->paragraph upgraded))))))))) + + +(define (main . args) + (match args + ((news-file data-directory) + ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH. Here we + ;; assume that the last item in (%package-module-path) is the distro + ;; directory. + (parameterize ((%package-module-path + (list (last (%package-module-path))))) + (define (package-file version) + (string-append data-directory "/packages-" + version ".txt")) + + (let-values (((previous-version new-version) + (call-with-input-file news-file NEWS->versions))) + (let* ((old (call-with-input-file (package-file previous-version) + read)) + (new (fold-packages (lambda (p r) + (alist-cons (package-name p) (package-version p) + r)) + '()))) + (call-with-output-file (package-file new-version) + (lambda (port) + (pretty-print new port))) + + (write-packages-added news-file old new) + (write-packages-updates news-file old new))))) + (x + (format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY + +Update the list of new and updated packages in NEWS-FILE using the +previous-version package list from DATA-DIRECTORY.\n") + (exit 1)))) + +(apply main (cdr (command-line))) |