maint: Add 'update-NEWS' target.
* build-aux/update-NEWS.scm: New file. * Makefile.am (EXTRA_DIST): Add it. (GUIX_MAINTENANCE_DIRECTORY): New variable. (update-NEWS): New target. (.PHONY): Add it.
This commit is contained in:
Ludovic Courtès
parent
266d281d25
commit
920803fbf4
12
Makefile.am
12
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. ##
|
||||
|
||||
161
build-aux/update-NEWS.scm
Normal file
161
build-aux/update-NEWS.scm
Normal file
@ -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)))
|
||||
Loading…
Reference in New Issue
Block a user