executable_guile-git-list-commiters 2.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879
  1. (use-modules (git)
  2. (git repository)
  3. (git reference)
  4. (git oid)
  5. (git tag)
  6. (git commit)
  7. (git structs) ;signature-email, etc.
  8. (srfi srfi-1)
  9. (srfi srfi-26)
  10. (ice-9 match)
  11. (ice-9 vlist))
  12. (define commit-author*
  13. (compose signature-name commit-author))
  14. (define commit-committer*
  15. (compose signature-name commit-committer))
  16. (define-syntax-rule (false-if-git-error exp)
  17. (catch 'git-error
  18. (lambda () exp)
  19. (const #f)))
  20. (define* (fold-commits proc seed repo
  21. #:key
  22. (start (reference-target
  23. (repository-head repo)))
  24. end)
  25. "Call PROC on each commit of REPO, starting at START (an OID), and until
  26. END if specified."
  27. (let loop ((commit (commit-lookup repo start))
  28. (result seed))
  29. (let ((parent (false-if-git-error (commit-parent commit))))
  30. (if parent
  31. (if (and end (oid=? (commit-id parent) end))
  32. (proc parent result)
  33. (loop parent (proc parent result)))
  34. result))))
  35. (define (reviewers repo)
  36. "Return a list of review count/committer pairs."
  37. (define vhash
  38. (fold-commits (lambda (commit result)
  39. (if (string=? (commit-author* commit)
  40. (commit-committer* commit))
  41. result
  42. (vhash-cons (commit-committer* commit) #t
  43. result)))
  44. vlist-null
  45. repo))
  46. (define committers
  47. (delete-duplicates
  48. (fold-commits (lambda (commit result)
  49. (cons (commit-committer* commit)
  50. result))
  51. '()
  52. repo)))
  53. (map (lambda (committer)
  54. (cons (vhash-fold* (lambda (_ count)
  55. (+ 1 count))
  56. 0
  57. committer
  58. vhash)
  59. committer))
  60. committers))
  61. (define (reviewer< r1 r2)
  62. (match r1
  63. ((count1 . name1)
  64. (match r2
  65. ((count2 . name2)
  66. (< count1 count2))))))
  67. (libgit2-init!)
  68. (define repo
  69. (repository-open "."))