build: Generate 'AUTHORS'.

* build-aux/generate-authors.scm: New file.
* Makefile.am (gen-AUTHORS): New target.
  (dist-hook, .PHONY): Add it.

2 files changed, 130 insertions, 2 deletions

diff --git a/Makefile.am b/Makefile.am
index cc0b135de6..44d3b09a82 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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
diff --git a/build-aux/generate-authors.scm b/build-aux/generate-authors.scm
new file mode 100644
index 0000000000..1dc882ff8a
--- /dev/null
+++ b/build-aux/generate-authors.scm
@@ -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