module Data.DOM.Location
       (assign, replace, reload, toString, set'href, get'href, getm'href,
        set'hash, get'hash, getm'hash, set'host, get'host, getm'host,
        set'hostname, get'hostname, getm'hostname, set'pathname,
        get'pathname, getm'pathname, set'port, get'port, getm'port,
        set'protocol, get'protocol, getm'protocol, set'search, get'search,
        getm'search)
       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)
 
assign ::
       (Monad mn, CLocation this) =>
         Expression String -> Expression this -> mn (Expression ())
assign a thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "assign")
       return (CallExpr et r [a /\ et])
 
replace ::
        (Monad mn, CLocation this) =>
          Expression String -> Expression this -> mn (Expression ())
replace a thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "replace")
       return (CallExpr et r [a /\ et])
 
reload ::
       (Monad mn, CLocation this) => Expression this -> mn (Expression ())
reload thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "reload")
       return (CallExpr et r [])
 
toString ::
         (Monad mn, CLocation this) =>
           Expression this -> mn (Expression String)
toString thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "toString")
       return (CallExpr et r [])
 
set'href ::
         (Monad mn, CLocation zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'href = setjsProperty "href"
 
get'href ::
         (Monad mn, CLocation this) =>
           Expression this -> mn (Expression String)
get'href thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "href")
       return r
 
getm'href ::
          (Monad mn, CLocation this) =>
            Expression this -> mn (Expression String)
getm'href = get'href
 
set'hash ::
         (Monad mn, CLocation zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'hash = setjsProperty "hash"
 
get'hash ::
         (Monad mn, CLocation this) =>
           Expression this -> mn (Expression String)
get'hash thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "hash")
       return r
 
getm'hash ::
          (Monad mn, CLocation this) =>
            Expression this -> mn (Expression String)
getm'hash = get'hash
 
set'host ::
         (Monad mn, CLocation zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'host = setjsProperty "host"
 
get'host ::
         (Monad mn, CLocation this) =>
           Expression this -> mn (Expression String)
get'host thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "host")
       return r
 
getm'host ::
          (Monad mn, CLocation this) =>
            Expression this -> mn (Expression String)
getm'host = get'host
 
set'hostname ::
             (Monad mn, CLocation zz) =>
               Expression String -> Expression zz -> mn (Expression zz)
set'hostname = setjsProperty "hostname"
 
get'hostname ::
             (Monad mn, CLocation this) =>
               Expression this -> mn (Expression String)
get'hostname thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "hostname")
       return r
 
getm'hostname ::
              (Monad mn, CLocation this) =>
                Expression this -> mn (Expression String)
getm'hostname = get'hostname
 
set'pathname ::
             (Monad mn, CLocation zz) =>
               Expression String -> Expression zz -> mn (Expression zz)
set'pathname = setjsProperty "pathname"
 
get'pathname ::
             (Monad mn, CLocation this) =>
               Expression this -> mn (Expression String)
get'pathname thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "pathname")
       return r
 
getm'pathname ::
              (Monad mn, CLocation this) =>
                Expression this -> mn (Expression String)
getm'pathname = get'pathname
 
set'port ::
         (Monad mn, CLocation zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'port = setjsProperty "port"
 
get'port ::
         (Monad mn, CLocation this) =>
           Expression this -> mn (Expression String)
get'port thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "port")
       return r
 
getm'port ::
          (Monad mn, CLocation this) =>
            Expression this -> mn (Expression String)
getm'port = get'port
 
set'protocol ::
             (Monad mn, CLocation zz) =>
               Expression String -> Expression zz -> mn (Expression zz)
set'protocol = setjsProperty "protocol"
 
get'protocol ::
             (Monad mn, CLocation this) =>
               Expression this -> mn (Expression String)
get'protocol thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "protocol")
       return r
 
getm'protocol ::
              (Monad mn, CLocation this) =>
                Expression this -> mn (Expression String)
getm'protocol = get'protocol
 
set'search ::
           (Monad mn, CLocation zz) =>
             Expression String -> Expression zz -> mn (Expression zz)
set'search = setjsProperty "search"
 
get'search ::
           (Monad mn, CLocation this) =>
             Expression this -> mn (Expression String)
get'search thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "search")
       return r
 
getm'search ::
            (Monad mn, CLocation this) =>
              Expression this -> mn (Expression String)
getm'search = get'search