aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/client/dexador/generate.lisp63
-rw-r--r--src/client/ps/generate.lisp7
2 files changed, 67 insertions, 3 deletions
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)))))))