build: Generate 'AUTHORS'.

* build-aux/generate-authors.scm: New file.
* Makefile.am (gen-AUTHORS): New target.
  (dist-hook, .PHONY): Add it.
This commit is contained in:
Alex Kost 2015-07-04 12:27:26 +03:00
parent f2820e0763
commit a8ac45b19e
2 changed files with 130 additions and 2 deletions

View File

@ -1,6 +1,7 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2015 Alex Kost <alezost@gmail.com>
#
# This file is part of GNU Guix.
#
@ -363,7 +364,9 @@ guix-binary.%.tar.xz:
"$(top_srcdir)/build-aux/make-binary-tarball.scm" "$*" "$@"
dist-hook: sync-descriptions gen-ChangeLog assert-no-store-file-names
dist-hook: sync-descriptions gen-ChangeLog gen-AUTHORS
dist-hook: assert-no-store-file-names
distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
sync-descriptions:
@ -378,6 +381,11 @@ gen-ChangeLog:
mv $(distdir)/cl-t $(distdir)/ChangeLog; \
fi
gen-AUTHORS:
$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/generate-authors.scm" \
"$(top_srcdir)" "$(distdir)/AUTHORS"
# Make sure we're not shipping a file that embeds a local /gnu/store file name.
assert-no-store-file-names:
if grep -r --exclude=*.texi --exclude=*.info \
@ -397,6 +405,6 @@ assert-final-inputs-self-contained:
$(top_builddir)/pre-inst-env "$(GUILE)" \
"$(top_srcdir)/build-aux/check-final-inputs-self-contained.scm"
.PHONY: sync-descriptions gen-ChangeLog clean-go
.PHONY: sync-descriptions gen-ChangeLog gen-AUTHORS clean-go
.PHONY: assert-no-store-file-names assert-binaries-available
.PHONY: assert-final-inputs-self-contained

View File

@ -0,0 +1,120 @@
;;; 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