jscl-react.lisp

jscl-react.lisp

;;; react.lisp --- React interop for JSCL

;; Copyright (C) 2025 JSCL contributors

;; JSCL is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; JSCL is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.

;;; React interop module providing JSX-like syntax, component
;;; definition with declarative hooks, and convenience wrappers for
;;; the React API.
;;;
;;; React and ReactDOM must be loaded in the JS environment before
;;; using this module.

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defpackage :react
    (:use :cl)
    (:import-from :jscl
     #:oget #:oset
     #:jsstring #:clstring #:jsbool #:clbool
     #:*root* #:new #:typeof #:instanceof
     #:object)
    (:export #:jsx #:defcomponent #:defhook
             #:create-context #:render
             #:use-state #:use-effect #:use-ref
             #:use-memo #:use-callback #:use-context
             #:ensure-js-value
             ;; Re-exported FFI symbols for convenience
             #:oget #:oset
             #:jsstring #:clstring #:jsbool #:clbool
             #:object #:new #:typeof #:instanceof)))

(in-package :react)


;;;; Macro-expansion helpers
;;;;
;;;; Everything used by the jsx, defcomponent, and defhook macros at
;;;; expansion time must be available in the host during
;;;; cross-compilation, so we wrap them in eval-when.

(eval-when (:compile-toplevel :load-toplevel :execute)

;;;; 1. Utility functions (compile-time)

(defun kebab-to-camel (string)
  "Convert a kebab-case STRING to camelCase.
Preserves hyphens in data-* and aria-* prefixes."
  (let ((data-prefix-p (or (and (>= (length string) 5)
                                (string= (subseq string 0 5) "data-"))
                           (and (>= (length string) 5)
                                (string= (subseq string 0 5) "aria-")))))
    (if data-prefix-p
        string
        (let ((result "")
              (upcase-next nil))
          (dotimes (i (length string))
            (let ((ch (char string i)))
              (cond
                ((char= ch #\-)
                 (setq upcase-next t))
                (upcase-next
                 (setq result (concatenate 'string result (string (char-upcase ch))))
                 (setq upcase-next nil))
                (t
                 (setq result (concatenate 'string result (string ch)))))))
          result))))

(defun prop-name (keyword)
  "Convert a keyword to a camelCase JS property name string.
:on-click -> \"onClick\", :class-name -> \"className\"."
  (kebab-to-camel (string-downcase (symbol-name keyword))))


;;;; 2. Hook expander registry

(defvar *hook-expanders* (list)
  "Alist mapping hook keyword symbols to expander functions.
Each expander function takes the cdr of the hook form (the arguments)
and returns (values bindings statements) where bindings is a list of
\(var init-form) pairs for let* and statements is a list of forms to
execute after the bindings.")

(defun register-hook-expander (keyword function)
  "Register an expander function for a hook keyword."
  (let ((entry (assoc keyword *hook-expanders*)))
    (if entry
        (setf (cdr entry) function)
        (push (cons keyword function) *hook-expanders*))))

(defun get-hook-expander (keyword)
  "Look up the hook expander for KEYWORD."
  (cdr (assoc keyword *hook-expanders*)))


;;;; 3. Built-in hook expanders

;;; Each expander returns (values bindings statements)
;;; where bindings = list of (var init-form)
;;; and statements = list of forms to evaluate for side effects

;; (:state (var initial))
;; Binds var and set-var.  The setter's symbol-function is also set
;; so that (set-var new-val) works in function-call position (Lisp-2).
(register-hook-expander :state
  (lambda (args)
    (destructuring-bind (var-and-init) args
      (let* ((var (first var-and-init))
             (init (second var-and-init))
             (setter (intern (concatenate 'string "SET-" (symbol-name var))
                             *package*))
             (pair (gensym "STATE")))
        (values
         `((,pair (#j:React:useState ,init))
           (,var (oget ,pair 0))
           (,setter (oget ,pair 1)))
         ;; Set the symbol-function so (set-var val) works in call position.
         ;; This must happen before :callback bindings close over it.
         `((oset ,setter ',setter "fvalue"))
         nil)))))

;; (:effect (deps...) body...)       — deps list
;; (:effect :every body...)          — every render (no deps arg)
(register-hook-expander :effect
  (lambda (args)
    (let ((first-arg (first args))
          (body (rest args)))
      (if (eq first-arg :every)
          ;; No deps argument — run on every render
          (values nil
                  `((#j:React:useEffect
                     (lambda ()
                       ,@body
                       #j:undefined))))
          ;; first-arg is a deps list
          (let ((deps first-arg))
            (values nil
                    `((#j:React:useEffect
                       (lambda ()
                         ,@body
                         #j:undefined)
                       (vector ,@deps)))))))))

;; (:ref name)          — initial value is #j:null
;; (:ref name initial)
(register-hook-expander :ref
  (lambda (args)
    (let ((name (first args))
          (initial (if (rest args) (second args) #j:null)))
      (values
       `((,name (#j:React:useRef ,initial)))
       nil))))

;; (:memo (name deps...) body...)
(register-hook-expander :memo
  (lambda (args)
    (destructuring-bind ((name &rest deps) &body body) args
      (values
       `((,name (#j:React:useMemo
                 (lambda () ,@body)
                 (vector ,@deps))))
       nil))))

;; (:callback (name deps...) fn-form)
(register-hook-expander :callback
  (lambda (args)
    (destructuring-bind ((name &rest deps) fn-form) args
      (values
       `((,name (#j:React:useCallback ,fn-form (vector ,@deps))))
       nil))))

;; (:context name ctx-obj)
(register-hook-expander :context
  (lambda (args)
    (destructuring-bind (name ctx-obj) args
      (values
       `((,name (#j:React:useContext ,ctx-obj)))
       nil))))


;;;; 4. JSX support — parsing and expansion

(defun parse-jsx-args (args)
  "Separate leading keyword-value prop pairs from children.
Returns (values props-plist children)."
  (let ((props nil)
        (rest args))
    (loop
      (when (or (null rest) (not (keywordp (car rest))))
        (return))
      (when (null (cdr rest))
        (error "JSX: odd number of prop arguments — missing value for ~S" (car rest)))
      (push (car rest) props)
      (push (cadr rest) props)
      (setq rest (cddr rest)))
    (values (nreverse props) rest)))

(defun jsx-type-form (type)
  "Convert a JSX type designator to a form.
Keywords become JS tag strings, :<> becomes React.Fragment,
other forms are evaluated as component references."
  (cond
    ((eq type :<>) '#j:React:Fragment)
    ((keywordp type)
     `(jsstring ,(string-downcase (symbol-name type))))
    (t type)))

(defun html-element-p (type)
  "Return T if TYPE designates an HTML element (a keyword other than :<>)."
  (and (keywordp type) (not (eq type :<>))))

(defun expand-props (props-plist html-p)
  "Expand a plist of props into an (object ...) form.
When HTML-P is true, wraps values with ensure-js-value."
  (if (null props-plist)
      #j:null
      (let ((pairs nil))
        (do ((tail props-plist (cddr tail)))
            ((null tail))
          (let ((key (car tail))
                (val (cadr tail)))
            (push (prop-name key) pairs)
            (if html-p
                (push `(ensure-js-value ,val) pairs)
                (push val pairs))))
        `(object ,@(nreverse pairs)))))

(defun component-symbol-p (sym)
  "Return T if SYM looks like a component name — a symbol not in the CL package."
  (and (symbolp sym)
       (not (keywordp sym))
       (not (eq (symbol-package sym) (find-package :cl)))))

(defun expand-jsx-child (child html-p)
  "Expand a single JSX child form.
If CHILD is a list starting with a keyword, treat it as a nested HTML element.
If CHILD is a list starting with a non-CL symbol, treat it as a component element.
If CHILD is a string literal and HTML-P, wrap with jsstring.
For HTML elements, wrap other runtime expressions with ensure-js-value
to convert Lisp strings and lists to JS-compatible values.
Otherwise return as-is."
  (cond
    ((and (consp child)
          (let ((head (car child)))
            (or (keywordp head)
                (component-symbol-p head))))
     (expand-nested-element child))
    ((and html-p (stringp child))
     `(jsstring ,child))
    (html-p
     `(ensure-js-value ,child))
    (t child)))

(defun expand-nested-element (form)
  "Expand a (:tag ...) nested element form into a React.createElement call."
  (let ((tag (car form))
        (rest (cdr form)))
    (multiple-value-bind (props children) (parse-jsx-args rest)
      (let* ((html-p (html-element-p tag))
             (type-form (jsx-type-form tag))
             (props-form (expand-props props html-p))
             (expanded-children (mapcar (lambda (c) (expand-jsx-child c html-p))
                                        children)))
        `(#j:React:createElement ,type-form ,props-form ,@expanded-children)))))


;;;; 5. Hook parsing (shared by defcomponent and defhook)

(defun hook-form-p (form)
  "Return T if FORM is a hook declaration (a list starting with a keyword
or a symbol that has a registered hook expander)."
  (and (consp form)
       (let ((head (car form)))
         (or (and (keywordp head) (get-hook-expander head))
             (and (symbolp head) (not (keywordp head))
                  (get-hook-expander head))))))

(defun parse-hooks (body)
  "Separate leading hook declarations from the render body.
Returns (values hook-forms render-body)."
  (let ((hooks nil))
    (loop
      (when (or (null body) (not (hook-form-p (car body))))
        (return))
      (push (car body) hooks)
      (setq body (cdr body)))
    (values (nreverse hooks) body)))

(defun expand-hook-bindings (hook-forms)
  "Expand a list of hook forms into (values all-bindings all-statements all-flet-bindings).
Bindings are for a let* form, statements are side-effecting forms,
and flet-bindings are local function definitions (used by :state setters
to bridge the Lisp-2 function/value namespace gap)."
  (let ((all-bindings nil)
        (all-statements nil)
        (all-flet-bindings nil))
    (dolist (form hook-forms)
      (let* ((head (car form))
             (args (cdr form))
             (expander (get-hook-expander head)))
        (unless expander
          (error "No hook expander registered for ~S" head))
        (multiple-value-bind (bindings statements flet-bindings) (funcall expander args)
          (setq all-bindings (append all-bindings bindings))
          (setq all-statements (append all-statements statements))
          (when flet-bindings
            (setq all-flet-bindings (append all-flet-bindings flet-bindings))))))
    (values all-bindings all-statements all-flet-bindings)))


;;;; 6. Props destructuring for defcomponent

(defun expand-props-destructuring (lambda-list props-sym)
  "Generate let* bindings to destructure React props from PROPS-SYM.
LAMBDA-LIST is a &key lambda list. Returns a list of (var init-form) bindings."
  (let ((bindings nil)
        (keys-started nil))
    (dolist (item lambda-list)
      (cond
        ((eq item '&key)
         (setq keys-started t))
        (keys-started
         (let (var default)
           (if (consp item)
               (setq var (first item) default (second item))
               (setq var item default nil))
           (let ((js-name (prop-name (intern (symbol-name var) "KEYWORD"))))
             (push `(,var (let ((%v (oget ,props-sym ,js-name)))
                            (if (eq %v #j:undefined) ,default %v)))
                   bindings))))))
    (nreverse bindings)))

) ;; end eval-when


;;;; 7. jsx macro

(defmacro jsx (type &rest args)
  "Create a React element.

TYPE is a keyword for HTML elements, :<> for fragments, or a symbol/form
for a component.  Remaining ARGS are keyword-value prop pairs followed by
children.

  (jsx :div :class-name \"container\"
    (:h1 \"Hello\")
    (:p \"World\"))

Inside jsx, child forms starting with a keyword or a non-CL symbol are
automatically treated as nested elements without needing another jsx call."
  (expand-nested-element (cons type args)))


;;;; 8. defcomponent macro

(defmacro defcomponent (name lambda-list &body body)
  "Define a React component.

NAME is the variable that will hold the component function.
LAMBDA-LIST is a &key lambda list for props destructuring.
BODY starts with optional hook declarations (:state, :effect, etc.)
followed by the render expression(s).

  (defcomponent counter (&key (initial-count 0))
    (:state (count initial-count))
    (jsx :div
      (:p (format nil \"Count: ~a\" count))
      (:button :on-click (lambda () (set-count (1+ count))) \"+\")))"
  (let ((props-sym (gensym "PROPS"))
        (ref-sym (gensym "REF")))
    (multiple-value-bind (hook-forms render-body) (parse-hooks body)
      (multiple-value-bind (hook-bindings hook-statements flet-bindings)
          (expand-hook-bindings hook-forms)
        (let* ((props-bindings (expand-props-destructuring lambda-list props-sym))
               (body-forms (if flet-bindings
                               `((flet ,flet-bindings
                                   ,@hook-statements
                                   ,@render-body))
                               `(,@hook-statements
                                 ,@render-body))))
          `(defvar ,name
             (let ((component
                     ;; React calls components with (props, ref-or-context),
                     ;; so accept an optional second argument.
                     (lambda (,props-sym &optional ,ref-sym)
                       (let* (,@props-bindings
                              ,@hook-bindings)
                         ,@body-forms))))
               (oset (jsstring ,(symbol-name name)) component "displayName")
               component)))))))


;;;; 9. defhook macro

(defmacro defhook (name lambda-list &body body)
  "Define a custom React hook.

NAME is the function name. LAMBDA-LIST is a regular lambda list.
BODY starts with optional hook declarations followed by the return
expression(s).

  (defhook use-counter (&key (initial 0))
    (:state (count initial))
    (:callback (increment count)
      (lambda () (set-count (1+ count))))
    (list count increment))"
  (multiple-value-bind (hook-forms return-body) (parse-hooks body)
    (multiple-value-bind (hook-bindings hook-statements flet-bindings)
        (expand-hook-bindings hook-forms)
      (let ((body-forms (if flet-bindings
                            `((flet ,flet-bindings
                                ,@hook-statements
                                ,@return-body))
                            `(,@hook-statements
                              ,@return-body))))
        `(defun ,name ,lambda-list
           (let* (,@hook-bindings)
             ,@body-forms))))))


;;;; 10. Runtime functions
;;;;
;;;; These are only needed in the target (JavaScript) at runtime.

(defun ensure-js-value (x)
  "Auto-convert Lisp values to JS-compatible values for React.
Lisp strings become JS strings, lists become JS arrays (recursively),
and nil becomes JS null. Other values pass through unchanged."
  (cond
    ((stringp x) (jsstring x))
    ((null x) #j:null)
    ((consp x) (apply #'vector (mapcar #'ensure-js-value x)))
    (t x)))

(defun use-state (initial)
  "Call React.useState. Returns two values: current value and setter function."
  (let ((pair (#j:React:useState initial)))
    (values (oget pair 0) (oget pair 1))))

(defun use-effect (fn deps)
  "Call React.useEffect with FN and a deps vector (or nil for every render)."
  (if deps
      (#j:React:useEffect fn deps)
      (#j:React:useEffect fn))
  nil)

(defun use-ref (&optional (initial #j:null))
  "Call React.useRef. Returns the ref object."
  (#j:React:useRef initial))

(defun use-memo (fn deps)
  "Call React.useMemo. Returns the memoized value."
  (#j:React:useMemo fn deps))

(defun use-callback (fn deps)
  "Call React.useCallback. Returns the memoized callback."
  (#j:React:useCallback fn deps))

(defun use-context (ctx)
  "Call React.useContext. Returns the current context value."
  (#j:React:useContext ctx))

(defun create-context (&optional default)
  "Create a React context with an optional default value."
  (#j:React:createContext default))

(defun render (element container)
  "Render a React element into a DOM container using createRoot."
  (let ((root (#j:ReactDOM:createRoot container)))
    ((oget root "render") element)
    root))

;;; EOF