aboutsummaryrefslogtreecommitdiff
path: root/src/client/ps
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/ps')
-rw-r--r--src/client/ps/generate.lisp56
1 files changed, 56 insertions, 0 deletions
diff --git a/src/client/ps/generate.lisp b/src/client/ps/generate.lisp
new file mode 100644
index 0000000..11b0c53
--- /dev/null
+++ b/src/client/ps/generate.lisp
@@ -0,0 +1,56 @@
+(defpackage #:weekend.client.ps
+ (:use #:cl)
+ (:import-from #:flatbind #:do>)
+ (:local-nicknames
+ (#:wknd #:weekend)
+ (#:a #:alexandria-2))
+ (:export #:parenscript))
+
+(in-package #:weekend.client.ps)
+
+
+;; this function largely mirrors the implementation of construct-route-builder
+(defun generate-endpoint-client (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))
+ (body
+ (when (wknd:body-expected-p method)
+ `(ps:chain -J-S-O-N
+ (stringify
+ (ps:create
+ ,@(loop :for arg :in args
+ :collect arg :collect arg))))))
+ (url-param-names
+ (unless (wknd:body-expected-p method)
+ (set-difference args parts :test 'eq)))
+ (url-params
+ (when url-param-names
+ (cons "?"
+ (loop :for (param . more) :on url-param-names
+ :collect (string param)
+ :collect "="
+ :collect param
+ :when more
+ :collect "&")))))
+ `(defun ,(class-name class) ,args
+ (fetch (+ ,@parts ,@url-params)
+ (ps:create
+ method ,(string method)
+ cache "no-cache"
+ headers (ps:create "Content-Type" "application/json")
+ redirect follow
+ ,@(when body (list 'body body)))))))
+