module Data.DOM.Window
       (setTimeout, clearTimeout, setInterval, clearInterval, get'window,
        getm'window, get'self, getm'self, get'location, getm'location,
        set'name, get'name, getm'name, get'parent, getm'parent, get'top,
        getm'top, get'frameElement, getm'frameElement)
       where
import Data.DOM.WindowObj
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Views
import Data.DOM.Dom
import Data.DOM.Document (createElement)
 
setTimeout ::
           (Monad mn, CWindow this, CTimerListener listener) =>
             Expression listener ->
               Expression Double -> Expression this -> mn (Expression Double)
setTimeout a b thisp
  = do let et = undefined :: Double
       let r = DotRef et (thisp /\ et) (Id et "setTimeout")
       return (CallExpr et r [a /\ et, b /\ et])
 
clearTimeout ::
             (Monad mn, CWindow this) =>
               Expression Double -> Expression this -> mn (Expression ())
clearTimeout a thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "clearTimeout")
       return (CallExpr et r [a /\ et])
 
setInterval ::
            (Monad mn, CWindow this, CTimerListener listener) =>
              Expression listener ->
                Expression Double -> Expression this -> mn (Expression Double)
setInterval a b thisp
  = do let et = undefined :: Double
       let r = DotRef et (thisp /\ et) (Id et "setInterval")
       return (CallExpr et r [a /\ et, b /\ et])
 
clearInterval ::
              (Monad mn, CWindow this) =>
                Expression Double -> Expression this -> mn (Expression ())
clearInterval a thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "clearInterval")
       return (CallExpr et r [a /\ et])
 
get'window ::
           (Monad mn, CWindow this, CWindow zz) =>
             Expression this -> mn (Expression zz)
get'window thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "window")
       return r
 
getm'window ::
            (Monad mn, CWindow this) =>
              Expression this -> mn (Expression TWindow)
getm'window = get'window
 
get'self ::
         (Monad mn, CWindow this, CWindow zz) =>
           Expression this -> mn (Expression zz)
get'self thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "self")
       return r
 
getm'self ::
          (Monad mn, CWindow this) =>
            Expression this -> mn (Expression TWindow)
getm'self = get'self
 
get'location ::
             (Monad mn, CWindow this, CLocation zz) =>
               Expression this -> mn (Expression zz)
get'location thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "location")
       return r
 
getm'location ::
              (Monad mn, CWindow this) =>
                Expression this -> mn (Expression TLocation)
getm'location = get'location
 
set'name ::
         (Monad mn, CWindow zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'name = setjsProperty "name"
 
get'name ::
         (Monad mn, CWindow this) =>
           Expression this -> mn (Expression String)
get'name thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "name")
       return r
 
getm'name ::
          (Monad mn, CWindow this) =>
            Expression this -> mn (Expression String)
getm'name = get'name
 
get'parent ::
           (Monad mn, CWindow this, CWindow zz) =>
             Expression this -> mn (Expression zz)
get'parent thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "parent")
       return r
 
getm'parent ::
            (Monad mn, CWindow this) =>
              Expression this -> mn (Expression TWindow)
getm'parent = get'parent
 
get'top ::
        (Monad mn, CWindow this, CWindow zz) =>
          Expression this -> mn (Expression zz)
get'top thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "top")
       return r
 
getm'top ::
         (Monad mn, CWindow this) =>
           Expression this -> mn (Expression TWindow)
getm'top = get'top
 
get'frameElement ::
                 (Monad mn, CWindow this, CElement zz) =>
                   Expression this -> mn (Expression zz)
get'frameElement thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "frameElement")
       return r
 
getm'frameElement ::
                  (Monad mn, CWindow this) =>
                    Expression this -> mn (Expression TElement)
getm'frameElement = get'frameElement