File: github.lisp

package info (click to toggle)
cl-github-v3 20130312-1.1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 52 kB
  • sloc: lisp: 86; makefile: 13
file content (101 lines) | stat: -rw-r--r-- 3,953 bytes parent folder | download | duplicates (2)
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))