summaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-18 16:21:35 +0200
committerLudovic Courtès <ludo@gnu.org>2017-05-18 16:24:02 +0200
commit920803fbf443f7e40ed299f433255f10a4ae9fb3 (patch)
treefa7efbcbdadee16fd75a57b6f2164df3dbb6359c /build-aux
parent266d281d253ffd20336f837fc64a64a14eb44b12 (diff)
downloadgnu-guix-920803fbf443f7e40ed299f433255f10a4ae9fb3.tar
gnu-guix-920803fbf443f7e40ed299f433255f10a4ae9fb3.tar.gz
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.
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/update-NEWS.scm161
1 files changed, 161 insertions, 0 deletions
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)))