module Data.DOM.HTMLParamElement
       (set'name, get'name, getm'name, set'type, get'type, getm'type,
        set'value, get'value, getm'value, set'valueType, get'valueType,
        getm'valueType, mkParam)
       where
import Data.DOM.Html2
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Dom
import Data.DOM.Document (createElement)
 
set'name ::
         (Monad mn, CHTMLParamElement zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'name = setjsProperty "name"
 
get'name ::
         (Monad mn, CHTMLParamElement 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, CHTMLParamElement this) =>
            Expression this -> mn (Expression String)
getm'name = get'name
 
set'type ::
         (Monad mn, CHTMLParamElement zz) =>
           Expression String -> Expression zz -> mn (Expression zz)
set'type = setjsProperty "type"
 
get'type ::
         (Monad mn, CHTMLParamElement this) =>
           Expression this -> mn (Expression String)
get'type thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "type")
       return r
 
getm'type ::
          (Monad mn, CHTMLParamElement this) =>
            Expression this -> mn (Expression String)
getm'type = get'type
 
set'value ::
          (Monad mn, CHTMLParamElement zz) =>
            Expression String -> Expression zz -> mn (Expression zz)
set'value = setjsProperty "value"
 
get'value ::
          (Monad mn, CHTMLParamElement this) =>
            Expression this -> mn (Expression String)
get'value thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "value")
       return r
 
getm'value ::
           (Monad mn, CHTMLParamElement this) =>
             Expression this -> mn (Expression String)
getm'value = get'value
 
set'valueType ::
              (Monad mn, CHTMLParamElement zz) =>
                Expression String -> Expression zz -> mn (Expression zz)
set'valueType = setjsProperty "valueType"
 
get'valueType ::
              (Monad mn, CHTMLParamElement this) =>
                Expression this -> mn (Expression String)
get'valueType thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "valueType")
       return r
 
getm'valueType ::
               (Monad mn, CHTMLParamElement this) =>
                 Expression this -> mn (Expression String)
getm'valueType = get'valueType
 
mkParam ::
        (Monad mn, CHTMLDocument a) =>
          Expression a -> mn (Expression THTMLParamElement)
mkParam = createElement (StringLit "param" "param")