diff options
Diffstat (limited to 'src/enum.lisp')
| -rw-r--r-- | src/enum.lisp | 24 |
1 files changed, 19 insertions, 5 deletions
diff --git a/src/enum.lisp b/src/enum.lisp index 8943a90..a047c1d 100644 --- a/src/enum.lisp +++ b/src/enum.lisp | |||
| @@ -1,7 +1,9 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | 1 | ;; SPDX-License-Identifier: EUPL-1.2 |
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/enum | 3 | (defpackage :ukkoclot/enum |
| 4 | (:documentation "Macro for generating an enum type.") | ||
| 4 | (:use :c2cl :iterate) | 5 | (:use :c2cl :iterate) |
| 6 | (:import-from :alexandria :with-gensyms) | ||
| 5 | (:import-from :ukkoclot/serializing :fixup-value :parse-value) | 7 | (:import-from :ukkoclot/serializing :fixup-value :parse-value) |
| 6 | (:import-from :string-case :string-case) | 8 | (:import-from :string-case :string-case) |
| 7 | (:local-nicknames | 9 | (:local-nicknames |
| @@ -13,33 +15,38 @@ | |||
| 13 | (defstruct (field (:constructor make-field%)) name string) | 15 | (defstruct (field (:constructor make-field%)) name string) |
| 14 | 16 | ||
| 15 | (defun make-field (name string) | 17 | (defun make-field (name string) |
| 18 | "Better constructor for `field'." | ||
| 16 | (make-field% :name name :string string)) | 19 | (make-field% :name name :string string)) |
| 17 | 20 | ||
| 18 | (defun parse-field-specs (field-specs) | 21 | (defun parse-field-specs (field-specs) |
| 22 | "Parse a list of field specs into a list of fields." | ||
| 19 | (iter (for field-spec in field-specs) | 23 | (iter (for field-spec in field-specs) |
| 20 | (collect (apply #'make-field field-spec)))) | 24 | (collect (apply #'make-field field-spec)))) |
| 21 | 25 | ||
| 22 | (defun emit-defconst (field) | 26 | (defun emit-defconst (field) |
| 27 | "Emit the `defconstant' statement for a specific field." | ||
| 23 | `(defconstant ,(field-name field) ',(field-name field))) | 28 | `(defconstant ,(field-name field) ',(field-name field))) |
| 24 | 29 | ||
| 25 | (defun emit-deftype (name fields) | 30 | (defun emit-deftype (name fields) |
| 31 | "Emit the `deftype' statement for the enum." | ||
| 26 | `(deftype ,name () | 32 | `(deftype ,name () |
| 27 | '(member ,@(iter (for field in fields) (collect (field-name field)))))) | 33 | '(member ,@(iter (for field in fields) (collect (field-name field)))))) |
| 28 | 34 | ||
| 29 | (defun emit-fixup-method (field) | 35 | (defun emit-fixup-method (field) |
| 30 | (let ((arg (gensym "ARG"))) | 36 | "Emit the `fixup-value' specialization for the enum." |
| 37 | (with-gensyms (arg) | ||
| 31 | `(defmethod fixup-value ((,arg (eql ',(field-name field)))) | 38 | `(defmethod fixup-value ((,arg (eql ',(field-name field)))) |
| 32 | ,(field-string field)))) | 39 | ,(field-string field)))) |
| 33 | 40 | ||
| 34 | (defun emit-jzon-write-method (field) | 41 | (defun emit-jzon-write-method (field) |
| 35 | (let ((writer (gensym "WRITER")) | 42 | "Emit the `json:write-value' specialization for the enum." |
| 36 | (arg (gensym "ARG"))) | 43 | (with-gensyms (arg writer) |
| 37 | `(defmethod jzon:write-value ((,writer jzon:writer) (,arg (eql ',(field-name field)))) | 44 | `(defmethod jzon:write-value ((,writer jzon:writer) (,arg (eql ',(field-name field)))) |
| 38 | (jzon:write-value ,writer ,(field-string field))))) | 45 | (jzon:write-value ,writer ,(field-string field))))) |
| 39 | 46 | ||
| 40 | (defun emit-parse-value (name fields) | 47 | (defun emit-parse-value (name fields) |
| 41 | (let ((type (gensym "TYPE")) | 48 | "Emit the `parse-value' specialization for the enum." |
| 42 | (source (gensym "SOURCE"))) | 49 | (with-gensyms (source type) |
| 43 | `(defmethod parse-value ((,type (eql ',name)) ,source) | 50 | `(defmethod parse-value ((,type (eql ',name)) ,source) |
| 44 | ;; nil in, nil out | 51 | ;; nil in, nil out |
| 45 | (when ,source | 52 | (when ,source |
| @@ -48,6 +55,13 @@ | |||
| 48 | (collect `(,(field-string field) ,(field-name field)))))))))) | 55 | (collect `(,(field-string field) ,(field-name field)))))))))) |
| 49 | 56 | ||
| 50 | (defmacro define-enum (name &body field-specs) | 57 | (defmacro define-enum (name &body field-specs) |
| 58 | "Define a new enumeration type. | ||
| 59 | |||
| 60 | FIELD-SPECS := FIELD-SPEC* | ||
| 61 | FIELD-SPEC := (FIELD-NAME FIELD-SERIALIZATION) | ||
| 62 | |||
| 63 | FIELD-NAME is the symbol name of the field. | ||
| 64 | FIELD-SERIALIZATION is the string serialization of the field." | ||
| 51 | (let ((fields (parse-field-specs field-specs))) | 65 | (let ((fields (parse-field-specs field-specs))) |
| 52 | `(progn | 66 | `(progn |
| 53 | ,@(iter (for field in fields) | 67 | ,@(iter (for field in fields) |