;;; 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
                    <tr><td class='mode'>-rw-r--r--</td><td class='upd'><a href='/guix/diff/gnu/packages/python-web.scm?id=74f38150981df1416e46b1fa6a2abf4f11e7281c&amp;id2=e92961a687c9626daadc6d2585f543f023d468b5'>gnu/packages/python-web.scm</a></td><td class='right'>33</td><td class='graph'><table summary='file diffstat' width='33%'><tr><td class='add' style='width: 48.5%;'/><td class='rem' style='width: 51.5%;'/><td class='none' style='width: 0.0%;'/></tr></table></td></tr>
</table><div class='diffstat-summary'>1 files changed, 16 insertions, 17 deletions</div><table summary='diff' class='diff'><tr><td><div class='head'>diff --git a/gnu/packages/python-web.scm b/gnu/packages/python-web.scm<br/>index c6e760ce35..483abec2d5 100644<br/>--- a/<a href='/guix/tree/gnu/packages/python-web.scm?id=e92961a687c9626daadc6d2585f543f023d468b5'>gnu/packages/python-web.scm</a><br/>+++ b/<a href='/guix/tree/gnu/packages/python-web.scm?id=74f38150981df1416e46b1fa6a2abf4f11e7281c'>gnu/packages/python-web.scm</a></div><div class='hunk'>@@ -3769,25 +3769,24 @@ itself.")</div><div class='ctx'> </div><div class='ctx'> (define-public python-flask-migrate</div><div class='ctx'>   (package</div><div class='del'>-  (name "python-flask-migrate")</div><div class='del'>-  (version "2.5.3")</div><div class='del'>-  (source</div><div class='del'>-    (origin</div><div class='del'>-      (method url-fetch)</div><div class='del'>-      (uri (pypi-uri "Flask-Migrate" version))</div><div class='del'>-      (sha256</div><div class='del'>-        (base32</div><div class='del'>-          "1vip9ww6l18dxffjsggm83k71zkvihxpnhaswpv8klh95s6517d6"))))</div><div class='del'>-  (build-system python-build-system)</div><div class='del'>-  (propagated-inputs</div><div class='del'>-   (list python-flask python-alembic python-sqlalchemy</div><div class='del'>-         python-flask-script python-flask-sqlalchemy))</div><di