diff options
Diffstat (limited to 'src/tg/method-macros.lisp')
| -rw-r--r-- | src/tg/method-macros.lisp | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp index 0d33ffb..9ab9e89 100644 --- a/src/tg/method-macros.lisp +++ b/src/tg/method-macros.lisp | |||
| @@ -5,10 +5,10 @@ | |||
| 5 | (:use :c2cl :iterate) | 5 | (:use :c2cl :iterate) |
| 6 | (:import-from :alexandria :make-keyword :with-gensyms) | 6 | (:import-from :alexandria :make-keyword :with-gensyms) |
| 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) | 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) |
| 8 | (:import-from :serapeum :take) | 8 | (:import-from :serapeum :-> :take) |
| 9 | (:import-from :state) | 9 | (:import-from :state) |
| 10 | (:import-from :str) | 10 | (:import-from :str) |
| 11 | (:import-from :ukkoclot/src/transport :do-call) | 11 | (:import-from :ukkoclot/src/transport :do-call :http-method) |
| 12 | (:export :define-tg-method)) | 12 | (:export :define-tg-method)) |
| 13 | (in-package :ukkoclot/src/tg/method-macros) | 13 | (in-package :ukkoclot/src/tg/method-macros) |
| 14 | 14 | ||
| @@ -21,6 +21,7 @@ | |||
| 21 | (defparameter +unique+ (gensym)) | 21 | (defparameter +unique+ (gensym)) |
| 22 | 22 | ||
| 23 | ;; TODO: Fix optional-and-key ! | 23 | ;; TODO: Fix optional-and-key ! |
| 24 | (-> make-param (symbol t &optional t &key (:skip-if-default boolean)) param) | ||
| 24 | (defun make-param (name type ; lint:suppress avoid-optional-and-key | 25 | (defun make-param (name type ; lint:suppress avoid-optional-and-key |
| 25 | &optional (default +unique+) | 26 | &optional (default +unique+) |
| 26 | &key (skip-if-default (not (eq default +unique+)))) | 27 | &key (skip-if-default (not (eq default +unique+)))) |
| @@ -32,26 +33,34 @@ | |||
| 32 | :default default | 33 | :default default |
| 33 | :skip-if-default skip-if-default))) | 34 | :skip-if-default skip-if-default))) |
| 34 | 35 | ||
| 36 | ;; TODO: list-of-params, list-of-param-specs | ||
| 37 | (-> parse-param-specs (list) list) | ||
| 35 | (defun parse-param-specs (param-specs) | 38 | (defun parse-param-specs (param-specs) |
| 36 | (iter (for param-spec in param-specs) | 39 | (iter (for param-spec in param-specs) |
| 37 | (collect (apply #'make-param param-spec)))) | 40 | (collect (apply #'make-param param-spec)))) |
| 38 | 41 | ||
| 42 | (-> path-from-name (symbol) string) | ||
| 39 | (defun path-from-name (name) | 43 | (defun path-from-name (name) |
| 40 | (let ((str (str:camel-case name))) | 44 | (let ((str (str:camel-case name))) |
| 41 | (if (str:ends-with-p "%" str :ignore-case nil) | 45 | (if (str:ends-with-p "%" str :ignore-case nil) |
| 42 | (take (- (length str) 1) str) | 46 | (take (- (length str) 1) str) |
| 43 | str))) | 47 | str))) |
| 44 | 48 | ||
| 49 | (-> emit-append-to-args (param symbol) list) | ||
| 45 | (defun emit-append-to-args (param args) | 50 | (defun emit-append-to-args (param args) |
| 46 | `(setf ,args (acons ',(param-name param) ,(param-name param) ,args))) | 51 | `(setf ,args (acons ',(param-name param) ,(param-name param) ,args))) |
| 47 | 52 | ||
| 53 | (-> emit-arg-type (param) list) | ||
| 48 | (defun emit-arg-type (param) | 54 | (defun emit-arg-type (param) |
| 49 | `(,(make-keyword (param-name param)) | 55 | `(,(make-keyword (param-name param)) |
| 50 | ,(param-type param))) | 56 | ,(param-type param))) |
| 51 | 57 | ||
| 58 | (-> emit-defun-arg (param) list) | ||
| 52 | (defun emit-defun-arg (param) | 59 | (defun emit-defun-arg (param) |
| 53 | `(,(param-name param) ,(param-default param))) | 60 | `(,(param-name param) ,(param-default param))) |
| 54 | 61 | ||
| 62 | ;; TODO: list-of-params | ||
| 63 | (-> emit-defun (symbol t list http-method) list) | ||
| 55 | (defun emit-defun (name return-type params method) | 64 | (defun emit-defun (name return-type params method) |
| 56 | (with-gensyms (args) | 65 | (with-gensyms (args) |
| 57 | `(defun ,name (&key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid | 66 | `(defun ,name (&key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid |
| @@ -65,11 +74,13 @@ | |||
| 65 | (emit-append-to-args param args)))) | 74 | (emit-append-to-args param args)))) |
| 66 | (do-call ,method ,(path-from-name name) ',return-type ,args))))) | 75 | (do-call ,method ,(path-from-name name) ',return-type ,args))))) |
| 67 | 76 | ||
| 77 | ;; TODO: list-of-params | ||
| 78 | (-> emit-ftype (symbol t list) list) | ||
| 68 | (defun emit-ftype (name return-type params) | 79 | (defun emit-ftype (name return-type params) |
| 69 | `(declaim (ftype (function (&key ,@(iter (for param in params) | 80 | `(-> ,name |
| 70 | (collect (emit-arg-type param)))) | 81 | (&key ,@(iter (for param in params) |
| 71 | ,return-type) | 82 | (collect (emit-arg-type param)))) |
| 72 | ,name)))) | 83 | ,return-type))) |
| 73 | 84 | ||
| 74 | (defmacro define-tg-method ((name type &optional (method :POST)) | 85 | (defmacro define-tg-method ((name type &optional (method :POST)) |
| 75 | &body param-specs) | 86 | &body param-specs) |