From a8ac45b19ebb3006ced49b46342e01632829cef2 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Sat, 4 Jul 2015 12:27:26 +0300 Subject: [PATCH] build: Generate 'AUTHORS'. * build-aux/generate-authors.scm: New file. * Makefile.am (gen-AUTHORS): New target. (dist-hook, .PHONY): Add it. --- Makefile.am | 12 +++- build-aux/generate-authors.scm | 120 +++++++++++++++++++++++++++++++++ 2 files changed, 130 insertions(+), 2 deletions(-) create mode 100644 build-aux/generate-authors.scm 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 # Copyright © 2013 Andreas Enge +# Copyright © 2015 Alex Kost # # 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 +;;; +;;; 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 . + +;;; +;;; 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