You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

121 lines
3.8 KiB

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