;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/enum
  (:use :c2cl :iterate)
  (: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)
    (make-field% :name name :string string))

  (defun parse-field-specs (field-specs)
    (iter (for field-spec in field-specs)
      (collect (apply #'make-field field-spec))))

  (defun emit-defconst (field)
    `(defconstant ,(field-name field) ',(field-name field)))

  (defun emit-deftype (name fields)
    `(deftype ,name ()
       '(member ,@(iter (for field in fields) (collect (field-name field))))))

  (defun emit-fixup-method (field)
    (let ((arg (gensym "ARG")))
      `(defmethod fixup-value ((,arg (eql ',(field-name field))))
         ,(field-string field))))

  (defun emit-jzon-write-method (field)
    (let ((writer (gensym "WRITER"))
          (arg (gensym "ARG")))
      `(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)
    (let ((type (gensym "TYPE"))
          (source (gensym "SOURCE")))
      `(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)
  (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)))))))