1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017, 2018 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/>.
21 ;;; This script updates the list of new and updated packages in 'NEWS'.
25 (use-modules (gnu) (guix)
27 ((guix ui) #:select (fill-paragraph))
36 (make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)"))
38 (define (NEWS->versions port)
39 "Return two values: the previous version and the current version as read
40 from PORT, which is an input port on the 'NEWS' file."
42 (let ((line (read-line port)))
43 (cond ((eof-object? line)
44 (error "failed to determine previous and current version"
46 ((regexp-exec %header-rx line)
49 (values (match:substring match 3)
50 (match:substring match 2))))
54 (define (skip-to-org-heading port)
55 "Read from PORT until an Org heading is found."
57 (let ((next (peek-char port)))
58 (cond ((eqv? next #\*)
61 (error "next heading could not be found"))
66 (define (rewrite-org-section input output heading-rx proc)
67 "Write to OUTPUT the text read from INPUT, but with the first Org section
68 matching HEADING-RX replaced by NEW-HEADING and CONTENTS."
70 (let ((line (read-line input)))
71 (cond ((eof-object? line)
72 (error "failed to match heading regexp" heading-rx))
73 ((regexp-exec heading-rx line)
77 (skip-to-org-heading input)
78 (dump-port input output)
85 (define (enumeration->paragraph lst)
86 "Turn LST, a list of strings, into a single string that is a ready-to-print
88 (fill-paragraph (string-join (sort lst string<?) ", ")
91 (define (write-packages-added news-file old new)
92 "Write to NEWS-FILE the list of packages added between OLD and NEW."
93 (let ((added (lset-difference string=? (map car new) (map car old))))
94 (with-atomic-file-replacement news-file
95 (lambda (input output)
96 (rewrite-org-section input output
97 (make-regexp "^(\\*+) (.*) new packages")
99 (let ((stars (match:substring match 1)))
101 "~a ~a new packages~%~%~a~%~%"
103 (enumeration->paragraph added)))))))))
105 (define (write-packages-updates news-file old new)
106 "Write to NEWS-FILE the list of packages upgraded between OLD and NEW."
107 (let ((upgraded (filter-map (match-lambda
108 ((package . new-version)
109 (match (assoc package old)
111 (and (version>? new-version old-version)
112 (string-append package "@"
116 (with-atomic-file-replacement news-file
117 (lambda (input output)
118 (rewrite-org-section input output
119 (make-regexp "^(\\*+) (.*) package updates")
121 (let ((stars (match:substring match 1)))
123 "~a ~a package updates~%~%~a~%~%"
124 stars (length upgraded)
125 (enumeration->paragraph upgraded)))))))))
128 (define (main . args)
130 ((news-file data-directory)
131 ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH and
132 ;; in external channels.
133 (parameterize ((%package-module-path
134 %default-package-module-path))
135 (define (package-file version)
136 (string-append data-directory "/packages-"
139 (let-values (((previous-version new-version)
140 (call-with-input-file news-file NEWS->versions)))
141 (let* ((old (call-with-input-file (package-file previous-version)
143 (new (fold-packages (lambda (p r)
144 (alist-cons (package-name p) (package-version p)
147 (call-with-output-file (package-file new-version)
149 (pretty-print new port)))
151 (write-packages-added news-file old new)
152 (write-packages-updates news-file old new)))))
154 (format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY
156 Update the list of new and updated packages in NEWS-FILE using the
157 previous-version package list from DATA-DIRECTORY.\n")
160 (apply main (cdr (command-line)))