1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017, 2018, 2019 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))
37 (make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)"))
39 (define (NEWS->versions port)
40 "Return two values: the previous version and the current version as read
41 from PORT, which is an input port on the 'NEWS' file."
43 (let ((line (read-line port)))
44 (cond ((eof-object? line)
45 (error "failed to determine previous and current version"
47 ((regexp-exec %header-rx line)
50 (values (match:substring match 3)
51 (match:substring match 2))))
55 (define (skip-to-org-heading port)
56 "Read from PORT until an Org heading is found."
58 (let ((next (peek-char port)))
59 (cond ((eqv? next #\*)
62 (error "next heading could not be found"))
67 (define (rewrite-org-section input output heading-rx proc)
68 "Write to OUTPUT the text read from INPUT, but with the first Org section
69 matching HEADING-RX replaced by NEW-HEADING and CONTENTS."
71 (let ((line (read-line input)))
72 (cond ((eof-object? line)
73 (error "failed to match heading regexp" heading-rx))
74 ((regexp-exec heading-rx line)
78 (skip-to-org-heading input)
79 (dump-port input output)
86 (define (enumeration->paragraph lst)
87 "Turn LST, a list of strings, into a single string that is a ready-to-print
89 (fill-paragraph (string-join (sort lst string<?) ", ")
92 (define (write-packages-added news-file old new)
93 "Write to NEWS-FILE the list of packages added between OLD and NEW."
94 (let ((added (lset-difference string=? (map car new) (map car old))))
95 (with-atomic-file-replacement news-file
96 (lambda (input output)
97 (rewrite-org-section input output
98 (make-regexp "^(\\*+) (.*) new packages")
100 (let ((stars (match:substring match 1)))
102 "~a ~a new packages~%~%"
103 stars (length added)))))))))
105 (define (write-packages-updates news-file old new)
106 "Write to NEWS-FILE the list of packages upgraded between OLD and NEW."
108 '("gcc-toolchain" "glibc" "binutils" "gdb" ;toolchain
109 "shepherd" "linux-libre" "xorg-server" "cups" ;OS
110 "gnome" "xfce" "enlightenment" "lxde" "mate" ;desktop env.
111 "guile" "bash" "python" "python2" "perl" ;languages
112 "ghc" "rust" "go" "julia" "r" "ocaml"
113 "icedtea" "openjdk" "clojure" "sbcl" "racket"
114 "emacs" "gimp" "inkscape" "libreoffice" ;applications
115 "octave" "icecat" "gnupg"))
117 (let* ((table (fold (lambda (package table)
120 (vhash-cons name version table))))
123 (latest (lambda (name)
124 (let ((versions (vhash-fold* cons '() name table)))
125 (match (sort versions version>?)
126 ((latest . _) latest)))))
127 (upgraded (filter-map (match-lambda
128 ((package . new-version)
129 (match (assoc package old)
131 (and (string=? new-version
133 (version>? new-version old-version)
134 (cons package new-version)))
137 (noteworthy (filter (match-lambda
139 (member package important)))
141 (with-atomic-file-replacement news-file
142 (lambda (input output)
143 (rewrite-org-section input output
144 (make-regexp "^(\\*+) (.*) package updates")
146 (let ((stars (match:substring match 1))
147 (lst (map (match-lambda
149 (string-append package " "
153 "~a ~a package updates~%~%Noteworthy updates:~%~a~%~%"
154 stars (length upgraded)
155 (enumeration->paragraph lst)))))))))
158 (define (main . args)
160 ((news-file data-directory)
161 ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH and
162 ;; in external channels.
163 (parameterize ((%package-module-path
164 %default-package-module-path))
165 (define (package-file version)
166 (string-append data-directory "/packages-"
169 (let-values (((previous-version new-version)
170 (call-with-input-file news-file NEWS->versions)))
171 (format (current-error-port) "Updating NEWS for ~a to ~a...~%"
172 previous-version new-version)
173 (let* ((old (call-with-input-file (package-file previous-version)
175 (new (fold-packages (lambda (p r)
176 (alist-cons (package-name p) (package-version p)
179 (call-with-output-file (package-file new-version)
181 (pretty-print new port)))
183 (write-packages-added news-file old new)
184 (write-packages-updates news-file old new)))))
186 (format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY
188 Update the list of new and updated packages in NEWS-FILE using the
189 previous-version package list from DATA-DIRECTORY.\n")
192 (apply main (cdr (command-line)))