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
|
(defpackage :cl-github
(:nicknames :github)
(:use #:cl)
(:export #:*username*
#:*password*
#:api-command
#:create-repository
#:list-repositories))
(in-package #:cl-github)
(defvar *username* nil
"Username to use for API calls")
(defvar *password* nil
"Password to use for API calls")
(define-condition api-error (error)
((http-status :initarg :http-status
:reader error-http-status)
(http-headers :initarg :http-headers
:reader error-http-headers)
(response :initarg :response
:reader error-response))
(:report (lambda (c stream)
(format stream "github API error, HTTP status code ~A~%~A~@[~%~A~]"
(error-http-status c)
(error-http-headers c)
(error-response c)))))
(defun keyword-to-github-keyword (keyword)
(string-downcase (substitute #\_ #\- (string keyword))))
(defun github-keyword-to-keyword (string)
(let ((*package* (find-package :keyword)))
(read-from-string (substitute #\- #\_ string))))
(defun plist-to-http-parameters (plist)
(loop
for (key value) on plist by #'cddr
collect (cons (keyword-to-github-keyword key) value)))
(defun plist-to-hash-table (plist)
(loop
with hash-table = (make-hash-table :test #'equal)
for (key value) on plist by #'cddr
do (setf (gethash (keyword-to-github-keyword key) hash-table) value)
finally (return hash-table)))
(defun api-command (url &key body (method :get) (username *username*) (password *password*) parameters)
(multiple-value-bind
(body status-code headers)
(drakma:http-request (format nil "https://api.github.com~A" url)
:method method
:parameters (plist-to-http-parameters parameters)
:basic-authorization (when username (list username password))
:content-type "application/json"
:content (when body
(with-output-to-string (s)
(yason:encode (plist-to-hash-table body) s))))
(let* ((yason:*parse-object-as* :plist)
(yason:*parse-object-key-fn* 'github-keyword-to-keyword)
(response (when body
(yason:parse (flex:octets-to-string body :external-format :utf-8)))))
(if (< status-code 300)
(values response headers)
(error 'api-error
:http-status status-code
:http-headers headers
:response response)))))
(defmacro booleanize-parameters (plist &rest keys)
;; unhygienic
`(setf ,plist (let (result)
(alexandria:doplist (key value ,plist (nreverse result))
(push key result)
(push (if (member key ',keys)
(if value
"true"
"false")
value)
result)))))
(defmacro define-github-command (name parameters &body body)
;; unhygienic
`(prog1
(defun ,name (&rest parameters &key ,@parameters)
(declare (ignorable parameters ,@(loop for parameter in parameters
collect (if (listp parameter) (first parameter) parameter))))
,@body)
(export ',name)))
(define-github-command create-repository (name org description homepage public has-issues has-wiki has-downloads)
(booleanize-parameters parameters :has-issues :has-wiki :has-downloads)
(api-command (if org (format nil "/orgs/~A/repos" org) "/user/repos")
:method :post
:body parameters))
(define-github-command list-repositories (org)
(api-command (if org (format nil "/orgs/~A/repos" org) "/user/repos")
:method :get))
|
