From 30a034b30b66694447fc38172a2265a1095af222 Mon Sep 17 00:00:00 2001 From: colin Date: Sun, 23 Jun 2024 14:43:20 -0700 Subject: Add: client generator for dexador --- src/client/dexador/generate.lisp | 63 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 src/client/dexador/generate.lisp (limited to 'src/client/dexador') 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))) -- cgit v1.2.3