;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/enum
  (:documentation "Macro for generating an enum type.")
  (:use :c2cl :iterate)
  (:import-from :alexandria :with-gensyms)
  (:import-from :ukkoclot/serializing :fixup-value :parse-value)
  (:import-from :string-case :string-case)
  (:local-nicknames
   (:jzon :com.inuoe.jzon))
  (:export :define-enum))
(in-package :ukkoclot/enum)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defstruct (field (:constructor make-field%)) name string)

  (defun make-field (name string)
    "Better constructor for `field'."
    (make-field% :name name :string string))

  (defun parse-field-specs (field-specs)
    "Parse a list of field specs into a list of fields."
    (iter (for field-spec in field-specs)
      (collect (apply #'make-field field-spec))))

  (defun emit-defconst (field)
    "Emit the `defconstant' statement for a specific field."
    `(defconstant ,(field-name field) ',(field-name field)))

  (defun emit-deftype (name fields)
    "Emit the `deftype' statement for the enum."
    `(deftype ,name ()
       '(member ,@(iter (for field in fields) (collect (field-name field))))))

  (defun emit-fixup-method (field)
    "Emit the `fixup-value' specialization for the enum."
    (with-gensyms (arg)
      `(defmethod fixup-value ((,arg (eql ',(field-name field))))
         ,(field-string field))))

  (defun emit-jzon-write-method (field)
    "Emit the `json:write-value' specialization for the enum."
    (with-gensyms (arg writer)
      `(defmethod jzon:write-value ((,writer jzon:writer) (,arg (eql ',(field-name field))))
         (jzon:write-value ,writer ,(field-string field)))))

  (defun emit-parse-value (name fields)
    "Emit the `parse-value' specialization for the enum."
    (with-gensyms (source type)
      `(defmethod parse-value ((,type (eql ',name)) ,source)
         ;; nil in, nil out
         (when ,source
           (string-case (,source)
             ,@(iter (for field in fields)
                 (collect `(,(field-string field) ,(field-name field))))))))))

(defmacro define-enum (name &body field-specs)
  "Define a new enumeration type.

FIELD-SPECS := FIELD-SPEC*
FIELD-SPEC := (FIELD-NAME FIELD-SERIALIZATION)

FIELD-NAME is the symbol name of the field.
FIELD-SERIALIZATION is the string serialization of the field."
  (let ((fields (parse-field-specs field-specs)))
    `(progn
       ,@(iter (for field in fields)
           (collect (emit-defconst field)))
       ,(emit-deftype name fields)
       ,(emit-parse-value name fields)
       ,@(iter (for field in fields)
           (collect `(progn
                       ,(emit-fixup-method field)
                       ,(emit-jzon-write-method field)))))))