forked from nixeagle/cl-github
-
Notifications
You must be signed in to change notification settings - Fork 0
/
repositories.lisp
288 lines (231 loc) · 12.2 KB
/
repositories.lisp
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
(in-package :cl-github)
(defgeneric repository-name (repository)
(:documentation "string representation of REPOSITORY."))
(defgeneric repository-owner (repository)
(:documentation "string representation of REPOSITORY's owner."))
(defgeneric repository-description (repository))
(defgeneric repository-open-issues-count (repository))
(defgeneric repository-open-issues (repository))
(defgeneric repository-fork-p (repository))
(defgeneric repository-forks (repository))
(defgeneric repository-forks-count (repository))
(defgeneric repository-private-p (repository))
(defgeneric repository-watchers-count (repository))
(defgeneric repository-watchers (repository))
(defgeneric github-repository-notation (repository))
(defgeneric parse-github-repository-notation (string)
(:documentation "Return a list pair with (\"owner\" \"repository\")")
(:method ((string string))
;; Assume only one /, and no garbage input (like trailing spaces).
(list (subseq string 0 (position #\/ string))
(subseq string (1+ (position #\/ string))))))
(defgeneric github-url (object)
(:documentation "string representation of OBJECT's resource location."))
(defgeneric github-git-url (object)
(:documentation "string representation of OBJECT's git location."))
(defclass repository ()
((description :reader repository-description)
(forks :reader repository-forks-count)
(url :reader repository-url)
(homepage)
(watchers :reader repository-watchers-count)
(fork :reader repository-fork-p)
(open-issues :reader repository-open-issues-count)
(private :reader repository-private-p)
(name :reader repository-name)
(owner :reader repository-owner)))
(defclass watched-repository (repository)
()
;; currently used only for WATCHED-REPOSITORIES.
(:documentation "Repository information."))
(defmethod repository-name ((repo repository))
(slot-value repo 'name))
(defmethod github-url ((repo repository))
(slot-value repo 'url))
(defmethod github-git-url ((repo repository))
(concatenate 'string "git" (subseq (github-url repo) 4) ".git"))
(defmethod repository-owner ((repo repository))
(slot-value repo 'owner))
(defmethod github-repository-notation ((repo repository))
(concatenate 'string (repository-owner repo) "/" (repository-name repo)))
(defclass searched-repository ()
(name size followers username language fork id type pushed
forks description score created)
(:documentation "Search repository result information."))
(defmethod repository-name ((repo searched-repository))
(slot-value repo 'name))
(defclass repositories (watched-repository searched-repository) ()
(:documentation "Workaround for cl-json.
Basically objects with a key named REPOSITORIES have different values
depending on what action is being done with github. For now we use an
abstract class that inherits all the conflicting classes so that at all
times the result object at least makes sense and has no missing
slots."))
(defclass languages ()
((languages :reader languages))
(:documentation "List of languages."))
(defclass collaborators ()
(collaborators)
(:documentation "List of collaborators."))
(defclass network (repositories)
()
(:documentation "A network is just another name for repositories."))
(defclass network-data-commit ()
(message time parents date author id space gravatar login)
(:documentation "We get commit data like this from the Network API."))
(defclass commits (network-data-commit)
(author authored-date committed-date committer
id message parents tree url)
(:documentation "A commit object."))
(defclass commit ()
(added modified removed parents author url id committed-date
authored-date message tree committer)
(:documentation "Detailed information on a commit."))
(defclass parent ()
(id)
;; Yes this is a little strange... but this is how github does it, it
;; can be cleaned up later.
(:documentation "The id for the parent commit."))
(defclass file-diff ()
(diff filename)
(:documentation "Modification information for a commit."))
(defclass public-key ()
(title id key)
(:documentation "Information on a public key."))
(defclass delete-token ()
((delete-token :reader delete-token))
(:documentation "Token github gives us to confirm deletion."))
;;; Repository meta information stuff
(defgeneric search-repositories (search-string)
(:documentation "Search github repositories for SEARCH-STRING."))
(defgeneric show-repository (username reponame &key login token)
(:documentation "Show information on USERNAME's REPONAME."))
(defgeneric show-user-repositories (username)
(:documentation "List USERNAME's repositories."))
(defmethod search-repositories ((search-string string))
(to-json (github-simple-request "repos" "search" search-string)))
(defmethod show-repository ((username string) (repository string) &key login token)
(if (equalp username login)
(to-json (authed-request login to-json (list "repos" "show" username repository)))
(to-json (github-simple-request "repos" "show" username repository))))
(defmethod show-user-repositories ((username string))
(to-json (github-simple-request "repos" "show" username)))
;;; Watch/unwatch
(defgeneric watch (username repository &key login token)
(:documentation "Watch REPOSITORY owned by USERNAME."))
(defgeneric unwatch (username repository &key login token)
(:documentation "Stop watching REPOSITORY owned by USERNAME."))
(defgeneric watched-repositories (username)
(:documentation "List repositories USERNAME watches."))
(defmethod watch ((username string) (repository string) &key login token)
(to-json (request login token `("repos" "watch" ,username ,repository))))
(defmethod unwatch ((username string) (repository string) &key login token)
(to-json (authed-request login token `("repos" "unwatch" ,username ,repository))))
(defmethod watched-repositories ((username string))
(to-json (github-simple-request "repos" "watched" username)))
;;; Create/delete/fork
(defgeneric fork (username repository &key login token)
(:documentation "Fork REPOSITORY owned by USERNAME."))
(defgeneric create-repository (repository &key login token description
homepage public)
(:documentation "Create new REPOSITORY on github."))
(defgeneric delete-repository (repository &key login token)
(:documentation "Delete REPOSITORY on github."))
(defmethod fork ((username string) (repository string) &key login token)
(to-json (authed-request login token `("repos" "fork" ,username ,repository))))
(defmethod create-repository ((repository string) &key login token
description homepage public)
(to-json (authed-request login token '("repos" "create")
:name repository
:description description
:homepage homepage
:public public)))
(defmethod delete-repository ((repository string) &key login token)
(flet ((del-repo (&optional delete-token)
(json->element
(authed-request login token
`("repos" "delete" ,repository)
:delete-token delete-token))))
(del-repo (del-repo))))
;;; Public/private
(defgeneric set-repository-private (repository &key login token)
(:documentation "Mark REPOSITORY as private on github."))
(defgeneric set-repository-public (repository &key login token)
(:documentation "Mark REPOSITORY as public on github."))
(defmethod set-repository-private ((repository string) &key login token)
(to-json (authed-request login token `("repos" "set" "private" ,repository))))
(defmethod set-repository-public ((repository string) &key login token)
(to-json (authed-request login token `("repos" "set" "public" ,repository))))
;;; Repository keys
(defgeneric deply-keys (repository &key login token)
(:documentation "List REPOSITORY's deploy keys.
These are basically read only ssh keys."))
(defgeneric add-deploy-key (repository title key &key login token)
(:documentation "Add KEY named TITLE as a deploy key for REPOSITORY."))
(defgeneric remove-deploy-key (repository id &key login token)
(:documentation "Remove key identified by ID as a deploy key for REPOSITORY."))
(defmethod deploy-keys ((repository string) &key login token)
(to-json (authed-request login token `("repos" "keys" ,repository))))
(defmethod add-deploy-key ((repository string) (title string)
(key string) &key login token)
(to-json (authed-request login token `("repos" "key" ,repository "add")
:title title :key key)))
(defmethod remove-deploy-key ((repository string) (id string) &key login token)
(to-json (authed-request login token `("repos" "key" ,repository "remove")
:id id)))
(defmethod remove-deploy-key ((repository string) (id integer) &key login token)
(remove-deploy-key repository (princ-to-string id) :login login :token token))
;;; Collaborators
(defgeneric show-collaborators (username repository &key login token)
(:documentation "List collaborators on REPOSITORY owned by USERNAME."))
(defgeneric remove-collaborator (username repository &key login token)
(:documentation "Remove USERNAME from the collaborators list of REPOSITORY."))
(defgeneric add-collaborator (username repository &key login token)
(:documentation "Add USERNAME to the collaborators list of REPOSITORY."))
(defmethod show-collaborators ((username string) (repository string)
&key login token)
(json->list (request login token `("repos" "show" ,username
,repository "collaborators"))))
(defmethod add-collaborator ((username string) (repository string) &key login token)
(json->list
(authed-request login token `("repos" "collaborators" ,repository
"add" ,username))))
(defmethod remove-collaborator ((username string) (repository string) &key login token)
(json->list
(authed-request login token `("repos" "collaborators" ,repository
"remove" ,username))))
;;; Repository refs stuff
(defgeneric show-tags (username repository &key login token)
(:documentation "List REPOSITORY's tags."))
(defgeneric show-languages (username repository &key login token)
(:documentation "List REPOSITORY's languages."))
(defgeneric show-branches (username repository &key login token)
(:documentation "List REPOSITORY's remote branches."))
(defmethod show-languages ((username string) (repository string) &key login token)
(json->list (request login token `("repos" "show"
,username ,repository "languages"))))
(defmethod show-tags ((username string) (repository string) &key login token)
(json->list (request login token `("repos" "show" ,username
,repository "tags"))))
(defmethod show-branches ((username string) (repository string) &key login token)
(json->list
(request login token `("repos" "show" ,username ,repository "branches"))))
(defgeneric show-commits (username repository &key branch file login token)
(:documentation "List commits in USERNAME's REPOSITORY on BRANCH optionally for FILE."))
(defgeneric repository-network (username repository)
(:documentation "Look at network of USERNAME's REPOSITORY."))
(defgeneric show-commit (username repository sha &key login token)
(:documentation "Show data for commit identified by SHA on USERNAME's REPOSITORY."))
(defgeneric show-network (username repository &key login token)
(:documentation "Show at network of USERNAME's REPOSITORY."))
;;; Repositories
(defmethod show-network ((username string) (repository string) &key login token)
(to-json (authed-request login token `("repos" "show" ,username
,repository "network"))))
(defmethod show-commits ((username string) (repository string)
&key branch file login token)
(to-json (request login token `("commits" "list" ,username
,repository ,(or branch "master") ,file))))
(defmethod show-commit ((username string) (repository string) (sha string)
&key login token)
(to-json (request login token `("commits" "show" ,username ,repository ,sha))))