;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;;
;;; 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/>.

;;;
;;; Generate AUTHORS file for directory with the Guix git repository.
;;;

(use-modules
 (ice-9 popen)
 (ice-9 rdelim)
 (ice-9 match)
 (srfi srfi-1)
 (guix config)
 (guix utils)
 (guix build utils))

(define %guix-dir
  (make-parameter #f))

(define-syntax-rule (append-maybe init-lst (test add-lst) ...)
  (let* ((lst init-lst)
         (lst (if test
                  (append lst add-lst)
                  lst))
         ...)
    lst))

(define (command-output cmd . args)
  "Execute CMD with ARGS and return its output without trailing newspace."
  (let* ((port (apply open-pipe* OPEN_READ cmd args))
         (output (read-string port)))
    (close-port port)
    (string-trim-right output #\newline)))

(define (git-output . args)
  "Execute git command with ARGS and return its output without trailing
newspace."
  (with-directory-excursion (%guix-dir)
    (apply command-output "git" args)))

(define* (contributors-string #:optional (range "HEAD"))
  "Return a string with names of people contributed to commit RANGE."
  (git-output "shortlog" "--numbered" "--summary" "--email" range))

(define* (tags #:key pattern sort)
  "Return a list of the git repository tags.
PATTERN is passed to '--list' and SORT is passed to '--sort' options of
'git tag' command."
  (let* ((args (append-maybe
                '("tag")
                (pattern (list "--list" pattern))
                (sort    (list "--sort" sort))))
         (output (apply git-output args)))
    (string-split output #\newline)))

(define (version-tags)
  "Return only version tags (v0.8, etc.) sorted from the biggest version
to the smallest one."
  (tags #:pattern "v*"
        #:sort "-version:refname"))

(define (generate-authors-file file)
  "Generate authors FILE."
  (define previous-release-tag
    (find (lambda (tag)
            (version>? %guix-version
                       (substring tag 1))) ; remove leading 'v'
          (version-tags)))

  (define release-range
    (string-append previous-release-tag "..HEAD"))

  (with-output-to-file file
    (lambda ()
      (display "\
GNU Guix consists of Scheme code that implements the deployment model
of the Nix package management tool.  In fact, it currently talks to a
build daemon whose code comes from Nix (see the manual for details.)

Nix was initially written by Eelco Dolstra; other people have been
contributing to it.  See `nix/AUTHORS' for details.\n\n")
      (format #t "Contributors to GNU Guix ~a:\n\n"
              %guix-version)
      (display (contributors-string release-range))
      (newline) (newline)
      (display "Overall contributors:\n\n")
      (display (contributors-string))
      (newline))))

(define (show-help)
  (match (command-line)
    ((me _ ...)
     (format #t "Usage: guile ~a DIRECTORY AUTHORS
Generate AUTHORS file for DIRECTORY with the Guix git repository.\n"
             me))))

(match (command-line)
  ((_ guix-dir authors-file)
   (parameterize ((%guix-dir guix-dir))
     (generate-authors-file authors-file)))
  (_
   (show-help)
   (exit 1)))

;;; generate-authors.scm ends here
ffb9fb6e4dbc2fa'>guix package: "guix package -f FILE" ensures FILE returns a package.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-05-26 23:02:02 +0200'>2019-05-26</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=002d17dcaacba0f86265b34f2509419d9e21224d'>discovery: 'all-modules' returns modules in path order.</a><span class='msg-avail'>...</span></td><td>Robert Vollmert</td></tr>
<tr><td><span title='2019-05-13 10:54:13 -0400'>2019-05-13</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=ccabb664ed55d44767e037bb73169be2ecf9449d'>tests: Fix guix-package.sh.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2019-05-09 00:10:34 -0700'>2019-05-09</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=387e6b9e340ce4b401f220f72881415623a466f7'>ui: Make package outputs searchable.</a><span class='msg-avail'>...</span></td><td>Chris Marusich</td></tr>
<tr><td><span title='2019-02-07 15:46:45 +0100'>2019-02-07</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=487cbb0164c715e722b622fa800fa0b217fa132c'>profiles: Raise an error for unmatched patterns.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-11-11 23:53:29 +0100'>2018-11-11</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=652163154c06b47936a453f44ea35938789718de'>guix package: '--show' errors when asked for a non-existent package.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-09-21 17:04:37 +0200'>2018-09-21</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=811b21fb15d36b06fde994ca7ef5916a9a19f250'>profiles: 'packages-&gt;manifest' now accepts inferior packages.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-07-13 17:28:39 +0200'>2018-07-13</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=bc6e291ef0b3c71c07e50d88d7764e5dd334e8b1'>guix package: Use relative symlinks to generations.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-06-06 14:37:35 +0200'>2018-06-06</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=477ee222aa796257b5f32966da662e76fe706332'>tests: Adjust 'guix package' test to "python2" name.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-03-31 23:30:50 +0200'>2018-03-31</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=fc95dc4c34bf88ebd8c21752bf6d54b5cf752d1a'>guix package: Add '--allow-collisions'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2018-02-27 15:46:56 +0100'>2018-02-27</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=0fb405796cdb5579c911b30da9d40b4a18cd7f07'>guix package: '--search' no longer shows superseded packages.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-11-11 15:33:47 +0100'>2017-11-11</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=ae0307f7c2a6f382311a1cedcbbb3d35b6623bab'>tests: Adjust to new unbound-variable error message.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-06-26 22:52:06 +0200'>2017-06-26</span></td><td><a href='/guix/commit/tests/guix-package.sh?id=fc8fdcf56ecc159cb4e85ffdde60a54c4fa5c04f'>guix package: 'guix package -r PKG -u' does not upgrade PKG.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>