(use-modules (reactive)
             (ice-9 match)
             (srfi srfi-9)
             (hoot ffi))

(define-foreign get-element-by-id
  "document" "getElementById"
  (ref string) -> (ref null extern))

(define-foreign document-body
  "document" "body"
  -> (ref null extern))

(define-foreign make-text-node
  "document" "createTextNode"
  (ref string) -> (ref null extern))

(define-foreign make-element
  "document" "createElement"
  (ref string) -> (ref null extern))

(define-foreign element-inner-text
  "element" "innerText"
  (ref null extern) -> (ref string))
(define-foreign set-element-inner-text!
  "element" "setInnerText"
  (ref null extern) (ref string) -> none)

(define-foreign add-event-listener!
  "element" "addEventListener"
  (ref null extern) (ref string) (ref null extern) -> none)

(define-foreign append-child!
  "element" "appendChild"
  (ref null extern) (ref null extern) -> (ref null extern))

(define-foreign element-parent
  "element" "parentElement"
  (ref null extern) -> (ref null extern))

(define-foreign replace-child!
  "element" "replaceChild"
  (ref null extern) (ref null extern) (ref null extern) -> (ref null extern))

(define-foreign set-attribute!
  "element" "setAttribute"
  (ref null extern) (ref string) (ref string) -> none)

(define-record-type <element-ref>
  (make-element-ref elem deriv children)
  element-ref?
  (elem element-ref-element element-ref-set-element!)
  (deriv element-ref-deriv element-ref-set-deriv!)
  (children element-ref-children element-ref-set-children!))

(define (sxml->dom-ref exp)
  (match exp
    ((or (? cell?) (? deriv?))
     (let* ((ref (make-element-ref #f #f '()))
            (deriv (~ (let ((old-elem (element-ref-element ref))
                            (inner-ref (sxml->dom (! exp)))
                            (elem (make-element "deriv")))
                        (append-child! elem (element-ref-element inner-ref))
                        (when old-elem
                          (replace-child! (element-parent old-elem) old-elem elem))
                        (element-ref-set-element! ref elem)
                        (element-ref-set-children! ref (list inner-ref))))))
       (element-ref-set-deriv! ref deriv)
       ref))
    ((? number? num)
     (make-element-ref (make-text-node (number->string num)) #f '()))
    ;; The simple case: a string representing a text node.
    ((? string? str)
     (make-element-ref (make-text-node str) #f '()))
    ;; An element tree.  The first item is the HTML tag.
    (((? symbol? tag) . body)
     ;; Create a new element with the given tag.
     (let* ((elem (make-element (symbol->string tag)))
            (ref (make-element-ref elem #f '())))
       (define (add-children children)
         ;; Recursively call sxml->dom for each child node and
         ;; append it to elem.
         (element-ref-set-children!
          ref
          (map (lambda (child)
                 (let ((child-ref (sxml->dom child)))
                   (append-child! elem (element-ref-element child-ref))
                   child-ref))
               children)))
       (match body
         ;; '@' denotes an attribute list.  Child nodes follow.
         ((('@ . attrs) . children)
          ;; Set attributes.
          (for-each (lambda (attr)
                      (match attr
                        ;; Attributes are (symbol string) tuples.
                        (((? symbol? name) (? string? val))
                         (set-attribute! elem
                                         (symbol->string name)
                                         val))
                        (((? symbol? name) (? procedure? proc))
                         (add-event-listener! elem
                                              (symbol->string name)
                                              (procedure->external proc)))))
                    attrs)
          (add-children children))
         ;; No attributes, just a list of child nodes.
         (children (add-children children)))
       ref))))

(define counter (make-cell 0))
(define square (~ (* (! counter) (! counter))))

(define root-ref
  (sxml->dom-ref
   `(div (@ (class "foo"))
         (p "this is a test")
         (button (@ (id "button")
                    (type "button")
                    (click ,(lambda (e)
                              (! counter (1+ (! counter)))
                              ;; Hacky hack to ensure root-ref isn't GC'd too early...
                              (display root-ref))))
                 "Counter: "
                 ,counter)
         (p "The square is: " ,square))))

(append-child! (document-body) (element-ref-element root-ref))