module Data.DOM.CSSStyleDeclaration
       (getPropertyValue, getPropertyCSSValue, removeProperty,
        getPropertyPriority, setProperty, item, set'cssText, get'cssText,
        getm'cssText, get'length, getm'length, get'parentRule,
        getm'parentRule)
       where
import Data.DOM.Css
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Views
import Data.DOM.Stylesheets
import Data.DOM.Dom
import Data.DOM.Document (createElement)
 
getPropertyValue ::
                 (Monad mn, CCSSStyleDeclaration this) =>
                   Expression String -> Expression this -> mn (Expression String)
getPropertyValue a thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "getPropertyValue")
       return (CallExpr et r [a /\ et])
 
getPropertyCSSValue ::
                    (Monad mn, CCSSStyleDeclaration this, CCSSValue zz) =>
                      Expression String -> Expression this -> mn (Expression zz)
getPropertyCSSValue a thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "getPropertyCSSValue")
       return (CallExpr et r [a /\ et])
 
removeProperty ::
               (Monad mn, CCSSStyleDeclaration this) =>
                 Expression String -> Expression this -> mn (Expression String)
removeProperty a thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "removeProperty")
       return (CallExpr et r [a /\ et])
 
getPropertyPriority ::
                    (Monad mn, CCSSStyleDeclaration this) =>
                      Expression String -> Expression this -> mn (Expression String)
getPropertyPriority a thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "getPropertyPriority")
       return (CallExpr et r [a /\ et])
 
setProperty ::
            (Monad mn, CCSSStyleDeclaration this) =>
              Expression String ->
                Expression String ->
                  Expression String -> Expression this -> mn (Expression ())
setProperty a b c thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "setProperty")
       return (CallExpr et r [a /\ et, b /\ et, c /\ et])
 
item ::
     (Monad mn, CCSSStyleDeclaration this) =>
       Expression Double -> Expression this -> mn (Expression String)
item a thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "item")
       return (CallExpr et r [a /\ et])
 
set'cssText ::
            (Monad mn, CCSSStyleDeclaration zz) =>
              Expression String -> Expression zz -> mn (Expression zz)
set'cssText = setjsProperty "cssText"
 
get'cssText ::
            (Monad mn, CCSSStyleDeclaration this) =>
              Expression this -> mn (Expression String)
get'cssText thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "cssText")
       return r
 
getm'cssText ::
             (Monad mn, CCSSStyleDeclaration this) =>
               Expression this -> mn (Expression String)
getm'cssText = get'cssText
 
get'length ::
           (Monad mn, CCSSStyleDeclaration this) =>
             Expression this -> mn (Expression Double)
get'length thisp
  = do let et = undefined :: Double
       let r = DotRef et (thisp /\ et) (Id et "length")
       return r
 
getm'length ::
            (Monad mn, CCSSStyleDeclaration this) =>
              Expression this -> mn (Expression Double)
getm'length = get'length
 
get'parentRule ::
               (Monad mn, CCSSStyleDeclaration this, CCSSRule zz) =>
                 Expression this -> mn (Expression zz)
get'parentRule thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "parentRule")
       return r
 
getm'parentRule ::
                (Monad mn, CCSSStyleDeclaration this) =>
                  Expression this -> mn (Expression TCSSRule)
getm'parentRule = get'parentRule