summaryrefslogtreecommitdiff
path: root/tissue/commit.scm
blob: 3dfd45f3d66a5839c0d07458ae2e06f21a7dcfc9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
;;; tissue --- Text based issue tracker
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of tissue.
;;;
;;; tissue 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.
;;;
;;; tissue 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 tissue.  If not, see <https://www.gnu.org/licenses/>.

(define-module (tissue commit)
  #:use-module (oop goops)
  #:use-module (term ansi-color)
  #:use-module (git)
  #:use-module (tissue document)
  #:use-module (tissue git)
  #:use-module (tissue person)
  #:use-module (tissue utils)
  #:export (<commit>
            commit-hash
            doc:commit-author
            doc:commit-author-date
            commits-in-current-repository))

(define-class <commit> (<document>)
  (hash #:getter commit-hash #:init-keyword #:hash)
  ;; We prefix commit-author and commit-author-date with doc: in order
  ;; to not conflict with similarly named functions from (git) and
  ;; (tissue git).
  (author #:getter doc:commit-author #:init-keyword #:author)
  (author-date #:getter doc:commit-author-date #:init-keyword #:author-date))

(define-method (document-id-term (commit <commit>))
  "Return the ID term for DOCUMENT."
  (string-append "Qcommit." (commit-hash commit)))

(define-method (document-boolean-terms (commit <commit>))
  "Return the boolean terms in COMMIT."
  (list (string-append "Qcommit." (commit-hash commit))
        (string-append "A" (doc:commit-author commit))))

(define-method (document-recency-date (commit <commit>))
  "Return a date representing the recency of DOCUMENT"
  (doc:commit-author-date commit))

(define-method (document-snippet-source-text (commit <commit>))
  "Return the source text for COMMIT from which to extract a search
result snippet."
  (commit-body
   (commit-lookup (current-git-repository)
                  (string->oid (commit-hash commit)))))

(define-method (document-text (commit <commit>))
  "Return the full text of COMMIT."
  (commit-message
   (commit-lookup (current-git-repository)
                  (string->oid (commit-hash commit)))))

(define-method (print (commit <commit>) mset port)
  "Print COMMIT, a <commit> object, to PORT as part of command-line
search results. MSET is the xapian MSet object representing a list of
search results."
  (display (colorize-string (document-title commit) 'MAGENTA 'UNDERLINE)
           port)
  (newline port)
  (display (colorize-string "COMMIT" 'BOLD 'YELLOW)
           port)
  (display " " port)
  (display (colorize-string (commit-hash commit) 'YELLOW)
           port)
  (newline port)
  (display (string-append
            "authored "
            (colorize-string (human-date-string (doc:commit-author-date commit)) 'CYAN)
            " by "
            (colorize-string (doc:commit-author commit) 'CYAN))
           port)
  (newline port)
  (let ((snippet (document-snippet commit mset)))
    (unless (string-null? snippet)
      (display snippet port)
      (newline port)
      (newline port))))

(define-method (document->sxml (commit <commit>) mset)
  "Render COMMIT, a <commit> object, to SXML. MSET is the xapian MSet
object representing a list of search results."
  `(li (@ (class ,(string-append "search-result search-result-commit")))
       (a (@ (href ,(document-web-uri commit))
             (class "search-result-title"))
          ,(document-title commit))
       (div (@ (class "search-result-metadata"))
            (span (@ (class ,(string-append "document-type commit-document-type")))
                  "commit")
            ,(string-append
              (format #f " authored ~a by ~a"
                      (human-date-string (doc:commit-author-date commit))
                      (doc:commit-author commit))))
       ,@(let ((snippet (document-sxml-snippet commit mset)))
           (if snippet
               (list `(div (@ (class "search-result-snippet"))
                           ,@snippet))
               (list)))))

(define (repository-commits repository)
  "Return a list of <commit> objects representing commits in
REPOSITORY."
  (fold-commits (lambda (commit result)
                  (cons (make <commit>
                          #:title (commit-summary commit)
                          #:hash (oid->string (commit-id commit))
                          #:author (resolve-alias (signature-name (commit-author commit))
                                                  (%aliases))
                          #:author-date (commit-author-date commit))
                        result))
                (list)
                repository))

(define (commits-in-current-repository)
  "Return a list of <commit> objects representing commits in current
repository."
  (repository-commits (current-git-repository)))