You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

193 lines
7.9 KiB

  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. ;;; Commentary:
  19. ;;;
  20. ;;; This script updates the list of new and updated packages in 'NEWS'.
  21. ;;;
  22. ;;; Code:
  23. (use-modules (gnu) (guix)
  24. (guix build utils)
  25. ((guix ui) #:select (fill-paragraph))
  26. (srfi srfi-1)
  27. (srfi srfi-11)
  28. (ice-9 match)
  29. (ice-9 rdelim)
  30. (ice-9 regex)
  31. (ice-9 vlist)
  32. (ice-9 pretty-print))
  33. (define %header-rx
  34. (make-regexp "^\\* Changes in (version )?([0-9.]+) \\(since ([0-9.]+)\\)"))
  35. (define (NEWS->versions port)
  36. "Return two values: the previous version and the current version as read
  37. from PORT, which is an input port on the 'NEWS' file."
  38. (let loop ()
  39. (let ((line (read-line port)))
  40. (cond ((eof-object? line)
  41. (error "failed to determine previous and current version"
  42. port))
  43. ((regexp-exec %header-rx line)
  44. =>
  45. (lambda (match)
  46. (values (match:substring match 3)
  47. (match:substring match 2))))
  48. (else
  49. (loop))))))
  50. (define (skip-to-org-heading port)
  51. "Read from PORT until an Org heading is found."
  52. (let loop ()
  53. (let ((next (peek-char port)))
  54. (cond ((eqv? next #\*)
  55. #t)
  56. ((eof-object? next)
  57. (error "next heading could not be found"))
  58. (else
  59. (read-line port)
  60. (loop))))))
  61. (define (rewrite-org-section input output heading-rx proc)
  62. "Write to OUTPUT the text read from INPUT, but with the first Org section
  63. matching HEADING-RX replaced by NEW-HEADING and CONTENTS."
  64. (let loop ()
  65. (let ((line (read-line input)))
  66. (cond ((eof-object? line)
  67. (error "failed to match heading regexp" heading-rx))
  68. ((regexp-exec heading-rx line)
  69. =>
  70. (lambda (match)
  71. (proc match output)
  72. (skip-to-org-heading input)
  73. (dump-port input output)
  74. #t))
  75. (else
  76. (display line output)
  77. (newline output)
  78. (loop))))))
  79. (define (enumeration->paragraph lst)
  80. "Turn LST, a list of strings, into a single string that is a ready-to-print
  81. paragraph."
  82. (fill-paragraph (string-join (sort lst string<?) ", ")
  83. 75))
  84. (define (write-packages-added news-file old new)
  85. "Write to NEWS-FILE the list of packages added between OLD and NEW."
  86. (let ((added (lset-difference string=? (map car new) (map car old))))
  87. (with-atomic-file-replacement news-file
  88. (lambda (input output)
  89. (rewrite-org-section input output
  90. (make-regexp "^(\\*+) (.*) new packages")
  91. (lambda (match port)
  92. (let ((stars (match:substring match 1)))
  93. (format port
  94. "~a ~a new packages~%~%"
  95. stars (length added)))))))))
  96. (define (write-packages-updates news-file old new)
  97. "Write to NEWS-FILE the list of packages upgraded between OLD and NEW."
  98. (define important
  99. '("gcc-toolchain" "glibc" "binutils" "gdb" ;toolchain
  100. "shepherd" "linux-libre" "xorg-server" "cups" ;OS
  101. "gnome" "xfce" "enlightenment" "lxde" "mate" ;desktop env.
  102. "guile" "bash" "python" "python2" "perl" ;languages
  103. "ghc" "rust" "go" "julia" "r" "ocaml"
  104. "icedtea" "openjdk" "clojure" "sbcl" "racket"
  105. "emacs" "gimp" "inkscape" "libreoffice" ;applications
  106. "octave" "icecat" "gnupg"))
  107. (let* ((table (fold (lambda (package table)
  108. (match package
  109. ((name . version)
  110. (vhash-cons name version table))))
  111. vlist-null
  112. new))
  113. (latest (lambda (name)
  114. (let ((versions (vhash-fold* cons '() name table)))
  115. (match (sort versions version>?)
  116. ((latest . _) latest)))))
  117. (upgraded (filter-map (match-lambda
  118. ((package . new-version)
  119. (match (assoc package old)
  120. ((_ . old-version)
  121. (and (string=? new-version
  122. (latest package))
  123. (version>? new-version old-version)
  124. (cons package new-version)))
  125. (_ #f))))
  126. new))
  127. (noteworthy (filter (match-lambda
  128. ((package . version)
  129. (member package important)))
  130. upgraded)))
  131. (with-atomic-file-replacement news-file
  132. (lambda (input output)
  133. (rewrite-org-section input output
  134. (make-regexp "^(\\*+) (.*) package updates")
  135. (lambda (match port)
  136. (let ((stars (match:substring match 1))
  137. (lst (map (match-lambda
  138. ((package . version)
  139. (string-append package " "
  140. version)))
  141. noteworthy)))
  142. (format port
  143. "~a ~a package updates~%~%Noteworthy updates:~%~a~%~%"
  144. stars (length upgraded)
  145. (enumeration->paragraph lst)))))))))
  146. (define (main . args)
  147. (match args
  148. ((news-file data-directory)
  149. ;; Don't browse things listed in the user's $GUIX_PACKAGE_PATH and
  150. ;; in external channels.
  151. (parameterize ((%package-module-path
  152. %default-package-module-path))
  153. (define (package-file version)
  154. (string-append data-directory "/packages-"
  155. version ".txt"))
  156. (let-values (((previous-version new-version)
  157. (call-with-input-file news-file NEWS->versions)))
  158. (format (current-error-port) "Updating NEWS for ~a to ~a...~%"
  159. previous-version new-version)
  160. (let* ((old (call-with-input-file (package-file previous-version)
  161. read))
  162. (new (fold-packages (lambda (p r)
  163. (alist-cons (package-name p) (package-version p)
  164. r))
  165. '())))
  166. (call-with-output-file (package-file new-version)
  167. (lambda (port)
  168. (pretty-print new port)))
  169. (write-packages-added news-file old new)
  170. (write-packages-updates news-file old new)))))
  171. (x
  172. (format (current-error-port) "Usage: update-NEWS NEWS-FILE DATA-DIRECTORY
  173. Update the list of new and updated packages in NEWS-FILE using the
  174. previous-version package list from DATA-DIRECTORY.\n")
  175. (exit 1))))
  176. (apply main (cdr (command-line)))