module Data.DOM.DOMImplementation
       (hasFeature, createDocumentType, createDocument) where
import Data.DOM.Dom
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Document (createElement)
 
hasFeature ::
           (Monad mn, CDOMImplementation this) =>
             Expression String ->
               Expression String -> Expression this -> mn (Expression Bool)
hasFeature a b thisp
  = do let et = undefined :: Bool
       let r = DotRef et (thisp /\ et) (Id et "hasFeature")
       return (CallExpr et r [a /\ et, b /\ et])
 
createDocumentType ::
                   (Monad mn, CDOMImplementation this, CDocumentType zz) =>
                     Expression String ->
                       Expression String ->
                         Expression String -> Expression this -> mn (Expression zz)
createDocumentType a b c thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createDocumentType")
       return (CallExpr et r [a /\ et, b /\ et, c /\ et])
 
createDocument ::
               (Monad mn, CDOMImplementation this, CDocumentType doctype,
                CDocument zz) =>
                 Expression String ->
                   Expression String ->
                     Expression doctype -> Expression this -> mn (Expression zz)
createDocument a b c thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createDocument")
       return (CallExpr et r [a /\ et, b /\ et, c /\ et])