module Data.DOM.MutationEvent
       (initMutationEvent, cMODIFICATION, cADDITION, cREMOVAL,
        get'relatedNode, getm'relatedNode, get'prevValue, getm'prevValue,
        get'newValue, getm'newValue, get'attrName, getm'attrName,
        get'attrChange, getm'attrChange)
       where
import Data.DOM.Events
import Control.Monad
import BrownPLT.JavaScript
import Data.DOM.WBTypes
import Data.DOM.Views
import Data.DOM.Dom
import Data.DOM.Document (createElement)
 
initMutationEvent ::
                  (Monad mn, CMutationEvent this, CNode relatedNodeArg) =>
                    Expression String ->
                      Expression Bool ->
                        Expression Bool ->
                          Expression relatedNodeArg ->
                            Expression String ->
                              Expression String ->
                                Expression String ->
                                  Expression Double -> Expression this -> mn (Expression ())
initMutationEvent a b c d e f g h thisp
  = do let et = undefined :: ()
       let r = DotRef et (thisp /\ et) (Id et "initMutationEvent")
       return
         (CallExpr et r
            [a /\ et, b /\ et, c /\ et, d /\ et, e /\ et, f /\ et, g /\ et,
             h /\ et])
cMODIFICATION = 1
cADDITION = 2
cREMOVAL = 3
 
get'relatedNode ::
                (Monad mn, CMutationEvent this, CNode zz) =>
                  Expression this -> mn (Expression zz)
get'relatedNode thisp
  = do let et = undefined :: zz
       let r = DotRef et (thisp /\ et) (Id et "relatedNode")
       return r
 
getm'relatedNode ::
                 (Monad mn, CMutationEvent this) =>
                   Expression this -> mn (Expression TNode)
getm'relatedNode = get'relatedNode
 
get'prevValue ::
              (Monad mn, CMutationEvent this) =>
                Expression this -> mn (Expression String)
get'prevValue thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "prevValue")
       return r
 
getm'prevValue ::
               (Monad mn, CMutationEvent this) =>
                 Expression this -> mn (Expression String)
getm'prevValue = get'prevValue
 
get'newValue ::
             (Monad mn, CMutationEvent this) =>
               Expression this -> mn (Expression String)
get'newValue thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "newValue")
       return r
 
getm'newValue ::
              (Monad mn, CMutationEvent this) =>
                Expression this -> mn (Expression String)
getm'newValue = get'newValue
 
get'attrName ::
             (Monad mn, CMutationEvent this) =>
               Expression this -> mn (Expression String)
get'attrName thisp
  = do let et = undefined :: String
       let r = DotRef et (thisp /\ et) (Id et "attrName")
       return r
 
getm'attrName ::
              (Monad mn, CMutationEvent this) =>
                Expression this -> mn (Expression String)
getm'attrName = get'attrName
 
get'attrChange ::
               (Monad mn, CMutationEvent this) =>
                 Expression this -> mn (Expression Double)
get'attrChange thisp
  = do let et = undefined :: Double
       let r = DotRef et (thisp /\ et) (Id et "attrChange")
       return r
 
getm'attrChange ::
                (Monad mn, CMutationEvent this) =>
                  Expression this -> mn (Expression Double)
getm'attrChange = get'attrChange