This commit is contained in:
Akira Tempaku 2025-04-21 01:36:52 +09:00
commit 574b760ff7
Signed by: paku
GPG key ID: 5B4E8402BCC50607
10 changed files with 278 additions and 90 deletions

108
src/client.lisp Normal file
View file

@ -0,0 +1,108 @@
(defpackage #:microcms/client
(:use #:cl)
(:import-from #:alexandria
#:remove-from-plist
#:symbolicate
#:alist-hash-table
#:hash-table-alist
#:make-keyword)
(:import-from #:com.inuoe.jzon
#:stringify
#:parse)
(:import-from #:dexador
#:request
#:http-request-failed
#:response-status)
(:import-from #:quri
#:make-uri
#:render-uri)
(:import-from #:kebab
#:to-camel-case
#:to-kebab-case)
(:export #:*api-key*
#:*service-domain*
#:define-list-client
#:define-object-client
#:%build-uri
#:%build-query
#:%build-content
#:%parse-response))
(in-package #:microcms/client)
(defparameter *api-key* nil)
(defparameter *service-domain* nil)
(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."))
(handler-case
(multiple-value-bind (res-body status res-headers)
(request (%build-uri endpoint :path path :query query)
:method method
:headers `(("X-MICROCMS-API-KEY" . ,*api-key*)
("Content-Type" . "application/json"))
:content (%build-content content)
:force-binary nil)
(format t "microCMS status: ~D~%" status)
(when (and (stringp res-body)
(search "application/json" (gethash "content-type" res-headers)))
(%parse-response res-body)))
(http-request-failed (e)
(format *error-output* "microCMS status: ~D~%" (response-status e)))))
(defun %build-uri (endpoint &key path query)
(render-uri (make-uri :scheme "https"
:host (format nil "~A.microcms.io" *service-domain*)
:path (format nil "/api/v1/~A~@[/~A~]" endpoint path)
:query (%build-query query))))
(defun %kebab-case-plist->camel-case-alist (plist)
(loop :for (key val) :on plist :by #'cddr
:collect (cons (to-camel-case (symbol-name key)) val)))
(defun %camel-case-hash-table->kebab-case-plist (hash-table)
(loop :for (key . val) :in (hash-table-alist hash-table)
:append (list (make-keyword (string-upcase (to-kebab-case key))) val)))
(defun %build-query (query)
(%kebab-case-plist->camel-case-alist query))
(defun %build-content (content)
(and content (stringify (alist-hash-table (%kebab-case-plist->camel-case-alist content)))))
(defun %parse-response (body)
(%camel-case-hash-table->kebab-case-plist (parse body)))
(defmacro define-list-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint)))
(get-list (symbolicate 'get- endpoint '-list))
(get-detail (symbolicate 'get- endpoint '-detail))
(create (symbolicate 'create- endpoint))
(update (symbolicate 'update- endpoint))
(delete (symbolicate 'delete- endpoint)))
`(list
(defun ,get-list (&key query)
(%request :get ,str-endpoint :query query))
(defun ,get-detail (id &key query)
(%request :get ,str-endpoint :path id :query query))
(defun ,create (content &key query)
(let ((id (getf content :id)))
(%request (if id :put :post)
,str-endpoint
:path id
:query query
:content (remove-from-plist content :id))))
(defun ,update (id content)
(%request :patch ,str-endpoint :path id :content content))
(defun ,delete (id)
(%request :delete ,str-endpoint :path id)))))
(defmacro define-object-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint)))
(get-object (symbolicate 'get- endpoint '-object))
(update (symbolicate 'update- endpoint)))
`(list
(defun ,get-object (&key query)
(%request :get ,str-endpoint :query query))
(defun ,update (content)
(%request :patch ,str-endpoint :content content)))))

View file

@ -1,92 +1,9 @@
(defpackage #:microcms
(uiop:define-package :microcms
(:nicknames #:microcms/main)
(:use #:cl)
(:import-from #:alexandria
#:remove-from-plist
#:symbolicate
#:plist-hash-table)
(:import-from #:com.inuoe.jzon
#:stringify
#:parse)
(:import-from #:dexador
#:request
#:http-request-failed
#:response-status)
(:import-from #:quri
#:make-uri
#:render-uri)
(:import-from #:kebab
#:to-camel-case)
(:use #:cl
#:microcms/client)
(:export #:*api-key*
#:*service-domain*
#:define-list-client
#:define-object-client))
(in-package #:microcms)
(defparameter *api-key* nil)
(defparameter *service-domain* nil)
(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."))
(handler-case
(multiple-value-bind (res-body status res-headers)
(request (%build-uri endpoint :path path :query query)
:method method
:headers `(("X-MICROCMS-API-KEY" . ,*api-key*)
("Content-Type" . "application/json"))
:content (%build-content content)
:force-binary nil)
(format t "microCMS status: ~D~%" status)
(when (and (stringp res-body)
(search "application/json" (gethash "content-type" res-headers)))
(parse res-body)))
(http-request-failed (e)
(format *error-output* "microCMS status: ~D~%" (response-status e)))))
(defun %build-uri (endpoint &key path query)
(render-uri (make-uri :scheme "https"
:host (format nil "~A.microcms.io" *service-domain*)
:path (format nil "/api/v1/~A~@[/~A~]" endpoint path)
:query (%build-query query))))
(defun %build-query (query)
(loop :for (key val) :on query :by #'cddr
:collect (cons (to-camel-case (symbol-name key)) val)))
(defun %build-content (content)
(and content (stringify (plist-hash-table content))))
(defmacro define-list-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint)))
(get-list (symbolicate 'get- endpoint '-list))
(get-detail (symbolicate 'get- endpoint '-detail))
(create (symbolicate 'create- endpoint))
(update (symbolicate 'update- endpoint))
(delete (symbolicate 'delete- endpoint)))
`(list
(defun ,get-list (&key query)
(%request :get ,str-endpoint :query query))
(defun ,get-detail (id &key query)
(%request :get ,str-endpoint :path id :query query))
(defun ,create (content &key query)
(let ((id (getf content :|id|)))
(%request (if id :put :post)
,str-endpoint
:path id
:query query
:content (remove-from-plist content :|id|))))
(defun ,update (id content)
(%request :patch ,str-endpoint :path id :content content))
(defun ,delete (id)
(%request :delete ,str-endpoint :path id)))))
(defmacro define-object-client (endpoint)
(let ((str-endpoint (string-downcase (string endpoint)))
(get-object (symbolicate 'get- endpoint '-object))
(update (symbolicate 'update- endpoint)))
`(list
(defun ,get-object (&key query)
(%request :get ,str-endpoint :query query))
(defun ,update (content)
(%request :patch ,str-endpoint :content content)))))
(in-package :microcms)