summaryrefslogtreecommitdiff
path: root/src/enum.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/enum.lisp')
-rw-r--r--src/enum.lisp24
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
60FIELD-SPECS := FIELD-SPEC*
61FIELD-SPEC := (FIELD-NAME FIELD-SERIALIZATION)
62
63FIELD-NAME is the symbol name of the field.
64FIELD-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)