module Data.DOM.Document
       (createElement, createDocumentFragment, createTextNode,
        createComment, createCDATASection, createProcessingInstruction,
        createAttribute, createEntityReference, getElementsByTagName,
        importNode, createElementNS, createAttributeNS,
        getElementsByTagNameNS, getElementById, get'doctype, getm'doctype,
        get'implementation, getm'implementation, get'documentElement,
        getm'documentElement)
       where
import Data.DOM.Dom
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
 
createElement ::
              (Monad mn, CDocument this, CElement zz) =>
                Expression String -> Expression this -> mn (Expression zz)
createElement a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createElement")
       return (CallExpr et r [a /\ et])
 
createDocumentFragment ::
                       (Monad mn, CDocument this, CDocumentFragment zz) =>
                         Expression this -> mn (Expression zz)
createDocumentFragment thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createDocumentFragment")
       return (CallExpr et r [])
 
createTextNode ::
               (Monad mn, CDocument this, CText zz) =>
                 Expression String -> Expression this -> mn (Expression zz)
createTextNode a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createTextNode")
       return (CallExpr et r [a /\ et])
 
createComment ::
              (Monad mn, CDocument this, CComment zz) =>
                Expression String -> Expression this -> mn (Expression zz)
createComment a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createComment")
       return (CallExpr et r [a /\ et])
 
createCDATASection ::
                   (Monad mn, CDocument this, CCDATASection zz) =>
                     Expression String -> Expression this -> mn (Expression zz)
createCDATASection a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createCDATASection")
       return (CallExpr et r [a /\ et])
 
createProcessingInstruction ::
                            (Monad mn, CDocument this, CProcessingInstruction zz) =>
                              Expression String ->
                                Expression String -> Expression this -> mn (Expression zz)
createProcessingInstruction a b thisp
  = do let et = undefined :: zz
       let r
             = DotRef et (thisp /\ et) (Id et "createProcessingInstruction")
       return (CallExpr et r [a /\ et, b /\ et])
 
createAttribute ::
                (Monad mn, CDocument this, CAttr zz) =>
                  Expression String -> Expression this -> mn (Expression zz)
createAttribute a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createAttribute")
       return (CallExpr et r [a /\ et])
 
createEntityReference ::
                      (Monad mn, CDocument this, CEntityReference zz) =>
                        Expression String -> Expression this -> mn (Expression zz)
createEntityReference a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createEntityReference")
       return (CallExpr et r [a /\ et])
 
getElementsByTagName ::
                     (Monad mn, CDocument this, CNodeList zz) =>
                       Expression String -> Expression this -> mn (Expression zz)
getElementsByTagName a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "getElementsByTagName")
       return (CallExpr et r [a /\ et])
 
importNode ::
           (Monad mn, CDocument this, CNode importedNode, CNode zz) =>
             Expression importedNode ->
               Expression Bool -> Expression this -> mn (Expression zz)
importNode a b thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "importNode")
       return (CallExpr et r [a /\ et, b /\ et])
 
createElementNS ::
                (Monad mn, CDocument this, CElement zz) =>
                  Expression String ->
                    Expression String -> Expression this -> mn (Expression zz)
createElementNS a b thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createElementNS")
       return (CallExpr et r [a /\ et, b /\ et])
 
createAttributeNS ::
                  (Monad mn, CDocument this, CAttr zz) =>
                    Expression String ->
                      Expression String -> Expression this -> mn (Expression zz)
createAttributeNS a b thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "createAttributeNS")
       return (CallExpr et r [a /\ et, b /\ et])
 
getElementsByTagNameNS ::
                       (Monad mn, CDocument this, CNodeList zz) =>
                         Expression String ->
                           Expression String -> Expression this -> mn (Expression zz)
getElementsByTagNameNS a b thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "getElementsByTagNameNS")
       return (CallExpr et r [a /\ et, b /\ et])
 
getElementById ::
               (Monad mn, CDocument this, CElement zz) =>
                 Expression String -> Expression this -> mn (Expression zz)
getElementById a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "getElementById")
       return (CallExpr et r [a /\ et])
 
get'doctype ::
            (Monad mn, CDocument this, CDocumentType zz) =>
              Expression this -> mn (Expression zz)
get'doctype thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "doctype")
       return r
 
getm'doctype ::
             (Monad mn, CDocument this) =>
               Expression this -> mn (Expression TDocumentType)
getm'doctype = get'doctype
 
get'implementation ::
                   (Monad mn, CDocument this, CDOMImplementation zz) =>
                     Expression this -> mn (Expression zz)
get'implementation thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "implementation")
       return r
 
getm'implementation ::
                    (Monad mn, CDocument this) =>
                      Expression this -> mn (Expression TDOMImplementation)
getm'implementation = get'implementation
 
get'documentElement ::
                    (Monad mn, CDocument this, CElement zz) =>
                      Expression this -> mn (Expression zz)
get'documentElement thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "documentElement")
       return r
 
getm'documentElement ::
                     (Monad mn, CDocument this) =>
                       Expression this -> mn (Expression TElement)
getm'documentElement = get'documentElement