module Data.DOM.HTMLDocument
       (open, close, write, writeln, getElementsByName, set'title,
        get'title, getm'title, get'referrer, getm'referrer, get'domain,
        getm'domain, get'URL, getm'URL, set'body, get'body, getm'body,
        get'images, getm'images, get'applets, getm'applets, get'links,
        getm'links, get'forms, getm'forms, get'anchors, getm'anchors,
        set'cookie, get'cookie, getm'cookie)
       where
import Data.DOM.Html2
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Dom
import Data.DOM.Document (createElement)
 
open ::
     (Monad mn, CHTMLDocument this) =>
       Expression this -> mn (Expression ())
open thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "open")
       return (CallExpr et r [])
 
close ::
      (Monad mn, CHTMLDocument this) =>
        Expression this -> mn (Expression ())
close thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "close")
       return (CallExpr et r [])
 
write ::
      (Monad mn, CHTMLDocument this) =>
        Expression String -> Expression this -> mn (Expression ())
write a thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "write")
       return (CallExpr et r [a /\ et])
 
writeln ::
        (Monad mn, CHTMLDocument this) =>
          Expression String -> Expression this -> mn (Expression ())
writeln a thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "writeln")
       return (CallExpr et r [a /\ et])
 
getElementsByName ::
                  (Monad mn, CHTMLDocument this, CNodeList zz) =>
                    Expression String -> Expression this -> mn (Expression zz)
getElementsByName a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "getElementsByName")
       return (CallExpr et r [a /\ et])
 
set'title ::
          (Monad mn, CHTMLDocument zz) =>
            Expression String -> Expression zz -> mn (Expression zz)
set'title = setjsProperty "title"
 
get'title ::
          (Monad mn, CHTMLDocument this) =>
            Expression this -> mn (Expression String)
get'title thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "title")
       return r
 
getm'title ::
           (Monad mn, CHTMLDocument this) =>
             Expression this -> mn (Expression String)
getm'title = get'title
 
get'referrer ::
             (Monad mn, CHTMLDocument this) =>
               Expression this -> mn (Expression String)
get'referrer thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "referrer")
       return r
 
getm'referrer ::
              (Monad mn, CHTMLDocument this) =>
                Expression this -> mn (Expression String)
getm'referrer = get'referrer
 
get'domain ::
           (Monad mn, CHTMLDocument this) =>
             Expression this -> mn (Expression String)
get'domain thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "domain")
       return r
 
getm'domain ::
            (Monad mn, CHTMLDocument this) =>
              Expression this -> mn (Expression String)
getm'domain = get'domain
 
get'URL ::
        (Monad mn, CHTMLDocument this) =>
          Expression this -> mn (Expression String)
get'URL thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "URL")
       return r
 
getm'URL ::
         (Monad mn, CHTMLDocument this) =>
           Expression this -> mn (Expression String)
getm'URL = get'URL
 
set'body ::
         (Monad mn, CHTMLElement val, CHTMLDocument zz) =>
           Expression val -> Expression zz -> mn (Expression zz)
set'body = setjsProperty "body"
 
get'body ::
         (Monad mn, CHTMLDocument this, CHTMLElement zz) =>
           Expression this -> mn (Expression zz)
get'body thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "body")
       return r
 
getm'body ::
          (Monad mn, CHTMLDocument this) =>
            Expression this -> mn (Expression THTMLElement)
getm'body = get'body
 
get'images ::
           (Monad mn, CHTMLDocument this, CHTMLCollection zz) =>
             Expression this -> mn (Expression zz)
get'images thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "images")
       return r
 
getm'images ::
            (Monad mn, CHTMLDocument this) =>
              Expression this -> mn (Expression THTMLCollection)
getm'images = get'images
 
get'applets ::
            (Monad mn, CHTMLDocument this, CHTMLCollection zz) =>
              Expression this -> mn (Expression zz)
get'applets thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "applets")
       return r
 
getm'applets ::
             (Monad mn, CHTMLDocument this) =>
               Expression this -> mn (Expression THTMLCollection)
getm'applets = get'applets
 
get'links ::
          (Monad mn, CHTMLDocument this, CHTMLCollection zz) =>
            Expression this -> mn (Expression zz)
get'links thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "links")
       return r
 
getm'links ::
           (Monad mn, CHTMLDocument this) =>
             Expression this -> mn (Expression THTMLCollection)
getm'links = get'links
 
get'forms ::
          (Monad mn, CHTMLDocument this, CHTMLCollection zz) =>
            Expression this -> mn (Expression zz)
get'forms thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "forms")
       return r
 
getm'forms ::
           (Monad mn, CHTMLDocument this) =>
             Expression this -> mn (Expression THTMLCollection)
getm'forms = get'forms
 
get'anchors ::
            (Monad mn, CHTMLDocument this, CHTMLCollection zz) =>
              Expression this -> mn (Expression zz)
get'anchors thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "anchors")
       return r
 
getm'anchors ::
             (Monad mn, CHTMLDocument this) =>
               Expression this -> mn (Expression THTMLCollection)
getm'anchors = get'anchors
 
set'cookie ::
           (Monad mn, CHTMLDocument zz) =>
             Expression String -> Expression zz -> mn (Expression zz)
set'cookie = setjsProperty "cookie"
 
get'cookie ::
           (Monad mn, CHTMLDocument this) =>
             Expression this -> mn (Expression String)
get'cookie thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "cookie")
       return r
 
getm'cookie ::
            (Monad mn, CHTMLDocument this) =>
              Expression this -> mn (Expression String)
getm'cookie = get'cookie