microcms-lisp-sdk/src/main.lisp

87 lines
3.4 KiB
Common Lisp
Raw Normal View History

2025-04-19 00:14:19 +09:00
(defpackage #:microcms
(:nicknames #:microcms/main)
(:use #:cl)
(:import-from #:alexandria
#:remove-from-plist
#:symbolicate)
(:import-from #:jonathan
#:to-json
#:parse)
(:import-from #:dexador
#:request
2025-04-19 14:25:01 +09:00
#:http-request-failed
#:response-status)
2025-04-19 00:14:19 +09:00
(:import-from #:quri
#:make-uri
#:render-uri)
(:import-from #:kebab
#:to-camel-case)
(:export #:*api-key*
#:*service-domain*
#:define-list-client
#:define-object-client))
(in-package #:microcms)
(defparameter *api-key* nil)
(defparameter *service-domain* nil)
2025-04-19 14:25:01 +09:00
(defun %request (method endpoint &key path query content)
(or *service-domain* (error "microcms:*service-domain* is not configured."))
(or *api-key* (error "microcms:*api-key* is not configured."))
(let* ((url (%build-uri endpoint :path path :query query))
(req-headers `(("X-MICROCMS-API-KEY" . ,*api-key*)
("Content-Type" . "application/json"))))
2025-04-19 00:14:19 +09:00
(handler-case
2025-04-19 14:25:01 +09:00
(multiple-value-bind (res-body status res-headers)
2025-04-19 00:14:19 +09:00
(request url
:method method
2025-04-19 14:25:01 +09:00
:headers req-headers
2025-04-19 13:42:16 +09:00
:content (and content (to-json content))
2025-04-19 00:14:19 +09:00
:force-binary nil)
2025-04-19 14:25:01 +09:00
(format t "microCMS status: ~D~%" status)
2025-04-19 13:42:16 +09:00
(when (and (stringp res-body)
2025-04-19 14:25:01 +09:00
(search "application/json" (gethash "content-type" res-headers)))
2025-04-19 13:42:16 +09:00
(parse res-body)))
2025-04-19 14:25:01 +09:00
(http-request-failed (e)
(format *error-output* "microCMS status: ~D~%" (response-status e))))))
2025-04-19 00:14:19 +09:00
2025-04-19 14:25:01 +09:00
(defun %build-uri (endpoint &key path query)
2025-04-19 00:14:19 +09:00
(let ((uri (make-uri
:scheme "https"
:host (format nil "~A.microcms.io" *service-domain*)
2025-04-19 14:25:01 +09:00
:path (format nil "/api/v1/~A~@[/~A~]" endpoint path)
2025-04-19 00:14:19 +09:00
:query (%build-query query))))
(render-uri uri)))
(defun %build-query (query)
(loop :for (key val) :on query :by #'cddr
:collect (cons (to-camel-case (symbol-name key)) val)))
(defmacro define-list-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint))))
`(progn
2025-04-19 14:25:01 +09:00
(defun ,(symbolicate 'get- endpoint '-list) (&key query)
(%request :get ,str-endpoint :query query))
(defun ,(symbolicate 'get- endpoint '-list-detail) (id &key query)
(%request :get ,str-endpoint :path id :query query))
(defun ,(symbolicate 'create- endpoint) (content &key query)
2025-04-19 13:42:16 +09:00
(let ((id (getf content :|id|)))
(%request (if id :put :post)
,str-endpoint
2025-04-19 14:25:01 +09:00
:path id
:query query
:content (remove-from-plist content :|id|))))
2025-04-19 00:14:19 +09:00
(defun ,(symbolicate 'update- endpoint) (id content)
2025-04-19 14:25:01 +09:00
(%request :patch ,str-endpoint :path id :content content))
2025-04-19 00:14:19 +09:00
(defun ,(symbolicate 'delete- endpoint) (id)
2025-04-19 14:25:01 +09:00
(%request :delete ,str-endpoint :path id))
2025-04-19 00:14:19 +09:00
nil)))
(defmacro define-object-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint))))
`(progn
2025-04-19 14:25:01 +09:00
(defun ,(symbolicate 'get- endpoint '-object) (&key query)
(%request :get ,str-endpoint :query query))
2025-04-19 00:14:19 +09:00
(defun ,(symbolicate 'update- endpoint) (content)
2025-04-19 14:25:01 +09:00
(%request :patch ,str-endpoint :content content))
nil)))