projects/guix·blob master · refs

120 lines · 3.8 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015 Alex Kost <[email protected]>
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
52newspace."
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.
62PATTERN 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
73to 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 "\
91GNU Guix consists of Scheme code that implements the deployment model
92of the Nix package management tool. In fact, it currently talks to a
93build daemon whose code comes from Nix (see the manual for details.)
94
95Nix was initially written by Eelco Dolstra; other people have been
96contributing 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
109Generate 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