build-aux/generate-authors.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
   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 ;;;
  20 ;;; Generate AUTHORS file for directory with the Guix git repository.
  21 ;;;
  22
  23 (use-modules
  24  (ice-9 popen)
  25  (ice-9 rdelim)
  26  (ice-9 match)
  27  (srfi srfi-1)
  28  (guix config)
  29  (guix utils)
  30  (guix build utils))
  31
  32 (define %guix-dir
  33   (make-parameter #f))
  34
  35 (define-syntax-rule (append-maybe init-lst (test add-lst) ...)
  36   (let* ((lst init-lst)
  37          (lst (if test
  38                   (append lst add-lst)
  39                   lst))
  40          ...)
  41     lst))
  42
  43 (define (command-output cmd . args)
  44   "Execute CMD with ARGS and return its output without trailing newspace."
  45   (let* ((port (apply open-pipe* OPEN_READ cmd args))
  46          (output (read-string port)))
  47     (close-port port)
  48     (string-trim-right output #\newline)))
  49
  50 (define (git-output . args)
  51   "Execute git command with ARGS and return its output without trailing
  52 newspace."
  53   (with-directory-excursion (%guix-dir)
  54     (apply command-output "git" args)))
  55
  56 (define* (contributors-string #:optional (range "HEAD"))
  57   "Return a string with names of people contributed to commit RANGE."
  58   (git-output "shortlog" "--numbered" "--summary" "--email" range))
  59
  60 (define* (tags #:key pattern sort)
  61   "Return a list of the git repository tags.
  62 PATTERN is passed to '--list' and SORT is passed to '--sort' options of
  63 'git tag' command."
  64   (let* ((args (append-maybe
  65                 '("tag")
  66                 (pattern (list "--list" pattern))
  67                 (sort    (list "--sort" sort))))
  68          (output (apply git-output args)))
  69     (string-split output #\newline)))
  70
  71 (define (version-tags)
  72   "Return only version tags (v0.8, etc.) sorted from the biggest version
  73 to the smallest one."
  74   (tags #:pattern "v*"
  75         #:sort "-version:refname"))
  76
  77 (define (generate-authors-file file)
  78   "Generate authors FILE."
  79   (define previous-release-tag
  80     (find (lambda (tag)
  81             (version>? %guix-version
  82                        (substring tag 1))) ; remove leading 'v'
  83           (version-tags)))
  84
  85   (define release-range
  86     (string-append previous-release-tag "..HEAD"))
  87
  88   (with-output-to-file file
  89     (lambda ()
  90       (display "\
  91 GNU Guix consists of Scheme code that implements the deployment model
  92 of the Nix package management tool.  In fact, it currently talks to a
  93 build daemon whose code comes from Nix (see the manual for details.)
  94
  95 Nix was initially written by Eelco Dolstra; other people have been
  96 contributing to it.  See `nix/AUTHORS' for details.\n\n")
  97       (format #t "Contributors to GNU Guix ~a:\n\n"
  98               %guix-version)
  99       (display (contributors-string release-range))
 100       (newline) (newline)
 101       (display "Overall contributors:\n\n")
 102       (display (contributors-string))
 103       (newline))))
 104
 105 (define (show-help)
 106   (match (command-line)
 107     ((me _ ...)
 108      (format #t "Usage: guile ~a DIRECTORY AUTHORS
 109 Generate AUTHORS file for DIRECTORY with the Guix git repository.\n"
 110              me))))
 111
 112 (match (command-line)
 113   ((_ guix-dir authors-file)
 114    (parameterize ((%guix-dir guix-dir))
 115      (generate-authors-file authors-file)))
 116   (_
 117    (show-help)
 118    (exit 1)))
 119
 120 ;;; generate-authors.scm ends here