From 30a034b30b66694447fc38172a2265a1095af222 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Sun, 23 Jun 2024 14:43:20 -0700
Subject: Add: client generator for dexador

---
 src/client/dexador/generate.lisp | 63 ++++++++++++++++++++++++++++++++++++++++
 src/client/ps/generate.lisp      |  7 +++--
 2 files changed, 67 insertions(+), 3 deletions(-)
 create mode 100644 src/client/dexador/generate.lisp

(limited to 'src/client')

diff --git a/src/client/dexador/generate.lisp b/src/client/dexador/generate.lisp
new file mode 100644
index 0000000..dd4652c
--- /dev/null
+++ b/src/client/dexador/generate.lisp
@@ -0,0 +1,63 @@
+(defpackage #:weekend.client.dexador
+  (:use #:cl)
+  (:import-from #:flatbind #:do>)
+  (:local-nicknames
+   (#:wknd #:weekend)
+   (#:a #:alexandria-2))
+  (:export #:generate))
+
+(in-package #:weekend.client.dexador)
+
+(defun generate-client-for (class)
+  (when (symbolp class) (setf class (find-class class)))
+
+  (let*
+      ((args
+         (mapcar (a:compose #'intern #'string)
+                 (wknd:class-initargs class)))
+       
+       (parts
+         (loop
+           :for part :in (wknd:route-builder-parts class)
+           :when (or (stringp part) (characterp part))
+             :collect part
+           :else
+             :collect (intern (string part))))
+       (method
+         (wknd:request-method class))
+
+       (dexador-fn
+         (ecase method
+           (:get 'dexador:get)
+           (:post 'dexador:post)
+           (:put 'dexador:put)
+           (:delete 'dexador:delete)
+           (:patch 'dexador:patch)
+           (:head 'dexador:head)))
+
+       (reqbody
+         (when (wknd:body-expected-p method)
+           `(mapcar #'cons
+                    ',(mapcar #'string (wknd:class-initargs class))
+                    (list ,@args))))
+
+       (host
+         (loop :with var := "HOST"
+               :while (find var args :test #'string-equal)
+               :do (setf var (concatenate 'string var "%"))
+               :finally (return (intern var))))
+       (dexador-kwargs
+         (loop :with var := "DEXADOR-KWARGS"
+               :while (find var args :test #'string-equal)
+               :do (setf var (concatenate 'string var "%"))
+               :finally (return (intern var)))))
+
+    `(defun ,(class-name class) (,host ,@args &rest ,dexador-kwargs)
+       (apply #',dexador-fn
+              (concatenate 'string ,host ,@parts)
+              ,@(when reqbody
+                  (list :content reqbody))
+              ,dexador-kwargs))))
+
+(defun generate (class)
+  (eval (generate-client-for class)))
diff --git a/src/client/ps/generate.lisp b/src/client/ps/generate.lisp
index 11b0c53..f6f317b 100644
--- a/src/client/ps/generate.lisp
+++ b/src/client/ps/generate.lisp
@@ -4,13 +4,13 @@
   (:local-nicknames
    (#:wknd #:weekend)
    (#:a #:alexandria-2))
-  (:export #:parenscript))
+  (:export #:generate))
 
 (in-package #:weekend.client.ps)
 
 
 ;; this function largely mirrors the implementation of construct-route-builder
-(defun generate-endpoint-client (class)
+(defun generate (class)
   (when (symbolp class) (setf class (find-class class)))
 
   (let*
@@ -26,6 +26,7 @@
              :collect (intern (string part))))
        (method
          (wknd:request-method class))
+       
        (body
          (when (wknd:body-expected-p method)
            `(ps:chain -J-S-O-N
@@ -51,6 +52,6 @@
                method ,(string method)
                cache "no-cache"
                headers (ps:create "Content-Type" "application/json")
-               redirect follow
+               redirect "follow"
                ,@(when body (list 'body body)))))))
 
-- 
cgit v1.2.3