{-# LANGUAGE CPP #-}

module Web.DOM.Internal.Types where

import Data.Foreign (Foreign)
import HPrelude
import Unsafe.Coerce (unsafeCoerce)

#if defined(javascript_HOST_ARCH)
import GHC.JS.Prim
import GHC.JS.Foreign.Callback
#endif

newtype Node = Node (Foreign Node)

newtype NodeList = NodeList (Foreign NodeList)

newtype Element = Element (Foreign Element)

newtype HTMLElement = HTMLElement (Foreign HTMLElement)

newtype HTMLCollection = HTMLCollection (Foreign HTMLCollection)

#if defined(javascript_HOST_ARCH)
newtype EventListener = EventListener (Callback (JSVal -> IO ()))
#else
newtype EventListener = EventListener (Foreign EventListener)
#endif

newtype Document = Document (Foreign Document)

newtype HTMLDocument = HTMLDocument (Foreign HTMLDocument)

newtype Window = Window (Foreign Window)

fromElement :: Element -> Maybe HTMLElement
fromElement :: Element -> Maybe HTMLElement
fromElement = HTMLElement -> Maybe HTMLElement
forall a. a -> Maybe a
Just (HTMLElement -> Maybe HTMLElement)
-> (Element -> HTMLElement) -> Element -> Maybe HTMLElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> HTMLElement
forall a b. Coercible a b => a -> b
coerce

toDocument :: a -> Document
toDocument :: forall a. a -> Document
toDocument = a -> Document
forall a b. a -> b
unsafeCoerce

toNode :: a -> Node
toNode :: forall a. a -> Node
toNode = a -> Node
forall a b. a -> b
unsafeCoerce