(define-library
  (sx dom)
  (export
    dom-document
    dom-window
    dom-body
    dom-head
    dom-create-element
    create-text-node
    create-fragment
    create-comment
    dom-append
    dom-prepend
    dom-insert-before
    dom-insert-after
    dom-remove
    dom-is-active-element?
    dom-is-input-element?
    dom-is-child-of?
    dom-attr-list
    dom-remove-child
    dom-replace-child
    dom-clone
    dom-query
    dom-query-all
    dom-query-by-id
    dom-closest
    dom-matches?
    dom-get-attr
    dom-set-attr
    dom-remove-attr
    dom-has-attr?
    dom-add-class
    dom-remove-class
    dom-has-class?
    dom-visible?
    dom-text-content
    dom-set-text-content
    dom-inner-html
    dom-set-inner-html
    dom-outer-html
    dom-insert-adjacent-html
    dom-get-style
    dom-set-style
    dom-get-prop
    dom-set-prop
    dom-tag-name
    dom-node-type
    dom-node-name
    dom-id
    dom-parent
    dom-first-child
    dom-next-sibling
    dom-child-list
    dom-is-fragment?
    dom-child-nodes
    dom-remove-children-after
    dom-focus
    dom-parse-html
    dom-listen
    dom-add-listener
    dom-dispatch
    event-detail
    prevent-default
    stop-propagation
    event-modifier-key?
    element-value
    error-message
    dom-get-data
    dom-set-data
    dom-append-to-head
    set-document-title)
  (begin
    (define dom-document (fn () (host-global "document")))
    (define dom-window (fn () (host-global "window")))
    (define dom-body (fn () (host-get (dom-document) "body")))
    (define dom-head (fn () (host-get (dom-document) "head")))
    (define
      dom-create-element
      (fn
        (tag ns)
        (if
          ns
          (host-call (dom-document) "createElementNS" ns tag)
          (host-call (dom-document) "createElement" tag))))
    (define
      create-text-node
      (fn (s) (host-call (dom-document) "createTextNode" s)))
    (define
      create-fragment
      (fn () (host-call (dom-document) "createDocumentFragment")))
    (define
      create-comment
      (fn (text) (host-call (dom-document) "createComment" (or text ""))))
    (define
      dom-append
      (fn
        (parent child)
        (when (and parent child) (host-call parent "appendChild" child))))
    (define
      dom-prepend
      (fn
        (parent child)
        (when (and parent child) (host-call parent "prepend" child))))
    (define
      dom-insert-before
      (fn
        (parent child ref)
        (when (and parent child) (host-call parent "insertBefore" child ref))))
    (define
      dom-insert-after
      (fn
        (ref node)
        "Insert node after ref in the same parent."
        (let
          ((parent (host-get ref "parentNode"))
            (next (host-get ref "nextSibling")))
          (when
            parent
            (if
              next
              (host-call parent "insertBefore" node next)
              (host-call parent "appendChild" node))))))
    (define dom-remove (fn (el) (when el (host-call el "remove"))))
    (define
      dom-is-active-element?
      (fn
        (el)
        (let
          ((active (host-get (dom-document) "activeElement")))
          (if (and active el) (identical? el active) false))))
    (define
      dom-is-input-element?
      (fn
        (el)
        (let
          ((tag (upper (or (dom-tag-name el) ""))))
          (or (= tag "INPUT") (= tag "TEXTAREA") (= tag "SELECT")))))
    (define
      dom-is-child-of?
      (fn
        (child parent)
        (and child parent (host-call parent "contains" child))))
    (define
      dom-attr-list
      (fn
        (el)
        (let
          ((attrs (host-get el "attributes")) (result (list)))
          (when
            attrs
            (let
              ((n (host-get attrs "length")))
              (let
                loop
                ((i 0))
                (when
                  (< i n)
                  (let
                    ((attr (host-call attrs "item" i)))
                    (append!
                      result
                      (list (host-get attr "name") (host-get attr "value"))))
                  (loop (+ i 1))))))
          result)))
    (define
      dom-remove-child
      (fn
        (parent child)
        (when (and parent child) (host-call parent "removeChild" child))))
    (define
      dom-replace-child
      (fn
        (parent new-child old-child)
        (when
          (and parent new-child old-child)
          (host-call parent "replaceChild" new-child old-child))))
    (define
      dom-clone
      (fn
        (node deep)
        (host-call node "cloneNode" (if (nil? deep) true deep))))
    (define
      dom-query
      (fn
        (root-or-sel sel)
        (if
          (nil? sel)
          (host-call (dom-document) "querySelector" root-or-sel)
          (host-call root-or-sel "querySelector" sel))))
    (define
      dom-query-all
      (fn
        (root sel)
        "Query DOM and return an SX list (not a host NodeList)."
        (let
          ((node-list (if (nil? sel) (host-call (dom-document) "querySelectorAll" root) (host-call root "querySelectorAll" sel))))
          (if
            (nil? node-list)
            (list)
            (let
              ((n (host-get node-list "length")) (result (list)))
              (let
                loop
                ((i 0))
                (when
                  (< i n)
                  (append! result (host-call node-list "item" i))
                  (loop (+ i 1))))
              result)))))
    (define
      dom-query-by-id
      (fn (id) (host-call (dom-document) "getElementById" id)))
    (define
      dom-closest
      (fn (el sel) (when el (host-call el "closest" sel))))
    (define
      dom-matches?
      (fn
        (el sel)
        (if
          (and el (host-get el "matches"))
          (host-call el "matches" sel)
          false)))
    (define
      dom-get-attr
      (fn
        (el name)
        (if
          (and el (host-get el "getAttribute"))
          (let
            ((v (host-call el "getAttribute" name)))
            (if (nil? v) nil v))
          nil)))
    (define
      dom-set-attr
      (fn
        (el name val)
        (when
          (and el (host-get el "setAttribute"))
          (host-call el "setAttribute" name val))))
    (define
      dom-remove-attr
      (fn
        (el name)
        (when
          (and el (host-get el "removeAttribute"))
          (host-call el "removeAttribute" name))))
    (define
      dom-has-attr?
      (fn
        (el name)
        (if
          (and el (host-get el "hasAttribute"))
          (host-call el "hasAttribute" name)
          false)))
    (define
      dom-add-class
      (fn
        (el cls)
        (when el (host-call (host-get el "classList") "add" cls))))
    (define
      dom-remove-class
      (fn
        (el cls)
        (when el (host-call (host-get el "classList") "remove" cls))))
    (define
      dom-has-class?
      (fn
        (el cls)
        (if el (host-call (host-get el "classList") "contains" cls) false)))
    (define dom-text-content (fn (el) (host-get el "textContent")))
    (define
      dom-set-text-content
      (fn (el val) (host-set! el "textContent" val)))
    (define dom-inner-html (fn (el) (host-get el "innerHTML")))
    (define dom-set-inner-html (fn (el val) (host-set! el "innerHTML" val)))
    (define dom-outer-html (fn (el) (host-get el "outerHTML")))
    (define
      dom-insert-adjacent-html
      (fn
        (el position html)
        (host-call el "insertAdjacentHTML" position html)))
    (define
      dom-get-style
      (fn (el prop) (host-get (host-get el "style") prop)))
    (define
      dom-set-style
      (fn
        (el prop val)
        (host-call (host-get el "style") "setProperty" prop val)))
    (define dom-get-prop (fn (el name) (host-get el name)))
    (define dom-set-prop (fn (el name val) (host-set! el name val)))
    (define
      dom-tag-name
      (fn (el) (if el (lower (or (host-get el "tagName") "")) "")))
    (define dom-node-type (fn (el) (host-get el "nodeType")))
    (define dom-node-name (fn (el) (host-get el "nodeName")))
    (define dom-id (fn (el) (host-get el "id")))
    (define dom-parent (fn (el) (host-get el "parentNode")))
    (define dom-first-child (fn (el) (host-get el "firstChild")))
    (define dom-next-sibling (fn (el) (host-get el "nextSibling")))
    (define
      dom-child-list
      (fn
        (el)
        "Return child nodes as an SX list."
        (if
          el
          (let
            ((nl (host-get el "childNodes"))
              (n (host-get nl "length"))
              (result (list)))
            (let
              loop
              ((i 0))
              (when
                (< i n)
                (append! result (host-call nl "item" i))
                (loop (+ i 1))))
            result)
          (list))))
    (define dom-is-fragment? (fn (el) (= (host-get el "nodeType") 11)))
    (define
      dom-child-nodes
      (fn
        (el)
        "Return child nodes as an SX list."
        (if
          el
          (let
            ((nl (host-get el "childNodes"))
              (n (host-get nl "length"))
              (result (list)))
            (let
              loop
              ((i 0))
              (when
                (< i n)
                (append! result (host-call nl "item" i))
                (loop (+ i 1))))
            result)
          (list))))
    (define
      dom-remove-children-after
      (fn
        (marker)
        "Remove all siblings after marker node."
        (let
          ((parent (dom-parent marker)))
          (when
            parent
            (let
              loop
              ()
              (let
                ((next (dom-next-sibling marker)))
                (when next (host-call parent "removeChild" next) (loop))))))))
    (define dom-focus (fn (el) (when el (host-call el "focus"))))
    (define
      dom-parse-html
      (fn
        (html)
        (let
          ((parser (host-new "DOMParser"))
            (doc (host-call parser "parseFromString" html "text/html")))
          (host-get (host-get doc "body") "childNodes"))))
    (define
      dom-listen
      (fn
        (el event-name handler)
        (let
          ((cb (host-callback handler)))
          (host-call el "addEventListener" event-name cb)
          (fn () (host-call el "removeEventListener" event-name cb)))))
    (define
      dom-add-listener
      (fn
        (el event-name handler opts)
        (let
          ((cb (host-callback handler)))
          (if
            opts
            (host-call el "addEventListener" event-name cb opts)
            (host-call el "addEventListener" event-name cb))
          (fn () (host-call el "removeEventListener" event-name cb)))))
    (define
      dom-dispatch
      (fn
        (el event-name detail)
        (let
          ((evt (host-new "CustomEvent" event-name (dict "detail" detail "bubbles" true))))
          (host-call el "dispatchEvent" evt))))
    (define event-detail (fn (evt) (host-get evt "detail")))
    (define
      prevent-default
      (fn (e) (when e (host-call e "preventDefault"))))
    (define
      stop-propagation
      (fn (e) (when e (host-call e "stopPropagation"))))
    (define
      event-modifier-key?
      (fn
        (e)
        (and
          e
          (or
            (host-get e "ctrlKey")
            (host-get e "metaKey")
            (host-get e "shiftKey")
            (host-get e "altKey")))))
    (define
      element-value
      (fn
        (el)
        (if
          (and el (not (nil? (host-get el "value"))))
          (host-get el "value")
          nil)))
    (define
      error-message
      (fn
        (e)
        (if (and e (host-get e "message")) (host-get e "message") (str e))))
    (define
      dom-get-data
      (fn
        (el key)
        (let
          ((store (host-get el "__sx_data")))
          (if store (host-get store key) nil))))
    (define
      dom-set-data
      (fn
        (el key val)
        (when
          (not (host-get el "__sx_data"))
          (host-set! el "__sx_data" (dict)))
        (host-set! (host-get el "__sx_data") key val)))
    (define
      dom-append-to-head
      (fn (el) (when (dom-head) (host-call (dom-head) "appendChild" el))))
    (define
      set-document-title
      (fn (title) (host-set! (dom-document) "title" title)))))

;; Re-export to global env
(define
  dom-visible?
  (fn
    (el)
    (if
      el
      (not (= (host-get (host-get el "style") "display") "none"))
      false)))

(import (sx dom))
