This commit is contained in:
Akira Tempaku 2025-04-19 13:42:16 +09:00
parent bc06ba5a1b
commit 9ef6e78400
Signed by: paku
GPG key ID: 5B4E8402BCC50607

View file

@ -26,50 +26,22 @@
(defparameter *api-key* nil)
(defparameter *service-domain* nil)
(defun %get-list (endpoint &optional query)
(%request :get endpoint "" query))
(defun %get-list-detail (endpoint id &optional (query nil))
(%request :get endpoint id query))
(defun %create (endpoint content &optional query)
(let ((id (getf content :|id|))
(pure-content (remove-from-plist content :|id|)))
(if id
(%put endpoint id pure-content)
(%post endpoint pure-content query))))
(defun %put (endpoint id content &optional query)
(%request :put endpoint id query content))
(defun %post (endpoint content &optional query)
(%request :post endpoint "" query content))
(defun %update (endpoint id content)
(%request :patch endpoint id nil content))
(defun %delete (endpoint id)
(%request :delete endpoint id))
(defun %get-object (endpoint)
(%request :get endpoint))
(defun %request (method endpoint &optional (path "") (query nil) (body nil))
(defun %request (method endpoint &optional (path "") (query nil) (content nil))
(let* ((url (%build-uri endpoint path query))
(headers `(("X-MICROCMS-API-KEY" . ,*api-key*)
("Content-Type" . "application/json"))))
(format t "API request url: ~a~%" url)
(handler-case
(multiple-value-bind (resp-body status resp-headers)
(multiple-value-bind (res-body status resp-headers)
(request url
:method method
:headers headers
:content (and body (to-json body))
:content (and content (to-json content))
:force-binary nil)
(format t "API response status: ~a~%" status)
(when (and (stringp resp-body)
(when (and (stringp res-body)
(search "application/json" (gethash "content-type" resp-headers)))
(parse resp-body)))
(parse res-body)))
(http-request-failed ()
'(:|error| "API request failed")))))
@ -89,22 +61,27 @@
(let ((str-endpoint (string-downcase (string endpoint))))
`(progn
(defun ,(symbolicate 'get- endpoint '-list) (&optional query)
(%get-list ,str-endpoint query))
(%request :get ,str-endpoint nil query))
(defun ,(symbolicate 'get- endpoint '-list-detail) (id &optional query)
(%get-list-detail ,str-endpoint id query))
(%request :get ,str-endpoint id query))
(defun ,(symbolicate 'create- endpoint) (content &optional query)
(%create ,str-endpoint content query))
(let ((id (getf content :|id|)))
(%request (if id :put :post)
,str-endpoint
id
query
(remove-from-plist content :|id|))))
(defun ,(symbolicate 'update- endpoint) (id content)
(%update ,str-endpoint id content))
(%request :patch ,str-endpoint id nil content))
(defun ,(symbolicate 'delete- endpoint) (id)
(%delete ,str-endpoint id))
(%request :delete ,str-endpoint id))
nil)))
(defmacro define-object-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint))))
`(progn
(defun ,(symbolicate 'get- endpoint '-object) ()
(%get-object ,str-endpoint))
(%request :get ,str-endpoint))
(defun ,(symbolicate 'update- endpoint) (content)
(%update ,str-endpoint nil content))
(%request :patch ,str-endpoint nil nil content))
nil)))