-
Notifications
You must be signed in to change notification settings - Fork 4
/
org-github-issues.el
507 lines (433 loc) · 21.8 KB
/
org-github-issues.el
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
;;; org-github-issues.el --- Package for creating todos from Github issues -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Jens Östlund
;; Author: Jens Östlund <[email protected]>
;; Keywords: tools
;; Version: 0.0.3
;; URL: https://github.com/iensu/org-github-issues
;; This program 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.
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; org-github-issues exposes a interactive function `org-github-issues-sync-issues'
;; which prompts for repository name and owner, and then creates org-modo TODOs of
;; all of the open issues in the repository.
;;; Code:
(require 'gh)
(require 'dash)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization options
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup org-github-issues nil
"Tool for creating org-mode todos out of Github issues"
:group 'tools)
(defcustom org-github-issues-user nil
"Github username with which you authenticate to Github."
:type 'string
:group 'org-github-issues)
(defcustom org-github-issues-token nil
"Github Personal Access Token to use for authentication.
This variable exists purely for convenience and should be avoided. Please use `auth-sources' as described in the README instead."
:type 'string
:group 'org-github-issues)
(defcustom org-github-issues-org-file "~/Dropbox/org/projects.org"
"Path to an existing `org-mode' file in which to write issues."
:type '(file :must-match t)
:group 'org-github-issues)
(defcustom org-github-issues-filter-by-assignee nil
"Flag to enable filtering issues by assignee."
:type 'boolean
:group 'org-github-issues)
(defcustom org-github-issues-assignee nil
"The assignee to use for issue filtering if different from `org-github-issuess-user'."
:type 'string
:group 'org-github-issues)
(defcustom org-github-issues-headline-prefix nil
"Flag to enable prefixing headlines with the repostiory name."
:type 'boolean
:group 'org-github-issues)
(defcustom org-github-issues-auto-schedule "+0d"
"Threshold for automatically scheduling new issues."
:type 'string
:group 'org-github-issues)
(defcustom org-github-issues-tags nil
"An alist of org-mode tags to add to all org entries."
:type '(alist :value-type (group string))
:group 'org-github-issues)
(defcustom org-github-issues-issue-tags nil
"An alist of org-mode tags to add to entries corresponding to issues."
:type '(alist :value-type (group string))
:group 'org-github-issues)
(defcustom org-github-issues-pull-tags nil
"An alist of org-mode tags to add to entries corresponding to pull requests."
:type '(alist :value-type (group string))
:group 'org-github-issues)
(defcustom org-github-issues-tag-transformations '(("[\s/-]+" "_"))
"An alist with transformation to apply to github labels when converting them to org-mode tags."
:type '(alist :value-type (group string))
:group 'org-github-issues)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Repository structure
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ogi--repository-create (name level tags)
"Create a repository entry with the specified NAME LEVEL and TAGS."
(list name level tags))
(defun ogi--repository-name (repo)
"Get the repository name."
(nth 0 repo))
(defun ogi--repository-level (repo)
"Get the repository level."
(nth 1 repo))
(defun ogi--repository-tags (repo)
"Get the repository tags."
(nth 2 repo))
(defun ogi--repository-named (repositories name)
"Get the first repository from REPOSITORIES with a matching NAME, or nil if there is no match."
(let* ((filtered (seq-filter (lambda (r) (string= name (ogi--repository-name r))) repositories)))
(if filtered (car filtered) nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helper functions
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ogi--get-auth-token (username)
"Returns Github Personal Access Token from `auth-sources' or `org-github-issues-token' if it exists."
(if org-github-issues-token
org-github-issues-token
(let* ((auth-entries (auth-source-search :host "org-github-issues"
:user username
:max 1))
(secret (plist-get (car auth-entries) :secret)))
(if (functionp secret)
(funcall secret)
secret))))
(defun ogi--connect ()
"Return a Github Issues api connection."
(if org-github-issues-user
(gh-issues-api "api" :auth (gh-oauth-authenticator :username org-github-issues-user
:token (ogi--get-auth-token org-github-issues-user)))
(gh-issues-api "api")))
(defun ogi--pulls-connect ()
"Return a Github Issues api connection."
(if org-github-issues-user
(gh-pulls-api "api" :auth (gh-oauth-authenticator :username org-github-issues-user
:token (ogi--get-auth-token org-github-issues-user)))
(gh-pulls-api "api")))
(defun ogi--fetch-pulls (owner repo &optional connection)
"Return a list of gh-issues-pull objects from OWNER/REPO over CONNECTION."
(let ((conn (or connection
(ogi--pulls-connect))))
(delete-dups
(append
;; Get pull requests assigned
(oref (ogi--pulls-pull-list conn
owner
repo
(if (and org-github-issues-filter-by-assignee
(or org-github-issues-assignee
org-github-issues-user))
(or org-github-issues-assignee org-github-issues-user)
nil))
data)
;; Get pull requests requested for review
(oref (ogi--pulls-pull-list conn
owner
repo)
data)))))
(defun ogi--fetch-issues (owner repo &optional connection)
"Return a list of gh-issues-issue objects from OWNER/REPO over CONNECTION."
(let ((conn (or connection
(ogi--connect))))
(oref (ogi--issues-issue-list conn
owner
repo
(if (and org-github-issues-filter-by-assignee
(or org-github-issues-assignee
org-github-issues-user))
(or org-github-issues-assignee org-github-issues-user)
nil))
data)))
(defun ogi--repo-header-exists-p (repository)
"Return t if a level 1 header for REPOSITORY exists in `org-github-issues-org-file'."
(let ((repo-headers (ogi--collect-synced-repository-names)))
(member repository repo-headers)))
(defun ogi--insert-repo-header (repository)
"Append a level 1 header for REPOSITORY into `org-github-issues-org-file'."
(save-excursion
(with-temp-buffer
(insert (concat "\n"
(org-element-interpret-data
`(headline (:title ,repository :level 1)
(property-drawer nil
((node-property (:key "CATEGORY" :value ,repository))
(node-property (:key "GH_URL" :value ,(format "https://github.com/%s" repository)))))))))
(append-to-file (point-min)
(point-max)
org-github-issues-org-file))))
(defun ogi--collect-synced-repository-names ()
"Return a list of potential repositories nanes from `org-github-issues-org-file'."
(mapcar 'ogi--repository-name (ogi--collect-synced-repositories)))
(defun ogi--collect-synced-repositories ()
"Return a list of potential repositories from `org-github-issues-org-file'."
(let ((repo-regex "[^\s]+/[^\s]+"))
(save-excursion
(with-temp-buffer
(insert-file-contents org-github-issues-org-file)
(org-mode)
(org-element-map (org-element-parse-buffer 'headline) 'headline
(lambda (hl)
(let ((title (car (split-string (org-element-property :title hl) " ")))
(level (org-element-property :level hl))
(tags (org-element-property :tags hl)))
(when (string-match-p repo-regex title)
(ogi--repository-create title level tags)))))))))
(defun ogi--issue-url (owner repo number)
"Return url to issue based on OWNER, REPO and issue NUMBER."
(format "https://github.com/%s/%s/issues/%d"
owner repo number))
(defun ogi--pull-url (owner repo number)
"Return url to issue based on OWNER, REPO and issue NUMBER."
(format "https://github.com/%s/%s/pull/%d"
owner repo number))
(defun ogi--labels-to-tags (issue)
"Return a string of org tags based on labels from ISSUE."
(seq-filter (lambda (s) (and s (not (string= "" s)))) (mapcar (lambda (label) (ogi--replace-multi-regexp-in-string (oref label name) org-github-issues-tag-transformations)) (oref issue labels)))) ;;Replace chars that are invalid for tags
(defun ogi--replace-multi-regexp-in-string(s mappings)
"Replace multiple replace-regexp-in-string in a pipeline fashion (Feed the result of each step as input to the next)."
(let ((result s))
(dolist (m mappings)
(let ((regexp (car m))
(to-replace (car (cdr m))))
(setq result (replace-regexp-in-string regexp to-replace result))))
result))
(defun ogi--scheduled-property (level)
"Return the scheduled string property."
(if org-github-issues-auto-schedule (format "%s SCHEDULED: <%s>\n" (make-string level 32) (org-read-date nil nil org-github-issues-auto-schedule)) nil))
(defun ogi--create-org-entry-for-issue (owner repo level issue)
"Return a string representation of a LEVEL+1 org TODO headline based on OWNER, REPO, ISSUE."
(let* ((title (oref issue title))
(number (oref issue number))
(assignee (oref (oref issue assignee) login))
(body (replace-regexp-in-string "^[\*]+" " - " (or (oref issue body) "")))
(tags (ogi--labels-to-tags issue))
(link (ogi--issue-url owner repo number))
(scheduled (ogi--scheduled-property level))
(params (list :title (if org-github-issues-headline-prefix (format "%s: #%d: %s" repo number title) (format "#%d: %s" number title))
:level (+ level 1)
:todo-keyword "TODO")))
(when org-github-issues-tags (setq tags (append org-github-issues-tags tags)))
(when org-github-issues-issue-tags (setq tags (append org-github-issues-issue-tags tags)))
(setq tags (seq-filter (lambda (s) (and s (not (string= "" s)))) (delete-dups tags)))
(org-element-interpret-data
`(headline ,(if tags
(append params (list :tags tags))
params)
,(if scheduled scheduled)
(property-drawer nil ((node-property (:key "GH_URL" :value ,link))
(node-property (:key "GH_OWNER" :value ,owner))
(node-property (:key "GH_REPO" :value ,repo))
(node-property (:key "GH_ISSUE_NO" :value ,number))
(node-property (:key "GH_ASSIGNE" :value ,assignee))
))
,body))))
(defun ogi--create-org-entry-for-pull (owner repo level pull)
"Return a string representation of a LEVEL+1 org TODO headline based on OWNER, REPO, ISSUE."
(let* ((title (oref pull title))
(number (oref pull number))
(assignee (oref (oref pull assignee) login))
(body (replace-regexp-in-string "^[\*]+" " - " (or (oref pull body) "")))
(tags (ogi--labels-to-tags pull))
(link (ogi--pull-url owner repo number))
(scheduled (ogi--scheduled-property level))
(params (list :title (if org-github-issues-headline-prefix (format "%s: #%d: %s" repo number title) (format "#%d: %s" number title))
:level (+ level 1)
:todo-keyword "TODO")))
(when org-github-issues-tags (setq tags (append org-github-issues-tags tags)))
(when org-github-issues-pull-tags (setq tags (append org-github-issues-pull-tags tags)))
(setq tags (seq-filter (lambda (s) (and s (not (string= "" s)))) (delete-dups tags)))
(org-element-interpret-data
`(headline ,(if tags
(append params (list :tags tags))
params)
,(if scheduled scheduled)
(property-drawer nil ((node-property (:key "GH_URL" :value ,link))
(node-property (:key "GH_OWNER" :value ,owner))
(node-property (:key "GH_REPO" :value ,repo))
(node-property (:key "GH_PULL_NO" :value ,number))
(node-property (:key "GH_ASSIGNE" :value ,assignee))
))
,body))))
(defun ogi--delete-org-entry ()
"Delete org entry at point until the next headline."
(deactivate-mark)
(outline-mark-subtree)
(kill-region (region-beginning) (region-end))
(set-mark (point))
(outline-next-heading)
(kill-region (region-beginning) (region-end))
(deactivate-mark)
(setq org-map-continue-from (outline-previous-heading)))
(defun ogi--delete-existing-issues (owner repo)
"Delete all previously created org entries matching OWNER and REPO."
(let ((match (format "+GH_OWNER={%s}+GH_REPO={%s}" owner repo)))
(org-map-entries
'ogi--delete-org-entry
match
`(,org-github-issues-org-file))))
(defun ogi--delete-existing-pulls (owner repo)
"Delete all previously created org entries matching OWNER and REPO."
(let ((match (format "+GH_OWNER={%s}+GH_REPO={%s}" owner repo)))
(org-map-entries
'ogi--delete-org-entry
match
`(,org-github-issues-org-file))))
(defun ogi--get-org-file-headline-position (headline)
"Return the marker for the given org HEADLINE."
(org-find-exact-headline-in-buffer headline (get-file-buffer org-github-issues-org-file)))
(defun ogi--issue-include-p (issue)
"Predicate that returns non-nil when ISSUE should be included."
(let ((assignee (oref (oref issue assignee) login)))
(or (not org-github-issues-filter-by-assignee)
(and org-github-issues-filter-by-assignee (string= assignee (or org-github-issues-assignee
org-github-issues-user))))))
(defun ogi--pull-include-p (pull)
"Predicate that returns non-nil when PULL should be included."
(let ((assignee (oref (oref pull assignee) login))
(reviewers (mapcar (lambda (r) (oref r login)) (oref pull requested_reviewers))))
(or (not org-github-issues-filter-by-assignee)
(or (and assignee (string= assignee (or org-github-issues-assignee org-github-issues-user)))
(member (or org-github-issues-assignee org-github-issues-user) reviewers)))))
(defun ogi--generate-org-entries-for-issues (owner repo level issues)
"Create entries based on OWNER and REPO from ISSUES."
(mapcar (-partial 'ogi--create-org-entry-for-issue owner repo level) (seq-filter 'ogi--issue-include-p issues)))
(defun ogi--generate-org-entries-for-pulls (owner repo level pulls)
"Create entries based on OWNER and REPO from PULLS."
(mapcar (-partial 'ogi--create-org-entry-for-pull owner repo level) (seq-filter 'ogi--pull-include-p pulls)))
(defun ogi--insert-org-entries (entries headline)
"Insert ENTRIES under HEADLINE."
(let ((body (if entries (string-join entries "\n") nil))
(pos (ogi--get-org-file-headline-position headline)))
(save-excursion
(with-current-buffer (marker-buffer pos)
(goto-char pos)
(outline-next-heading)
(when body
(insert "\n")
(insert (replace-regexp-in-string "\r" "" body))
(insert "\n"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; rest methods
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ogi--issues-issue-list ((api gh-issues-api) user repo &optional assignee)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api issue-cls)) "GET"
(if assignee
(format "/repos/%s/%s/issues?assignee=%s" user repo assignee)
(format "/repos/%s/%s/issues" user repo))))
(defmethod ogi--pulls-pull-list ((api gh-pulls-api) user repo &optional assignee)
(gh-api-authenticated-request
api (gh-object-list-reader (oref api req-cls)) "GET"
(if assignee
(format "/repos/%s/%s/pulls?assignee=%s" user repo assignee)
(format "/repos/%s/%s/pulls?q=%s" user repo "is%3Apr+is%3Aopen+user-review-requested%3A%40me"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public functions
;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun org-github-issues-browse-entry-at-point ()
"Browse the issue/pull that corresponds to the org entry at point."
(interactive)
(let ((origin (current-buffer)))
(when (eq major-mode 'org-agenda-mode) (org-agenda-switch-to))
(let* ((p (point))
(url (string-trim (org-entry-get nil "GH_URL"))))
(when url (browse-url url))
(when (not (equal origin (current-buffer))) (switch-to-buffer origin)))))
;;;###autoload
(defun org-github-issues-sync-issues (repository)
"Fetch and insert all open issues from github REPOSITORY.
Example: https://github.com/foo/bar, the repository is `foo/bar'
Issues will be put under the heading matching REPOSITORY in the file
specified by `org-github-issues-org-file'.
Executing this function will replace already downloaded issues."
(interactive
(list (completing-read "Github repo: "
(ogi--collect-synced-repository-names)
nil nil)))
(let* ((repositories (ogi--collect-synced-repositories))
(owner-and-repo (split-string repository "/"))
(owner (car owner-and-repo))
(repo (cadr owner-and-repo))
(selected (ogi--repository-named repositories repository))
(level (ogi--repository-level selected))
(tags (ogi--repository-tags selected))
(issues (ogi--fetch-issues owner repo)))
(when (not (ogi--repo-header-exists-p repository))
(progn
(message "Creating headline for %s in %s" repository org-github-issues-org-file)
(ogi--insert-repo-header repository)
(sleep-for 1))) ; wait for file to be fully updated before adding issues
(if (not issues)
(message (format "No open issues found in repository https://github.com/%s" repository))
(progn
(ogi--delete-existing-issues owner repo)
(ogi--insert-org-entries (ogi--generate-org-entries-for-issues owner repo level issues)
repository)))))
(defun org-github-issues-sync-pulls (repository)
"Fetch and insert all open pulls awaiting review or assigned to the user from github REPOSITORY.
Example: https://github.com/foo/bar, the repository is `foo/bar'
Pulls will be put under the heading matching REPOSITORY in the file
specified by `org-github-pulls-org-file'.
Executing this function will replace already downloaded issues."
(interactive
(list (completing-read "Github repo: "
(ogi--collect-synced-repository-names)
nil nil)))
(let* ((repositories (ogi--collect-synced-repositories))
(owner-and-repo (split-string repository "/"))
(owner (car owner-and-repo))
(repo (cadr owner-and-repo))
(selected (ogi--repository-named repositories repository))
(level (ogi--repository-level selected))
(tags (ogi--repository-tags selected))
(pulls (ogi--fetch-pulls owner repo)))
(when (not (ogi--repo-header-exists-p repository))
(progn
(message "Creating headline for %s in %s" repository org-github-issues-org-file)
(ogi--insert-repo-header repository)
(sleep-for 1))) ; wait for file to be fully updated before adding issues
(if (not pulls)
(message (format "No assigned/review pending pulls found in repository https://github.com/%s" repository))
(progn
(ogi--delete-existing-pulls owner repo)
(ogi--insert-org-entries (ogi--generate-org-entries-for-pulls owner repo level pulls)
repository)))))
(defun org-github-issues-sync-all ()
"Sync all github repository issues and pull requests."
(interactive)
(let ((repos (ogi--collect-synced-repository-names)))
(mapcar (lambda (r) (org-github-issues-sync-issues r)) repos)
(mapcar (lambda (r) (org-github-issues-sync-pulls r)) repos)))
;; gh-pulls.el does not include requested_reviewers, assignee, assignees and labels, so that needs to change.
(gh-defclass gh-pulls-request (gh-pulls-request-stub)
((number :initarg :number)
(merged :initarg :merged)
(mergeable :initarg :mergeable)
(merged-by :initarg :merged-by)
(comments :initarg :comments)
(user :initarg :user :initform nil :marshal-type gh-user)
(labels :initarg :labels :initform nil :marshal-type (list gh-issues-label))
(assignees :initarg :assignees :initform nil :marshal-type (list gh-user))
(assignee :initarg :assignee :initform nil :marshal-type gh-user)
(requested_reviewers :initarg :assignees :initform nil :marshal-type (list gh-user))
(commits :initarg :commits)
(additions :initarg :additions)
(deletions :initarg :deletions)
(changed-files :initarg :changed-files))
"Git pull requests API")
(provide 'org-github-issues)
;;; org-github-issues.el ends here