build-aux/update-NEWS.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   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.
  10 ;;;
  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.
  15 ;;;
  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/>.
  18
  19 ;;; Commentary:
  20 ;;;
  21 ;;; This script updates the list of new and updated packages in 'NEWS'.
  22 ;;;
  23 ;;; Code:
  24
  25 (use-modules (gnu) (guix)
  26              (guix build utils)
  27              ((guix ui) #:select (fill-paragraph))
  28              (srfi srfi-1)
  29              (srfi srfi-11)
  30              (ice-9 match)
  31              (ice-9 rdelim)
  32              (ice-9 regex)
  33              (ice-9 vlist)
  34              (ice-9 pretty-print))
  35
  36 (define %header-rx
  37   (make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)"))
  38
  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."
  42   (let loop ()
  43     (let ((line (read-line port)))
  44       (cond ((eof-object? line)
  45              (error "failed to determine previous and current version"
  46                     port))
  47             ((regexp-exec %header-rx line)
  48              =>
  49              (lambda (match)
  50                (values (match:substring match 3)
  51                        (match:substring match 2))))
  52             (else
  53              (loop))))))
  54
  55 (define (skip-to-org-heading port)
  56   "Read from PORT until an Org heading is found."
  57   (let loop ()
  58     (let ((next (peek-char port)))
  59       (cond ((eqv? next #\*)
  60              #t)
  61             ((eof-object? next)
  62              (error "next heading could not be found"))
  63             (else
  64              (read-line port)
  65              (loop))))))
  66
  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."
  70   (let loop ()
  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)
  75              =>
  76              (lambda (match)
  77                (proc match output)
  78                (skip-to-org-heading input)
  79                (dump-port input output)
  80                #t))
  81             (else
  82              (display line output)
  83              (newline output)
  84              (loop))))))
  85
  86 (define (enumeration->paragraph lst)
  87   "Turn LST, a list of strings, into a single string that is a ready-to-print
  88 paragraph."
  89   (fill-paragraph (string-join (sort lst string<?) ", ")
  90                   75))
  91
  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")
  99                              (lambda (match port)
 100                                (let ((stars (match:substring match 1)))
 101                                  (format port
 102                                          "~a ~a new packages~%~%"
 103                                          stars (length added)))))))))
 104
 105 (define (write-packages-updates news-file old new)
 106   "Write to NEWS-FILE the list of packages upgraded between OLD and NEW."
 107   (define important
 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"))
 116
 117   (let* ((table    (fold (lambda (package table)
 118                            (match package
 119                              ((name . version)
 120                               (vhash-cons name version table))))
 121                          vlist-null
 122                          new))
 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)
 130                                     ((_ . old-version)
 131                                      (and (string=? new-version
 132                                                     (latest package))
 133                                           (version>? new-version old-version)
 134                                           (cons package new-version)))
 135                                     (_ #f))))
 136                                new))
 137          (noteworthy (filter (match-lambda
 138                                ((package . version)
 139                                 (member package important)))
 140                              upgraded)))
 141     (with-atomic-file-replacement news-file
 142       (lambda (input output)
 143         (rewrite-org-section input output
 144                              (make-regexp "^(\\*+) (.*) package updates")
 145                              (lambda (match port)
 146                                (let ((stars (match:substring match 1))
 147                                      (lst   (map (match-lambda
 148                                                    ((package . version)
 149                                                     (string-append package " "
 150                                                                    version)))
 151                                                  noteworthy)))
 152                                  (format port
 153                                          "~a ~a package updates~%~%Noteworthy updates:~%~a~%~%"
 154                                          stars (length upgraded)
 155                                          (enumeration->paragraph lst)))))))))
 156
 157 \f
 158 (define (main . args)
 159   (match 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-"
 167                         version ".txt"))
 168
 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)
 174                        read))
 175                 (new (fold-packages (lambda (p r)
 176                                       (alist-cons (package-name p) (package-version p)
 177                                                   r))
 178                                     '())))
 179            (call-with-output-file (package-file new-version)
 180              (lambda (port)
 181                (pretty-print new port)))
 182
 183            (write-packages-added news-file old new)
 184            (write-packages-updates news-file old new)))))
 185     (x
 186      (format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY
 187
 188 Update the list of new and updated packages in NEWS-FILE using the
 189 previous-version package list from DATA-DIRECTORY.\n")
 190      (exit 1))))
 191
 192 (apply main (cdr (command-line)))