Add test

.forgejo/workflows/ci.yml

@@ -0,0 +1,70 @@
+name: 'CI'
+
+on:
+  push:
+    branches:
+      - 'main'
+  pull_request:
+
+jobs:
+  test:
+    runs-on: docker
+
+    strategy:
+      matrix:
+        lisp:
+          - sbcl-bin
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Restore cache
+        id: restore-cache
+        uses: actions/cache/restore@v4
+        with:
+          path: |
+            ~/.roswell
+            /usr/local/bin/ros
+            /usr/local/etc/roswell/
+            qlfile
+            qlfile.lock
+            .qlot
+            ~/.cache/common-lisp/
+          key: roswell-${{ runner.os }}-${{ matrix.lisp }}-${{ hashFiles('qlfile', 'qlfile.lock', '*.asd') }}
+
+      - name: Install Roswell
+        if: steps.restore-cache.outputs.cache-hit != 'true'
+        env:
+          LISP: ${{ matrix.lisp }}
+        run: |
+          curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh
+
+      - name: Install Qlot
+        if: steps.restore-cache.outputs.cache-hit != 'true'
+        run: |
+          ros install fukamachi/qlot
+
+      - name: Install dependencies
+        if: steps.restore-cache.outputs.cache-hit != 'true'
+        run: |
+          PATH="~/.roswell/bin:$PATH"
+          qlot install
+          qlot exec ros install microcms
+
+      - name: Save cache
+        id: save-cache
+        uses: actions/cache/save@v4
+        if: steps.restore-cache.outputs.cache-hit != 'true'
+        with:
+          path: |
+            ~/.roswell
+            /usr/local/bin/ros
+            /usr/local/etc/roswell/
+            qlfile
+            qlfile.lock
+            .qlot
+            ~/.cache/common-lisp/
+          key: ${{ steps.restore-cache.outputs.cache-primary-key }}
+
+      - name: Run tests
+        run: .qlot/bin/rove microcms.asd

.github/workflows/ci.yml

@@ -0,0 +1,29 @@
+name: 'CI'
+
+on:
+  push:
+    branches:
+      - 'main'
+  pull_request:
+
+jobs:
+  test:
+    runs-on: ubuntu-latest
+
+    strategy:
+      matrix:
+        lisp:
+          - sbcl-bin
+          - ccl-bin
+
+    env:
+      LISP: ${{ matrix.lisp }}
+
+    steps:
+      - uses: actions/checkout@v4
+      - uses: 40ants/setup-lisp@v4
+        with:
+          asdf-system: microcms
+      - uses: 40ants/run-tests@v2
+        with:
+          asdf-system: microcms

README.md

@@ -17,6 +17,9 @@ Before making API requests, set your API key and service domain:
 
 Use `define-list-client` macro to define functions for list-type content.
 
+`query` and `content` must be provided as property list (plist), with keys written in kebab-case (e.g., `:draft-key`).
+The JSON response from the microCMS API are automatically converted into plist, with keys transformed from camelCase to kebab-case.
+
 ```lisp
 (microcms:define-list-client article)
 ```
@@ -30,8 +33,6 @@ This will generate the following functions:
 | `update-article` | (`id`, `content`) | Update an existing article by its ID with new content. |
 | `delete-article` | (`id`) | Delete an article by its ID. |
 
-Note: query arguments should be provided as a property list (plist), where keys use kebab-case (e.g., `:draft-key`).
-
 ### Object Type Endpoint
 
 Use `define-object-client` macro to define functions for object-type content.

microcms-test.asd

@@ -0,0 +1,6 @@
+(defsystem "microcms-test"
+  :class :package-inferred-system
+  :pathname "tests"
+  :depends-on ("rove"
+               "microcms-test/client")
+  :perform (test-op (o c) (symbol-call :rove :run c :style :dot)))

microcms.asd

@@ -5,4 +5,5 @@
   :license "MIT"
   :class :package-inferred-system
   :pathname "src"
-  :depends-on ("microcms/main"))
+  :depends-on ("microcms/main")
+  :in-order-to ((test-op (test-op "microcms-test"))))

qlfile

@@ -3,3 +3,5 @@ ql dexador
 ql jzon
 ql quri
 ql kebab
+git rove https://github.com/fukamachi/rove
+git dissect https://github.com/Shinmera/dissect

qlfile.lock

@@ -22,3 +22,11 @@
  (:class qlot/source/ql:source-ql
   :initargs (:%version :latest)
   :version "ql-2015-06-08"))
+("rove" .
+ (:class qlot/source/git:source-git
+  :initargs (:remote-url "https://github.com/fukamachi/rove")
+  :version "git-9868028edf511da5fe61355881af9f4c35f051df"))
+("dissect" .
+ (:class qlot/source/git:source-git
+  :initargs (:remote-url "https://github.com/Shinmera/dissect")
+  :version "git-a70cabcd748cf7c041196efd711e2dcca2bbbb2c"))

src/client.lisp

@@ -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)))))

src/main.lisp

@@ -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)

tests/client.lisp

@@ -0,0 +1,46 @@
+(defpackage #:microcms-test/client
+  (:use #:cl
+        #:rove
+        #:microcms/client))
+(in-package #:microcms-test/client)
+
+(deftest build-uri-test
+  (testing "build-uri constructs correct endpoint URLs"
+    (let ((*service-domain* "my-service"))
+      (ok (string= (%build-uri "article")
+                   "https://my-service.microcms.io/api/v1/article"))
+      (ok (string= (%build-uri "article" :path "abc123")
+                   "https://my-service.microcms.io/api/v1/article/abc123"))
+      (ok (string= (%build-uri "article" :query '(:limit 10 :offset 5))
+                   "https://my-service.microcms.io/api/v1/article?limit=10&offset=5")))))
+
+(deftest build-query-test
+  (testing "build-query converts kebab-case plist to camelCase alist"
+    (let ((result (%build-query '(:foo 1 :bar-baz 2))))
+      (ok (equal result '(("foo" . 1) ("barBaz" . 2)))))))
+
+(deftest build-content-test
+  (testing "build-content converts kebab-case plist to camelCase JSON"
+    (let ((json (%build-content '(:title "Hello" :created-at "2025-04-01"))))
+      (ok (search "\"title\":\"Hello\"" json))
+      (ok (search "\"createdAt\":\"2025-04-01\"" json)))))
+
+(deftest parse-response-test
+  (testing "parse-response converts camelCase JSON to kebab-case plist"
+    (let ((result (%parse-response "{\"myTitle\": \"Hello\", \"createdAt\": \"2025-04-01\"}")))
+      (ok (equal (getf result :my-title) "Hello"))
+      (ok (equal (getf result :created-at) "2025-04-01")))))
+
+(deftest macro-test
+  (testing "define-list-client creates expected functions"
+    (define-list-client blog)
+    (ok (fboundp 'get-blog-list))
+    (ok (fboundp 'get-blog-detail))
+    (ok (fboundp 'create-blog))
+    (ok (fboundp 'update-blog))
+    (ok (fboundp 'delete-blog)))
+
+  (testing "define-object-client creates expected functions"
+    (define-object-client config)
+    (ok (fboundp 'get-config-object))
+    (ok (fboundp 'update-config))))