{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.WebKit.Objects.DOMHTMLScriptElement
    ( 

-- * Exported types
    DOMHTMLScriptElement(..)                ,
    DOMHTMLScriptElementK                   ,
    toDOMHTMLScriptElement                  ,
    noDOMHTMLScriptElement                  ,


 -- * Methods
-- ** dOMHTMLScriptElementGetAsync
    dOMHTMLScriptElementGetAsync            ,


-- ** dOMHTMLScriptElementGetCharset
    dOMHTMLScriptElementGetCharset          ,


-- ** dOMHTMLScriptElementGetCrossOrigin
    dOMHTMLScriptElementGetCrossOrigin      ,


-- ** dOMHTMLScriptElementGetDefer
    dOMHTMLScriptElementGetDefer            ,


-- ** dOMHTMLScriptElementGetEvent
    dOMHTMLScriptElementGetEvent            ,


-- ** dOMHTMLScriptElementGetHtmlFor
    dOMHTMLScriptElementGetHtmlFor          ,


-- ** dOMHTMLScriptElementGetNonce
    dOMHTMLScriptElementGetNonce            ,


-- ** dOMHTMLScriptElementGetSrc
    dOMHTMLScriptElementGetSrc              ,


-- ** dOMHTMLScriptElementGetText
    dOMHTMLScriptElementGetText             ,


-- ** dOMHTMLScriptElementSetAsync
    dOMHTMLScriptElementSetAsync            ,


-- ** dOMHTMLScriptElementSetCharset
    dOMHTMLScriptElementSetCharset          ,


-- ** dOMHTMLScriptElementSetCrossOrigin
    dOMHTMLScriptElementSetCrossOrigin      ,


-- ** dOMHTMLScriptElementSetDefer
    dOMHTMLScriptElementSetDefer            ,


-- ** dOMHTMLScriptElementSetEvent
    dOMHTMLScriptElementSetEvent            ,


-- ** dOMHTMLScriptElementSetHtmlFor
    dOMHTMLScriptElementSetHtmlFor          ,


-- ** dOMHTMLScriptElementSetNonce
    dOMHTMLScriptElementSetNonce            ,


-- ** dOMHTMLScriptElementSetSrc
    dOMHTMLScriptElementSetSrc              ,


-- ** dOMHTMLScriptElementSetText
    dOMHTMLScriptElementSetText             ,




 -- * Properties
-- ** Async
    DOMHTMLScriptElementAsyncPropertyInfo   ,
    constructDOMHTMLScriptElementAsync      ,
    getDOMHTMLScriptElementAsync            ,
    setDOMHTMLScriptElementAsync            ,


-- ** Charset
    DOMHTMLScriptElementCharsetPropertyInfo ,
    constructDOMHTMLScriptElementCharset    ,
    getDOMHTMLScriptElementCharset          ,
    setDOMHTMLScriptElementCharset          ,


-- ** CrossOrigin
    DOMHTMLScriptElementCrossOriginPropertyInfo,
    constructDOMHTMLScriptElementCrossOrigin,
    getDOMHTMLScriptElementCrossOrigin      ,
    setDOMHTMLScriptElementCrossOrigin      ,


-- ** Defer
    DOMHTMLScriptElementDeferPropertyInfo   ,
    constructDOMHTMLScriptElementDefer      ,
    getDOMHTMLScriptElementDefer            ,
    setDOMHTMLScriptElementDefer            ,


-- ** Event
    DOMHTMLScriptElementEventPropertyInfo   ,
    constructDOMHTMLScriptElementEvent      ,
    getDOMHTMLScriptElementEvent            ,
    setDOMHTMLScriptElementEvent            ,


-- ** HtmlFor
    DOMHTMLScriptElementHtmlForPropertyInfo ,
    constructDOMHTMLScriptElementHtmlFor    ,
    getDOMHTMLScriptElementHtmlFor          ,
    setDOMHTMLScriptElementHtmlFor          ,


-- ** Nonce
    DOMHTMLScriptElementNoncePropertyInfo   ,
    constructDOMHTMLScriptElementNonce      ,
    getDOMHTMLScriptElementNonce            ,
    setDOMHTMLScriptElementNonce            ,


-- ** Src
    DOMHTMLScriptElementSrcPropertyInfo     ,
    constructDOMHTMLScriptElementSrc        ,
    getDOMHTMLScriptElementSrc              ,
    setDOMHTMLScriptElementSrc              ,


-- ** Text
    DOMHTMLScriptElementTextPropertyInfo    ,
    constructDOMHTMLScriptElementText       ,
    getDOMHTMLScriptElementText             ,
    setDOMHTMLScriptElementText             ,


-- ** Type
    DOMHTMLScriptElementTypePropertyInfo    ,
    constructDOMHTMLScriptElementType       ,
    getDOMHTMLScriptElementType             ,
    setDOMHTMLScriptElementType             ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.WebKit.Types
import GI.WebKit.Callbacks
import qualified GI.GObject as GObject

newtype DOMHTMLScriptElement = DOMHTMLScriptElement (ForeignPtr DOMHTMLScriptElement)
foreign import ccall "webkit_dom_html_script_element_get_type"
    c_webkit_dom_html_script_element_get_type :: IO GType

type instance ParentTypes DOMHTMLScriptElement = DOMHTMLScriptElementParentTypes
type DOMHTMLScriptElementParentTypes = '[DOMHTMLElement, DOMElement, DOMNode, DOMObject, GObject.Object, DOMEventTarget]

instance GObject DOMHTMLScriptElement where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_webkit_dom_html_script_element_get_type
    

class GObject o => DOMHTMLScriptElementK o
instance (GObject o, IsDescendantOf DOMHTMLScriptElement o) => DOMHTMLScriptElementK o

toDOMHTMLScriptElement :: DOMHTMLScriptElementK o => o -> IO DOMHTMLScriptElement
toDOMHTMLScriptElement = unsafeCastTo DOMHTMLScriptElement

noDOMHTMLScriptElement :: Maybe DOMHTMLScriptElement
noDOMHTMLScriptElement = Nothing

-- VVV Prop "async"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementAsync :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m Bool
getDOMHTMLScriptElementAsync obj = liftIO $ getObjectPropertyBool obj "async"

setDOMHTMLScriptElementAsync :: (MonadIO m, DOMHTMLScriptElementK o) => o -> Bool -> m ()
setDOMHTMLScriptElementAsync obj val = liftIO $ setObjectPropertyBool obj "async" val

constructDOMHTMLScriptElementAsync :: Bool -> IO ([Char], GValue)
constructDOMHTMLScriptElementAsync val = constructObjectPropertyBool "async" val

data DOMHTMLScriptElementAsyncPropertyInfo
instance AttrInfo DOMHTMLScriptElementAsyncPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementAsyncPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementAsyncPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLScriptElementAsyncPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementAsyncPropertyInfo = Bool
    type AttrLabel DOMHTMLScriptElementAsyncPropertyInfo = "DOMHTMLScriptElement::async"
    attrGet _ = getDOMHTMLScriptElementAsync
    attrSet _ = setDOMHTMLScriptElementAsync
    attrConstruct _ = constructDOMHTMLScriptElementAsync

-- VVV Prop "charset"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementCharset :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementCharset obj = liftIO $ getObjectPropertyString obj "charset"

setDOMHTMLScriptElementCharset :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementCharset obj val = liftIO $ setObjectPropertyString obj "charset" val

constructDOMHTMLScriptElementCharset :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementCharset val = constructObjectPropertyString "charset" val

data DOMHTMLScriptElementCharsetPropertyInfo
instance AttrInfo DOMHTMLScriptElementCharsetPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementCharsetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementCharsetPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementCharsetPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementCharsetPropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementCharsetPropertyInfo = "DOMHTMLScriptElement::charset"
    attrGet _ = getDOMHTMLScriptElementCharset
    attrSet _ = setDOMHTMLScriptElementCharset
    attrConstruct _ = constructDOMHTMLScriptElementCharset

-- VVV Prop "cross-origin"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementCrossOrigin :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementCrossOrigin obj = liftIO $ getObjectPropertyString obj "cross-origin"

setDOMHTMLScriptElementCrossOrigin :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementCrossOrigin obj val = liftIO $ setObjectPropertyString obj "cross-origin" val

constructDOMHTMLScriptElementCrossOrigin :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementCrossOrigin val = constructObjectPropertyString "cross-origin" val

data DOMHTMLScriptElementCrossOriginPropertyInfo
instance AttrInfo DOMHTMLScriptElementCrossOriginPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementCrossOriginPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementCrossOriginPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementCrossOriginPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementCrossOriginPropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementCrossOriginPropertyInfo = "DOMHTMLScriptElement::cross-origin"
    attrGet _ = getDOMHTMLScriptElementCrossOrigin
    attrSet _ = setDOMHTMLScriptElementCrossOrigin
    attrConstruct _ = constructDOMHTMLScriptElementCrossOrigin

-- VVV Prop "defer"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementDefer :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m Bool
getDOMHTMLScriptElementDefer obj = liftIO $ getObjectPropertyBool obj "defer"

setDOMHTMLScriptElementDefer :: (MonadIO m, DOMHTMLScriptElementK o) => o -> Bool -> m ()
setDOMHTMLScriptElementDefer obj val = liftIO $ setObjectPropertyBool obj "defer" val

constructDOMHTMLScriptElementDefer :: Bool -> IO ([Char], GValue)
constructDOMHTMLScriptElementDefer val = constructObjectPropertyBool "defer" val

data DOMHTMLScriptElementDeferPropertyInfo
instance AttrInfo DOMHTMLScriptElementDeferPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementDeferPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementDeferPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLScriptElementDeferPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementDeferPropertyInfo = Bool
    type AttrLabel DOMHTMLScriptElementDeferPropertyInfo = "DOMHTMLScriptElement::defer"
    attrGet _ = getDOMHTMLScriptElementDefer
    attrSet _ = setDOMHTMLScriptElementDefer
    attrConstruct _ = constructDOMHTMLScriptElementDefer

-- VVV Prop "event"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementEvent :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementEvent obj = liftIO $ getObjectPropertyString obj "event"

setDOMHTMLScriptElementEvent :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementEvent obj val = liftIO $ setObjectPropertyString obj "event" val

constructDOMHTMLScriptElementEvent :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementEvent val = constructObjectPropertyString "event" val

data DOMHTMLScriptElementEventPropertyInfo
instance AttrInfo DOMHTMLScriptElementEventPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementEventPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementEventPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementEventPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementEventPropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementEventPropertyInfo = "DOMHTMLScriptElement::event"
    attrGet _ = getDOMHTMLScriptElementEvent
    attrSet _ = setDOMHTMLScriptElementEvent
    attrConstruct _ = constructDOMHTMLScriptElementEvent

-- VVV Prop "html-for"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementHtmlFor :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementHtmlFor obj = liftIO $ getObjectPropertyString obj "html-for"

setDOMHTMLScriptElementHtmlFor :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementHtmlFor obj val = liftIO $ setObjectPropertyString obj "html-for" val

constructDOMHTMLScriptElementHtmlFor :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementHtmlFor val = constructObjectPropertyString "html-for" val

data DOMHTMLScriptElementHtmlForPropertyInfo
instance AttrInfo DOMHTMLScriptElementHtmlForPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementHtmlForPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementHtmlForPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementHtmlForPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementHtmlForPropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementHtmlForPropertyInfo = "DOMHTMLScriptElement::html-for"
    attrGet _ = getDOMHTMLScriptElementHtmlFor
    attrSet _ = setDOMHTMLScriptElementHtmlFor
    attrConstruct _ = constructDOMHTMLScriptElementHtmlFor

-- VVV Prop "nonce"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementNonce :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementNonce obj = liftIO $ getObjectPropertyString obj "nonce"

setDOMHTMLScriptElementNonce :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementNonce obj val = liftIO $ setObjectPropertyString obj "nonce" val

constructDOMHTMLScriptElementNonce :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementNonce val = constructObjectPropertyString "nonce" val

data DOMHTMLScriptElementNoncePropertyInfo
instance AttrInfo DOMHTMLScriptElementNoncePropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementNoncePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementNoncePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementNoncePropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementNoncePropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementNoncePropertyInfo = "DOMHTMLScriptElement::nonce"
    attrGet _ = getDOMHTMLScriptElementNonce
    attrSet _ = setDOMHTMLScriptElementNonce
    attrConstruct _ = constructDOMHTMLScriptElementNonce

-- VVV Prop "src"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementSrc :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementSrc obj = liftIO $ getObjectPropertyString obj "src"

setDOMHTMLScriptElementSrc :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementSrc obj val = liftIO $ setObjectPropertyString obj "src" val

constructDOMHTMLScriptElementSrc :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementSrc val = constructObjectPropertyString "src" val

data DOMHTMLScriptElementSrcPropertyInfo
instance AttrInfo DOMHTMLScriptElementSrcPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementSrcPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementSrcPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementSrcPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementSrcPropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementSrcPropertyInfo = "DOMHTMLScriptElement::src"
    attrGet _ = getDOMHTMLScriptElementSrc
    attrSet _ = setDOMHTMLScriptElementSrc
    attrConstruct _ = constructDOMHTMLScriptElementSrc

-- VVV Prop "text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementText :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementText obj = liftIO $ getObjectPropertyString obj "text"

setDOMHTMLScriptElementText :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementText obj val = liftIO $ setObjectPropertyString obj "text" val

constructDOMHTMLScriptElementText :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementText val = constructObjectPropertyString "text" val

data DOMHTMLScriptElementTextPropertyInfo
instance AttrInfo DOMHTMLScriptElementTextPropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementTextPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementTextPropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementTextPropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementTextPropertyInfo = "DOMHTMLScriptElement::text"
    attrGet _ = getDOMHTMLScriptElementText
    attrSet _ = setDOMHTMLScriptElementText
    attrConstruct _ = constructDOMHTMLScriptElementText

-- VVV Prop "type"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLScriptElementType :: (MonadIO m, DOMHTMLScriptElementK o) => o -> m T.Text
getDOMHTMLScriptElementType obj = liftIO $ getObjectPropertyString obj "type"

setDOMHTMLScriptElementType :: (MonadIO m, DOMHTMLScriptElementK o) => o -> T.Text -> m ()
setDOMHTMLScriptElementType obj val = liftIO $ setObjectPropertyString obj "type" val

constructDOMHTMLScriptElementType :: T.Text -> IO ([Char], GValue)
constructDOMHTMLScriptElementType val = constructObjectPropertyString "type" val

data DOMHTMLScriptElementTypePropertyInfo
instance AttrInfo DOMHTMLScriptElementTypePropertyInfo where
    type AttrAllowedOps DOMHTMLScriptElementTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLScriptElementTypePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLScriptElementTypePropertyInfo = DOMHTMLScriptElementK
    type AttrGetType DOMHTMLScriptElementTypePropertyInfo = T.Text
    type AttrLabel DOMHTMLScriptElementTypePropertyInfo = "DOMHTMLScriptElement::type"
    attrGet _ = getDOMHTMLScriptElementType
    attrSet _ = setDOMHTMLScriptElementType
    attrConstruct _ = constructDOMHTMLScriptElementType

type instance AttributeList DOMHTMLScriptElement = DOMHTMLScriptElementAttributeList
type DOMHTMLScriptElementAttributeList = ('[ '("access-key", DOMHTMLElementAccessKeyPropertyInfo), '("async", DOMHTMLScriptElementAsyncPropertyInfo), '("attributes", DOMElementAttributesPropertyInfo), '("base-uri", DOMNodeBaseUriPropertyInfo), '("charset", DOMHTMLScriptElementCharsetPropertyInfo), '("child-element-count", DOMElementChildElementCountPropertyInfo), '("child-nodes", DOMNodeChildNodesPropertyInfo), '("children", DOMHTMLElementChildrenPropertyInfo), '("class-list", DOMElementClassListPropertyInfo), '("class-name", DOMElementClassNamePropertyInfo), '("client-height", DOMElementClientHeightPropertyInfo), '("client-left", DOMElementClientLeftPropertyInfo), '("client-top", DOMElementClientTopPropertyInfo), '("client-width", DOMElementClientWidthPropertyInfo), '("content-editable", DOMHTMLElementContentEditablePropertyInfo), '("core-object", DOMObjectCoreObjectPropertyInfo), '("cross-origin", DOMHTMLScriptElementCrossOriginPropertyInfo), '("defer", DOMHTMLScriptElementDeferPropertyInfo), '("dir", DOMHTMLElementDirPropertyInfo), '("draggable", DOMHTMLElementDraggablePropertyInfo), '("event", DOMHTMLScriptElementEventPropertyInfo), '("first-child", DOMNodeFirstChildPropertyInfo), '("first-element-child", DOMElementFirstElementChildPropertyInfo), '("hidden", DOMHTMLElementHiddenPropertyInfo), '("html-for", DOMHTMLScriptElementHtmlForPropertyInfo), '("id", DOMElementIdPropertyInfo), '("inner-html", DOMHTMLElementInnerHtmlPropertyInfo), '("inner-text", DOMHTMLElementInnerTextPropertyInfo), '("is-content-editable", DOMHTMLElementIsContentEditablePropertyInfo), '("lang", DOMHTMLElementLangPropertyInfo), '("last-child", DOMNodeLastChildPropertyInfo), '("last-element-child", DOMElementLastElementChildPropertyInfo), '("local-name", DOMNodeLocalNamePropertyInfo), '("namespace-uri", DOMNodeNamespaceUriPropertyInfo), '("next-element-sibling", DOMElementNextElementSiblingPropertyInfo), '("next-sibling", DOMNodeNextSiblingPropertyInfo), '("node-name", DOMNodeNodeNamePropertyInfo), '("node-type", DOMNodeNodeTypePropertyInfo), '("node-value", DOMNodeNodeValuePropertyInfo), '("nonce", DOMHTMLScriptElementNoncePropertyInfo), '("offset-height", DOMElementOffsetHeightPropertyInfo), '("offset-left", DOMElementOffsetLeftPropertyInfo), '("offset-parent", DOMElementOffsetParentPropertyInfo), '("offset-top", DOMElementOffsetTopPropertyInfo), '("offset-width", DOMElementOffsetWidthPropertyInfo), '("outer-html", DOMHTMLElementOuterHtmlPropertyInfo), '("outer-text", DOMHTMLElementOuterTextPropertyInfo), '("owner-document", DOMNodeOwnerDocumentPropertyInfo), '("parent-element", DOMNodeParentElementPropertyInfo), '("parent-node", DOMNodeParentNodePropertyInfo), '("prefix", DOMNodePrefixPropertyInfo), '("previous-element-sibling", DOMElementPreviousElementSiblingPropertyInfo), '("previous-sibling", DOMNodePreviousSiblingPropertyInfo), '("scroll-height", DOMElementScrollHeightPropertyInfo), '("scroll-left", DOMElementScrollLeftPropertyInfo), '("scroll-top", DOMElementScrollTopPropertyInfo), '("scroll-width", DOMElementScrollWidthPropertyInfo), '("spellcheck", DOMHTMLElementSpellcheckPropertyInfo), '("src", DOMHTMLScriptElementSrcPropertyInfo), '("style", DOMElementStylePropertyInfo), '("tab-index", DOMHTMLElementTabIndexPropertyInfo), '("tag-name", DOMElementTagNamePropertyInfo), '("text", DOMHTMLScriptElementTextPropertyInfo), '("text-content", DOMNodeTextContentPropertyInfo), '("title", DOMHTMLElementTitlePropertyInfo), '("translate", DOMHTMLElementTranslatePropertyInfo), '("type", DOMHTMLScriptElementTypePropertyInfo), '("webkit-region-overset", DOMElementWebkitRegionOversetPropertyInfo), '("webkitdropzone", DOMHTMLElementWebkitdropzonePropertyInfo)] :: [(Symbol, *)])

type instance SignalList DOMHTMLScriptElement = DOMHTMLScriptElementSignalList
type DOMHTMLScriptElementSignalList = ('[ '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method DOMHTMLScriptElement::get_async
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_async" webkit_dom_html_script_element_get_async :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CInt


dOMHTMLScriptElementGetAsync ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m Bool
dOMHTMLScriptElementGetAsync _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_async _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_charset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_charset" webkit_dom_html_script_element_get_charset :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetCharset ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetCharset _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_charset _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_charset" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_cross_origin
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_cross_origin" webkit_dom_html_script_element_get_cross_origin :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetCrossOrigin ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetCrossOrigin _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_cross_origin _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_cross_origin" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_defer
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_defer" webkit_dom_html_script_element_get_defer :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CInt


dOMHTMLScriptElementGetDefer ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m Bool
dOMHTMLScriptElementGetDefer _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_defer _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_event
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_event" webkit_dom_html_script_element_get_event :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetEvent ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetEvent _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_event _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_event" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_html_for
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_html_for" webkit_dom_html_script_element_get_html_for :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetHtmlFor ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetHtmlFor _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_html_for _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_html_for" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_nonce
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_nonce" webkit_dom_html_script_element_get_nonce :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetNonce ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetNonce _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_nonce _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_nonce" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_src
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_src" webkit_dom_html_script_element_get_src :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetSrc ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetSrc _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_src _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_src" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::get_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_get_text" webkit_dom_html_script_element_get_text :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    IO CString


dOMHTMLScriptElementGetText ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    m T.Text
dOMHTMLScriptElementGetText _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_script_element_get_text _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_script_element_get_text" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLScriptElement::set_async
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_async" webkit_dom_html_script_element_set_async :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


dOMHTMLScriptElementSetAsync ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- value
    m ()
dOMHTMLScriptElementSetAsync _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let value' = (fromIntegral . fromEnum) value
    webkit_dom_html_script_element_set_async _obj' value'
    touchManagedPtr _obj
    return ()

-- method DOMHTMLScriptElement::set_charset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_charset" webkit_dom_html_script_element_set_charset :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetCharset ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetCharset _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_charset _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()

-- method DOMHTMLScriptElement::set_cross_origin
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_cross_origin" webkit_dom_html_script_element_set_cross_origin :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetCrossOrigin ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetCrossOrigin _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_cross_origin _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()

-- method DOMHTMLScriptElement::set_defer
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_defer" webkit_dom_html_script_element_set_defer :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


dOMHTMLScriptElementSetDefer ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- value
    m ()
dOMHTMLScriptElementSetDefer _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let value' = (fromIntegral . fromEnum) value
    webkit_dom_html_script_element_set_defer _obj' value'
    touchManagedPtr _obj
    return ()

-- method DOMHTMLScriptElement::set_event
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_event" webkit_dom_html_script_element_set_event :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetEvent ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetEvent _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_event _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()

-- method DOMHTMLScriptElement::set_html_for
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_html_for" webkit_dom_html_script_element_set_html_for :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetHtmlFor ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetHtmlFor _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_html_for _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()

-- method DOMHTMLScriptElement::set_nonce
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_nonce" webkit_dom_html_script_element_set_nonce :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetNonce ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetNonce _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_nonce _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()

-- method DOMHTMLScriptElement::set_src
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_src" webkit_dom_html_script_element_set_src :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetSrc ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetSrc _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_src _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()

-- method DOMHTMLScriptElement::set_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLScriptElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_html_script_element_set_text" webkit_dom_html_script_element_set_text :: 
    Ptr DOMHTMLScriptElement ->             -- _obj : TInterface "WebKit" "DOMHTMLScriptElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


dOMHTMLScriptElementSetText ::
    (MonadIO m, DOMHTMLScriptElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- value
    m ()
dOMHTMLScriptElementSetText _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    value' <- textToCString value
    webkit_dom_html_script_element_set_text _obj' value'
    touchManagedPtr _obj
    freeMem value'
    return ()