{- |
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.DOMHTMLTextAreaElement
    ( 

-- * Exported types
    DOMHTMLTextAreaElement(..)              ,
    DOMHTMLTextAreaElementK                 ,
    toDOMHTMLTextAreaElement                ,
    noDOMHTMLTextAreaElement                ,


 -- * Methods
-- ** dOMHTMLTextAreaElementCheckValidity
    dOMHTMLTextAreaElementCheckValidity     ,


-- ** dOMHTMLTextAreaElementGetAutocapitalize
    dOMHTMLTextAreaElementGetAutocapitalize ,


-- ** dOMHTMLTextAreaElementGetAutocorrect
    dOMHTMLTextAreaElementGetAutocorrect    ,


-- ** dOMHTMLTextAreaElementGetAutofocus
    dOMHTMLTextAreaElementGetAutofocus      ,


-- ** dOMHTMLTextAreaElementGetCols
    dOMHTMLTextAreaElementGetCols           ,


-- ** dOMHTMLTextAreaElementGetDefaultValue
    dOMHTMLTextAreaElementGetDefaultValue   ,


-- ** dOMHTMLTextAreaElementGetDirName
    dOMHTMLTextAreaElementGetDirName        ,


-- ** dOMHTMLTextAreaElementGetDisabled
    dOMHTMLTextAreaElementGetDisabled       ,


-- ** dOMHTMLTextAreaElementGetForm
    dOMHTMLTextAreaElementGetForm           ,


-- ** dOMHTMLTextAreaElementGetLabels
    dOMHTMLTextAreaElementGetLabels         ,


-- ** dOMHTMLTextAreaElementGetMaxLength
    dOMHTMLTextAreaElementGetMaxLength      ,


-- ** dOMHTMLTextAreaElementGetName
    dOMHTMLTextAreaElementGetName           ,


-- ** dOMHTMLTextAreaElementGetPlaceholder
    dOMHTMLTextAreaElementGetPlaceholder    ,


-- ** dOMHTMLTextAreaElementGetReadOnly
    dOMHTMLTextAreaElementGetReadOnly       ,


-- ** dOMHTMLTextAreaElementGetRequired
    dOMHTMLTextAreaElementGetRequired       ,


-- ** dOMHTMLTextAreaElementGetRows
    dOMHTMLTextAreaElementGetRows           ,


-- ** dOMHTMLTextAreaElementGetSelectionDirection
    dOMHTMLTextAreaElementGetSelectionDirection,


-- ** dOMHTMLTextAreaElementGetSelectionEnd
    dOMHTMLTextAreaElementGetSelectionEnd   ,


-- ** dOMHTMLTextAreaElementGetSelectionStart
    dOMHTMLTextAreaElementGetSelectionStart ,


-- ** dOMHTMLTextAreaElementGetTextLength
    dOMHTMLTextAreaElementGetTextLength     ,


-- ** dOMHTMLTextAreaElementGetValidationMessage
    dOMHTMLTextAreaElementGetValidationMessage,


-- ** dOMHTMLTextAreaElementGetValidity
    dOMHTMLTextAreaElementGetValidity       ,


-- ** dOMHTMLTextAreaElementGetValue
    dOMHTMLTextAreaElementGetValue          ,


-- ** dOMHTMLTextAreaElementGetWillValidate
    dOMHTMLTextAreaElementGetWillValidate   ,


-- ** dOMHTMLTextAreaElementGetWrap
    dOMHTMLTextAreaElementGetWrap           ,


-- ** dOMHTMLTextAreaElementIsEdited
    dOMHTMLTextAreaElementIsEdited          ,


-- ** dOMHTMLTextAreaElementSelect
    dOMHTMLTextAreaElementSelect            ,


-- ** dOMHTMLTextAreaElementSetAutocapitalize
    dOMHTMLTextAreaElementSetAutocapitalize ,


-- ** dOMHTMLTextAreaElementSetAutocorrect
    dOMHTMLTextAreaElementSetAutocorrect    ,


-- ** dOMHTMLTextAreaElementSetAutofocus
    dOMHTMLTextAreaElementSetAutofocus      ,


-- ** dOMHTMLTextAreaElementSetCols
    dOMHTMLTextAreaElementSetCols           ,


-- ** dOMHTMLTextAreaElementSetCustomValidity
    dOMHTMLTextAreaElementSetCustomValidity ,


-- ** dOMHTMLTextAreaElementSetDefaultValue
    dOMHTMLTextAreaElementSetDefaultValue   ,


-- ** dOMHTMLTextAreaElementSetDirName
    dOMHTMLTextAreaElementSetDirName        ,


-- ** dOMHTMLTextAreaElementSetDisabled
    dOMHTMLTextAreaElementSetDisabled       ,


-- ** dOMHTMLTextAreaElementSetMaxLength
    dOMHTMLTextAreaElementSetMaxLength      ,


-- ** dOMHTMLTextAreaElementSetName
    dOMHTMLTextAreaElementSetName           ,


-- ** dOMHTMLTextAreaElementSetPlaceholder
    dOMHTMLTextAreaElementSetPlaceholder    ,


-- ** dOMHTMLTextAreaElementSetRangeText
    dOMHTMLTextAreaElementSetRangeText      ,


-- ** dOMHTMLTextAreaElementSetReadOnly
    dOMHTMLTextAreaElementSetReadOnly       ,


-- ** dOMHTMLTextAreaElementSetRequired
    dOMHTMLTextAreaElementSetRequired       ,


-- ** dOMHTMLTextAreaElementSetRows
    dOMHTMLTextAreaElementSetRows           ,


-- ** dOMHTMLTextAreaElementSetSelectionDirection
    dOMHTMLTextAreaElementSetSelectionDirection,


-- ** dOMHTMLTextAreaElementSetSelectionEnd
    dOMHTMLTextAreaElementSetSelectionEnd   ,


-- ** dOMHTMLTextAreaElementSetSelectionRange
    dOMHTMLTextAreaElementSetSelectionRange ,


-- ** dOMHTMLTextAreaElementSetSelectionStart
    dOMHTMLTextAreaElementSetSelectionStart ,


-- ** dOMHTMLTextAreaElementSetValue
    dOMHTMLTextAreaElementSetValue          ,


-- ** dOMHTMLTextAreaElementSetWrap
    dOMHTMLTextAreaElementSetWrap           ,




 -- * Properties
-- ** Autocapitalize
    DOMHTMLTextAreaElementAutocapitalizePropertyInfo,
    constructDOMHTMLTextAreaElementAutocapitalize,
    getDOMHTMLTextAreaElementAutocapitalize ,
    setDOMHTMLTextAreaElementAutocapitalize ,


-- ** Autocorrect
    DOMHTMLTextAreaElementAutocorrectPropertyInfo,
    constructDOMHTMLTextAreaElementAutocorrect,
    getDOMHTMLTextAreaElementAutocorrect    ,
    setDOMHTMLTextAreaElementAutocorrect    ,


-- ** Autofocus
    DOMHTMLTextAreaElementAutofocusPropertyInfo,
    constructDOMHTMLTextAreaElementAutofocus,
    getDOMHTMLTextAreaElementAutofocus      ,
    setDOMHTMLTextAreaElementAutofocus      ,


-- ** Cols
    DOMHTMLTextAreaElementColsPropertyInfo  ,
    constructDOMHTMLTextAreaElementCols     ,
    getDOMHTMLTextAreaElementCols           ,
    setDOMHTMLTextAreaElementCols           ,


-- ** DefaultValue
    DOMHTMLTextAreaElementDefaultValuePropertyInfo,
    constructDOMHTMLTextAreaElementDefaultValue,
    getDOMHTMLTextAreaElementDefaultValue   ,
    setDOMHTMLTextAreaElementDefaultValue   ,


-- ** DirName
    DOMHTMLTextAreaElementDirNamePropertyInfo,
    constructDOMHTMLTextAreaElementDirName  ,
    getDOMHTMLTextAreaElementDirName        ,
    setDOMHTMLTextAreaElementDirName        ,


-- ** Disabled
    DOMHTMLTextAreaElementDisabledPropertyInfo,
    constructDOMHTMLTextAreaElementDisabled ,
    getDOMHTMLTextAreaElementDisabled       ,
    setDOMHTMLTextAreaElementDisabled       ,


-- ** Form
    DOMHTMLTextAreaElementFormPropertyInfo  ,
    getDOMHTMLTextAreaElementForm           ,


-- ** Labels
    DOMHTMLTextAreaElementLabelsPropertyInfo,
    getDOMHTMLTextAreaElementLabels         ,


-- ** MaxLength
    DOMHTMLTextAreaElementMaxLengthPropertyInfo,
    constructDOMHTMLTextAreaElementMaxLength,
    getDOMHTMLTextAreaElementMaxLength      ,
    setDOMHTMLTextAreaElementMaxLength      ,


-- ** Name
    DOMHTMLTextAreaElementNamePropertyInfo  ,
    constructDOMHTMLTextAreaElementName     ,
    getDOMHTMLTextAreaElementName           ,
    setDOMHTMLTextAreaElementName           ,


-- ** Placeholder
    DOMHTMLTextAreaElementPlaceholderPropertyInfo,
    constructDOMHTMLTextAreaElementPlaceholder,
    getDOMHTMLTextAreaElementPlaceholder    ,
    setDOMHTMLTextAreaElementPlaceholder    ,


-- ** ReadOnly
    DOMHTMLTextAreaElementReadOnlyPropertyInfo,
    constructDOMHTMLTextAreaElementReadOnly ,
    getDOMHTMLTextAreaElementReadOnly       ,
    setDOMHTMLTextAreaElementReadOnly       ,


-- ** Required
    DOMHTMLTextAreaElementRequiredPropertyInfo,
    constructDOMHTMLTextAreaElementRequired ,
    getDOMHTMLTextAreaElementRequired       ,
    setDOMHTMLTextAreaElementRequired       ,


-- ** Rows
    DOMHTMLTextAreaElementRowsPropertyInfo  ,
    constructDOMHTMLTextAreaElementRows     ,
    getDOMHTMLTextAreaElementRows           ,
    setDOMHTMLTextAreaElementRows           ,


-- ** SelectionDirection
    DOMHTMLTextAreaElementSelectionDirectionPropertyInfo,
    constructDOMHTMLTextAreaElementSelectionDirection,
    getDOMHTMLTextAreaElementSelectionDirection,
    setDOMHTMLTextAreaElementSelectionDirection,


-- ** SelectionEnd
    DOMHTMLTextAreaElementSelectionEndPropertyInfo,
    constructDOMHTMLTextAreaElementSelectionEnd,
    getDOMHTMLTextAreaElementSelectionEnd   ,
    setDOMHTMLTextAreaElementSelectionEnd   ,


-- ** SelectionStart
    DOMHTMLTextAreaElementSelectionStartPropertyInfo,
    constructDOMHTMLTextAreaElementSelectionStart,
    getDOMHTMLTextAreaElementSelectionStart ,
    setDOMHTMLTextAreaElementSelectionStart ,


-- ** TextLength
    DOMHTMLTextAreaElementTextLengthPropertyInfo,
    getDOMHTMLTextAreaElementTextLength     ,


-- ** Type
    DOMHTMLTextAreaElementTypePropertyInfo  ,
    getDOMHTMLTextAreaElementType           ,


-- ** ValidationMessage
    DOMHTMLTextAreaElementValidationMessagePropertyInfo,
    getDOMHTMLTextAreaElementValidationMessage,


-- ** Validity
    DOMHTMLTextAreaElementValidityPropertyInfo,
    getDOMHTMLTextAreaElementValidity       ,


-- ** Value
    DOMHTMLTextAreaElementValuePropertyInfo ,
    constructDOMHTMLTextAreaElementValue    ,
    getDOMHTMLTextAreaElementValue          ,
    setDOMHTMLTextAreaElementValue          ,


-- ** WillValidate
    DOMHTMLTextAreaElementWillValidatePropertyInfo,
    getDOMHTMLTextAreaElementWillValidate   ,


-- ** Wrap
    DOMHTMLTextAreaElementWrapPropertyInfo  ,
    constructDOMHTMLTextAreaElementWrap     ,
    getDOMHTMLTextAreaElementWrap           ,
    setDOMHTMLTextAreaElementWrap           ,




    ) 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 DOMHTMLTextAreaElement = DOMHTMLTextAreaElement (ForeignPtr DOMHTMLTextAreaElement)
foreign import ccall "webkit_dom_html_text_area_element_get_type"
    c_webkit_dom_html_text_area_element_get_type :: IO GType

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

instance GObject DOMHTMLTextAreaElement where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_webkit_dom_html_text_area_element_get_type
    

class GObject o => DOMHTMLTextAreaElementK o
instance (GObject o, IsDescendantOf DOMHTMLTextAreaElement o) => DOMHTMLTextAreaElementK o

toDOMHTMLTextAreaElement :: DOMHTMLTextAreaElementK o => o -> IO DOMHTMLTextAreaElement
toDOMHTMLTextAreaElement = unsafeCastTo DOMHTMLTextAreaElement

noDOMHTMLTextAreaElement :: Maybe DOMHTMLTextAreaElement
noDOMHTMLTextAreaElement = Nothing

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

getDOMHTMLTextAreaElementAutocapitalize :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementAutocapitalize obj = liftIO $ getObjectPropertyString obj "autocapitalize"

setDOMHTMLTextAreaElementAutocapitalize :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementAutocapitalize obj val = liftIO $ setObjectPropertyString obj "autocapitalize" val

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

data DOMHTMLTextAreaElementAutocapitalizePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementAutocapitalizePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementAutocapitalizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementAutocapitalizePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementAutocapitalizePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementAutocapitalizePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementAutocapitalizePropertyInfo = "DOMHTMLTextAreaElement::autocapitalize"
    attrGet _ = getDOMHTMLTextAreaElementAutocapitalize
    attrSet _ = setDOMHTMLTextAreaElementAutocapitalize
    attrConstruct _ = constructDOMHTMLTextAreaElementAutocapitalize

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

getDOMHTMLTextAreaElementAutocorrect :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Bool
getDOMHTMLTextAreaElementAutocorrect obj = liftIO $ getObjectPropertyBool obj "autocorrect"

setDOMHTMLTextAreaElementAutocorrect :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Bool -> m ()
setDOMHTMLTextAreaElementAutocorrect obj val = liftIO $ setObjectPropertyBool obj "autocorrect" val

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

data DOMHTMLTextAreaElementAutocorrectPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementAutocorrectPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementAutocorrectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementAutocorrectPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementAutocorrectPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementAutocorrectPropertyInfo = Bool
    type AttrLabel DOMHTMLTextAreaElementAutocorrectPropertyInfo = "DOMHTMLTextAreaElement::autocorrect"
    attrGet _ = getDOMHTMLTextAreaElementAutocorrect
    attrSet _ = setDOMHTMLTextAreaElementAutocorrect
    attrConstruct _ = constructDOMHTMLTextAreaElementAutocorrect

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

getDOMHTMLTextAreaElementAutofocus :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Bool
getDOMHTMLTextAreaElementAutofocus obj = liftIO $ getObjectPropertyBool obj "autofocus"

setDOMHTMLTextAreaElementAutofocus :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Bool -> m ()
setDOMHTMLTextAreaElementAutofocus obj val = liftIO $ setObjectPropertyBool obj "autofocus" val

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

data DOMHTMLTextAreaElementAutofocusPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementAutofocusPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementAutofocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementAutofocusPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementAutofocusPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementAutofocusPropertyInfo = Bool
    type AttrLabel DOMHTMLTextAreaElementAutofocusPropertyInfo = "DOMHTMLTextAreaElement::autofocus"
    attrGet _ = getDOMHTMLTextAreaElementAutofocus
    attrSet _ = setDOMHTMLTextAreaElementAutofocus
    attrConstruct _ = constructDOMHTMLTextAreaElementAutofocus

-- VVV Prop "cols"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLTextAreaElementCols :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Int64
getDOMHTMLTextAreaElementCols obj = liftIO $ getObjectPropertyInt64 obj "cols"

setDOMHTMLTextAreaElementCols :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Int64 -> m ()
setDOMHTMLTextAreaElementCols obj val = liftIO $ setObjectPropertyInt64 obj "cols" val

constructDOMHTMLTextAreaElementCols :: Int64 -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementCols val = constructObjectPropertyInt64 "cols" val

data DOMHTMLTextAreaElementColsPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementColsPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementColsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementColsPropertyInfo = (~) Int64
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementColsPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementColsPropertyInfo = Int64
    type AttrLabel DOMHTMLTextAreaElementColsPropertyInfo = "DOMHTMLTextAreaElement::cols"
    attrGet _ = getDOMHTMLTextAreaElementCols
    attrSet _ = setDOMHTMLTextAreaElementCols
    attrConstruct _ = constructDOMHTMLTextAreaElementCols

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

getDOMHTMLTextAreaElementDefaultValue :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementDefaultValue obj = liftIO $ getObjectPropertyString obj "default-value"

setDOMHTMLTextAreaElementDefaultValue :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementDefaultValue obj val = liftIO $ setObjectPropertyString obj "default-value" val

constructDOMHTMLTextAreaElementDefaultValue :: T.Text -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementDefaultValue val = constructObjectPropertyString "default-value" val

data DOMHTMLTextAreaElementDefaultValuePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementDefaultValuePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementDefaultValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementDefaultValuePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementDefaultValuePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementDefaultValuePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementDefaultValuePropertyInfo = "DOMHTMLTextAreaElement::default-value"
    attrGet _ = getDOMHTMLTextAreaElementDefaultValue
    attrSet _ = setDOMHTMLTextAreaElementDefaultValue
    attrConstruct _ = constructDOMHTMLTextAreaElementDefaultValue

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

getDOMHTMLTextAreaElementDirName :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementDirName obj = liftIO $ getObjectPropertyString obj "dir-name"

setDOMHTMLTextAreaElementDirName :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementDirName obj val = liftIO $ setObjectPropertyString obj "dir-name" val

constructDOMHTMLTextAreaElementDirName :: T.Text -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementDirName val = constructObjectPropertyString "dir-name" val

data DOMHTMLTextAreaElementDirNamePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementDirNamePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementDirNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementDirNamePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementDirNamePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementDirNamePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementDirNamePropertyInfo = "DOMHTMLTextAreaElement::dir-name"
    attrGet _ = getDOMHTMLTextAreaElementDirName
    attrSet _ = setDOMHTMLTextAreaElementDirName
    attrConstruct _ = constructDOMHTMLTextAreaElementDirName

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

getDOMHTMLTextAreaElementDisabled :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Bool
getDOMHTMLTextAreaElementDisabled obj = liftIO $ getObjectPropertyBool obj "disabled"

setDOMHTMLTextAreaElementDisabled :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Bool -> m ()
setDOMHTMLTextAreaElementDisabled obj val = liftIO $ setObjectPropertyBool obj "disabled" val

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

data DOMHTMLTextAreaElementDisabledPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementDisabledPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementDisabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementDisabledPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementDisabledPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementDisabledPropertyInfo = Bool
    type AttrLabel DOMHTMLTextAreaElementDisabledPropertyInfo = "DOMHTMLTextAreaElement::disabled"
    attrGet _ = getDOMHTMLTextAreaElementDisabled
    attrSet _ = setDOMHTMLTextAreaElementDisabled
    attrConstruct _ = constructDOMHTMLTextAreaElementDisabled

-- VVV Prop "form"
   -- Type: TInterface "WebKit" "DOMHTMLFormElement"
   -- Flags: [PropertyReadable]

getDOMHTMLTextAreaElementForm :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m DOMHTMLFormElement
getDOMHTMLTextAreaElementForm obj = liftIO $ getObjectPropertyObject obj "form" DOMHTMLFormElement

data DOMHTMLTextAreaElementFormPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementFormPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementFormPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementFormPropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementFormPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementFormPropertyInfo = DOMHTMLFormElement
    type AttrLabel DOMHTMLTextAreaElementFormPropertyInfo = "DOMHTMLTextAreaElement::form"
    attrGet _ = getDOMHTMLTextAreaElementForm
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "labels"
   -- Type: TInterface "WebKit" "DOMNodeList"
   -- Flags: [PropertyReadable]

getDOMHTMLTextAreaElementLabels :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m DOMNodeList
getDOMHTMLTextAreaElementLabels obj = liftIO $ getObjectPropertyObject obj "labels" DOMNodeList

data DOMHTMLTextAreaElementLabelsPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementLabelsPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementLabelsPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementLabelsPropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementLabelsPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementLabelsPropertyInfo = DOMNodeList
    type AttrLabel DOMHTMLTextAreaElementLabelsPropertyInfo = "DOMHTMLTextAreaElement::labels"
    attrGet _ = getDOMHTMLTextAreaElementLabels
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "max-length"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLTextAreaElementMaxLength :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Int64
getDOMHTMLTextAreaElementMaxLength obj = liftIO $ getObjectPropertyInt64 obj "max-length"

setDOMHTMLTextAreaElementMaxLength :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Int64 -> m ()
setDOMHTMLTextAreaElementMaxLength obj val = liftIO $ setObjectPropertyInt64 obj "max-length" val

constructDOMHTMLTextAreaElementMaxLength :: Int64 -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementMaxLength val = constructObjectPropertyInt64 "max-length" val

data DOMHTMLTextAreaElementMaxLengthPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementMaxLengthPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementMaxLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementMaxLengthPropertyInfo = (~) Int64
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementMaxLengthPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementMaxLengthPropertyInfo = Int64
    type AttrLabel DOMHTMLTextAreaElementMaxLengthPropertyInfo = "DOMHTMLTextAreaElement::max-length"
    attrGet _ = getDOMHTMLTextAreaElementMaxLength
    attrSet _ = setDOMHTMLTextAreaElementMaxLength
    attrConstruct _ = constructDOMHTMLTextAreaElementMaxLength

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

getDOMHTMLTextAreaElementName :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementName obj = liftIO $ getObjectPropertyString obj "name"

setDOMHTMLTextAreaElementName :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementName obj val = liftIO $ setObjectPropertyString obj "name" val

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

data DOMHTMLTextAreaElementNamePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementNamePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementNamePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementNamePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementNamePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementNamePropertyInfo = "DOMHTMLTextAreaElement::name"
    attrGet _ = getDOMHTMLTextAreaElementName
    attrSet _ = setDOMHTMLTextAreaElementName
    attrConstruct _ = constructDOMHTMLTextAreaElementName

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

getDOMHTMLTextAreaElementPlaceholder :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementPlaceholder obj = liftIO $ getObjectPropertyString obj "placeholder"

setDOMHTMLTextAreaElementPlaceholder :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementPlaceholder obj val = liftIO $ setObjectPropertyString obj "placeholder" val

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

data DOMHTMLTextAreaElementPlaceholderPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementPlaceholderPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementPlaceholderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementPlaceholderPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementPlaceholderPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementPlaceholderPropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementPlaceholderPropertyInfo = "DOMHTMLTextAreaElement::placeholder"
    attrGet _ = getDOMHTMLTextAreaElementPlaceholder
    attrSet _ = setDOMHTMLTextAreaElementPlaceholder
    attrConstruct _ = constructDOMHTMLTextAreaElementPlaceholder

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

getDOMHTMLTextAreaElementReadOnly :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Bool
getDOMHTMLTextAreaElementReadOnly obj = liftIO $ getObjectPropertyBool obj "read-only"

setDOMHTMLTextAreaElementReadOnly :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Bool -> m ()
setDOMHTMLTextAreaElementReadOnly obj val = liftIO $ setObjectPropertyBool obj "read-only" val

constructDOMHTMLTextAreaElementReadOnly :: Bool -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementReadOnly val = constructObjectPropertyBool "read-only" val

data DOMHTMLTextAreaElementReadOnlyPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementReadOnlyPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementReadOnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementReadOnlyPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementReadOnlyPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementReadOnlyPropertyInfo = Bool
    type AttrLabel DOMHTMLTextAreaElementReadOnlyPropertyInfo = "DOMHTMLTextAreaElement::read-only"
    attrGet _ = getDOMHTMLTextAreaElementReadOnly
    attrSet _ = setDOMHTMLTextAreaElementReadOnly
    attrConstruct _ = constructDOMHTMLTextAreaElementReadOnly

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

getDOMHTMLTextAreaElementRequired :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Bool
getDOMHTMLTextAreaElementRequired obj = liftIO $ getObjectPropertyBool obj "required"

setDOMHTMLTextAreaElementRequired :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Bool -> m ()
setDOMHTMLTextAreaElementRequired obj val = liftIO $ setObjectPropertyBool obj "required" val

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

data DOMHTMLTextAreaElementRequiredPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementRequiredPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementRequiredPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementRequiredPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementRequiredPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementRequiredPropertyInfo = Bool
    type AttrLabel DOMHTMLTextAreaElementRequiredPropertyInfo = "DOMHTMLTextAreaElement::required"
    attrGet _ = getDOMHTMLTextAreaElementRequired
    attrSet _ = setDOMHTMLTextAreaElementRequired
    attrConstruct _ = constructDOMHTMLTextAreaElementRequired

-- VVV Prop "rows"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLTextAreaElementRows :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Int64
getDOMHTMLTextAreaElementRows obj = liftIO $ getObjectPropertyInt64 obj "rows"

setDOMHTMLTextAreaElementRows :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Int64 -> m ()
setDOMHTMLTextAreaElementRows obj val = liftIO $ setObjectPropertyInt64 obj "rows" val

constructDOMHTMLTextAreaElementRows :: Int64 -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementRows val = constructObjectPropertyInt64 "rows" val

data DOMHTMLTextAreaElementRowsPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementRowsPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementRowsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementRowsPropertyInfo = (~) Int64
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementRowsPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementRowsPropertyInfo = Int64
    type AttrLabel DOMHTMLTextAreaElementRowsPropertyInfo = "DOMHTMLTextAreaElement::rows"
    attrGet _ = getDOMHTMLTextAreaElementRows
    attrSet _ = setDOMHTMLTextAreaElementRows
    attrConstruct _ = constructDOMHTMLTextAreaElementRows

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

getDOMHTMLTextAreaElementSelectionDirection :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementSelectionDirection obj = liftIO $ getObjectPropertyString obj "selection-direction"

setDOMHTMLTextAreaElementSelectionDirection :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementSelectionDirection obj val = liftIO $ setObjectPropertyString obj "selection-direction" val

constructDOMHTMLTextAreaElementSelectionDirection :: T.Text -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementSelectionDirection val = constructObjectPropertyString "selection-direction" val

data DOMHTMLTextAreaElementSelectionDirectionPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementSelectionDirectionPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementSelectionDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementSelectionDirectionPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementSelectionDirectionPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementSelectionDirectionPropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementSelectionDirectionPropertyInfo = "DOMHTMLTextAreaElement::selection-direction"
    attrGet _ = getDOMHTMLTextAreaElementSelectionDirection
    attrSet _ = setDOMHTMLTextAreaElementSelectionDirection
    attrConstruct _ = constructDOMHTMLTextAreaElementSelectionDirection

-- VVV Prop "selection-end"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLTextAreaElementSelectionEnd :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Int64
getDOMHTMLTextAreaElementSelectionEnd obj = liftIO $ getObjectPropertyInt64 obj "selection-end"

setDOMHTMLTextAreaElementSelectionEnd :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Int64 -> m ()
setDOMHTMLTextAreaElementSelectionEnd obj val = liftIO $ setObjectPropertyInt64 obj "selection-end" val

constructDOMHTMLTextAreaElementSelectionEnd :: Int64 -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementSelectionEnd val = constructObjectPropertyInt64 "selection-end" val

data DOMHTMLTextAreaElementSelectionEndPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementSelectionEndPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementSelectionEndPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementSelectionEndPropertyInfo = (~) Int64
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementSelectionEndPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementSelectionEndPropertyInfo = Int64
    type AttrLabel DOMHTMLTextAreaElementSelectionEndPropertyInfo = "DOMHTMLTextAreaElement::selection-end"
    attrGet _ = getDOMHTMLTextAreaElementSelectionEnd
    attrSet _ = setDOMHTMLTextAreaElementSelectionEnd
    attrConstruct _ = constructDOMHTMLTextAreaElementSelectionEnd

-- VVV Prop "selection-start"
   -- Type: TBasicType TInt64
   -- Flags: [PropertyReadable,PropertyWritable]

getDOMHTMLTextAreaElementSelectionStart :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Int64
getDOMHTMLTextAreaElementSelectionStart obj = liftIO $ getObjectPropertyInt64 obj "selection-start"

setDOMHTMLTextAreaElementSelectionStart :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> Int64 -> m ()
setDOMHTMLTextAreaElementSelectionStart obj val = liftIO $ setObjectPropertyInt64 obj "selection-start" val

constructDOMHTMLTextAreaElementSelectionStart :: Int64 -> IO ([Char], GValue)
constructDOMHTMLTextAreaElementSelectionStart val = constructObjectPropertyInt64 "selection-start" val

data DOMHTMLTextAreaElementSelectionStartPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementSelectionStartPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementSelectionStartPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementSelectionStartPropertyInfo = (~) Int64
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementSelectionStartPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementSelectionStartPropertyInfo = Int64
    type AttrLabel DOMHTMLTextAreaElementSelectionStartPropertyInfo = "DOMHTMLTextAreaElement::selection-start"
    attrGet _ = getDOMHTMLTextAreaElementSelectionStart
    attrSet _ = setDOMHTMLTextAreaElementSelectionStart
    attrConstruct _ = constructDOMHTMLTextAreaElementSelectionStart

-- VVV Prop "text-length"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable]

getDOMHTMLTextAreaElementTextLength :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Word64
getDOMHTMLTextAreaElementTextLength obj = liftIO $ getObjectPropertyUInt64 obj "text-length"

data DOMHTMLTextAreaElementTextLengthPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementTextLengthPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementTextLengthPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementTextLengthPropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementTextLengthPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementTextLengthPropertyInfo = Word64
    type AttrLabel DOMHTMLTextAreaElementTextLengthPropertyInfo = "DOMHTMLTextAreaElement::text-length"
    attrGet _ = getDOMHTMLTextAreaElementTextLength
    attrSet _ = undefined
    attrConstruct _ = undefined

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

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

data DOMHTMLTextAreaElementTypePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementTypePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementTypePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementTypePropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementTypePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementTypePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementTypePropertyInfo = "DOMHTMLTextAreaElement::type"
    attrGet _ = getDOMHTMLTextAreaElementType
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "validation-message"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getDOMHTMLTextAreaElementValidationMessage :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementValidationMessage obj = liftIO $ getObjectPropertyString obj "validation-message"

data DOMHTMLTextAreaElementValidationMessagePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementValidationMessagePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementValidationMessagePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementValidationMessagePropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementValidationMessagePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementValidationMessagePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementValidationMessagePropertyInfo = "DOMHTMLTextAreaElement::validation-message"
    attrGet _ = getDOMHTMLTextAreaElementValidationMessage
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "validity"
   -- Type: TInterface "WebKit" "DOMValidityState"
   -- Flags: [PropertyReadable]

getDOMHTMLTextAreaElementValidity :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m DOMValidityState
getDOMHTMLTextAreaElementValidity obj = liftIO $ getObjectPropertyObject obj "validity" DOMValidityState

data DOMHTMLTextAreaElementValidityPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementValidityPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementValidityPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementValidityPropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementValidityPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementValidityPropertyInfo = DOMValidityState
    type AttrLabel DOMHTMLTextAreaElementValidityPropertyInfo = "DOMHTMLTextAreaElement::validity"
    attrGet _ = getDOMHTMLTextAreaElementValidity
    attrSet _ = undefined
    attrConstruct _ = undefined

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

getDOMHTMLTextAreaElementValue :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementValue obj = liftIO $ getObjectPropertyString obj "value"

setDOMHTMLTextAreaElementValue :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementValue obj val = liftIO $ setObjectPropertyString obj "value" val

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

data DOMHTMLTextAreaElementValuePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementValuePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementValuePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementValuePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementValuePropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementValuePropertyInfo = "DOMHTMLTextAreaElement::value"
    attrGet _ = getDOMHTMLTextAreaElementValue
    attrSet _ = setDOMHTMLTextAreaElementValue
    attrConstruct _ = constructDOMHTMLTextAreaElementValue

-- VVV Prop "will-validate"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getDOMHTMLTextAreaElementWillValidate :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m Bool
getDOMHTMLTextAreaElementWillValidate obj = liftIO $ getObjectPropertyBool obj "will-validate"

data DOMHTMLTextAreaElementWillValidatePropertyInfo
instance AttrInfo DOMHTMLTextAreaElementWillValidatePropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementWillValidatePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementWillValidatePropertyInfo = (~) ()
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementWillValidatePropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementWillValidatePropertyInfo = Bool
    type AttrLabel DOMHTMLTextAreaElementWillValidatePropertyInfo = "DOMHTMLTextAreaElement::will-validate"
    attrGet _ = getDOMHTMLTextAreaElementWillValidate
    attrSet _ = undefined
    attrConstruct _ = undefined

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

getDOMHTMLTextAreaElementWrap :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> m T.Text
getDOMHTMLTextAreaElementWrap obj = liftIO $ getObjectPropertyString obj "wrap"

setDOMHTMLTextAreaElementWrap :: (MonadIO m, DOMHTMLTextAreaElementK o) => o -> T.Text -> m ()
setDOMHTMLTextAreaElementWrap obj val = liftIO $ setObjectPropertyString obj "wrap" val

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

data DOMHTMLTextAreaElementWrapPropertyInfo
instance AttrInfo DOMHTMLTextAreaElementWrapPropertyInfo where
    type AttrAllowedOps DOMHTMLTextAreaElementWrapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint DOMHTMLTextAreaElementWrapPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint DOMHTMLTextAreaElementWrapPropertyInfo = DOMHTMLTextAreaElementK
    type AttrGetType DOMHTMLTextAreaElementWrapPropertyInfo = T.Text
    type AttrLabel DOMHTMLTextAreaElementWrapPropertyInfo = "DOMHTMLTextAreaElement::wrap"
    attrGet _ = getDOMHTMLTextAreaElementWrap
    attrSet _ = setDOMHTMLTextAreaElementWrap
    attrConstruct _ = constructDOMHTMLTextAreaElementWrap

type instance AttributeList DOMHTMLTextAreaElement = DOMHTMLTextAreaElementAttributeList
type DOMHTMLTextAreaElementAttributeList = ('[ '("access-key", DOMHTMLElementAccessKeyPropertyInfo), '("attributes", DOMElementAttributesPropertyInfo), '("autocapitalize", DOMHTMLTextAreaElementAutocapitalizePropertyInfo), '("autocorrect", DOMHTMLTextAreaElementAutocorrectPropertyInfo), '("autofocus", DOMHTMLTextAreaElementAutofocusPropertyInfo), '("base-uri", DOMNodeBaseUriPropertyInfo), '("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), '("cols", DOMHTMLTextAreaElementColsPropertyInfo), '("content-editable", DOMHTMLElementContentEditablePropertyInfo), '("core-object", DOMObjectCoreObjectPropertyInfo), '("default-value", DOMHTMLTextAreaElementDefaultValuePropertyInfo), '("dir", DOMHTMLElementDirPropertyInfo), '("dir-name", DOMHTMLTextAreaElementDirNamePropertyInfo), '("disabled", DOMHTMLTextAreaElementDisabledPropertyInfo), '("draggable", DOMHTMLElementDraggablePropertyInfo), '("first-child", DOMNodeFirstChildPropertyInfo), '("first-element-child", DOMElementFirstElementChildPropertyInfo), '("form", DOMHTMLTextAreaElementFormPropertyInfo), '("hidden", DOMHTMLElementHiddenPropertyInfo), '("id", DOMElementIdPropertyInfo), '("inner-html", DOMHTMLElementInnerHtmlPropertyInfo), '("inner-text", DOMHTMLElementInnerTextPropertyInfo), '("is-content-editable", DOMHTMLElementIsContentEditablePropertyInfo), '("labels", DOMHTMLTextAreaElementLabelsPropertyInfo), '("lang", DOMHTMLElementLangPropertyInfo), '("last-child", DOMNodeLastChildPropertyInfo), '("last-element-child", DOMElementLastElementChildPropertyInfo), '("local-name", DOMNodeLocalNamePropertyInfo), '("max-length", DOMHTMLTextAreaElementMaxLengthPropertyInfo), '("name", DOMHTMLTextAreaElementNamePropertyInfo), '("namespace-uri", DOMNodeNamespaceUriPropertyInfo), '("next-element-sibling", DOMElementNextElementSiblingPropertyInfo), '("next-sibling", DOMNodeNextSiblingPropertyInfo), '("node-name", DOMNodeNodeNamePropertyInfo), '("node-type", DOMNodeNodeTypePropertyInfo), '("node-value", DOMNodeNodeValuePropertyInfo), '("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), '("placeholder", DOMHTMLTextAreaElementPlaceholderPropertyInfo), '("prefix", DOMNodePrefixPropertyInfo), '("previous-element-sibling", DOMElementPreviousElementSiblingPropertyInfo), '("previous-sibling", DOMNodePreviousSiblingPropertyInfo), '("read-only", DOMHTMLTextAreaElementReadOnlyPropertyInfo), '("required", DOMHTMLTextAreaElementRequiredPropertyInfo), '("rows", DOMHTMLTextAreaElementRowsPropertyInfo), '("scroll-height", DOMElementScrollHeightPropertyInfo), '("scroll-left", DOMElementScrollLeftPropertyInfo), '("scroll-top", DOMElementScrollTopPropertyInfo), '("scroll-width", DOMElementScrollWidthPropertyInfo), '("selection-direction", DOMHTMLTextAreaElementSelectionDirectionPropertyInfo), '("selection-end", DOMHTMLTextAreaElementSelectionEndPropertyInfo), '("selection-start", DOMHTMLTextAreaElementSelectionStartPropertyInfo), '("spellcheck", DOMHTMLElementSpellcheckPropertyInfo), '("style", DOMElementStylePropertyInfo), '("tab-index", DOMHTMLElementTabIndexPropertyInfo), '("tag-name", DOMElementTagNamePropertyInfo), '("text-content", DOMNodeTextContentPropertyInfo), '("text-length", DOMHTMLTextAreaElementTextLengthPropertyInfo), '("title", DOMHTMLElementTitlePropertyInfo), '("translate", DOMHTMLElementTranslatePropertyInfo), '("type", DOMHTMLTextAreaElementTypePropertyInfo), '("validation-message", DOMHTMLTextAreaElementValidationMessagePropertyInfo), '("validity", DOMHTMLTextAreaElementValidityPropertyInfo), '("value", DOMHTMLTextAreaElementValuePropertyInfo), '("webkit-region-overset", DOMElementWebkitRegionOversetPropertyInfo), '("webkitdropzone", DOMHTMLElementWebkitdropzonePropertyInfo), '("will-validate", DOMHTMLTextAreaElementWillValidatePropertyInfo), '("wrap", DOMHTMLTextAreaElementWrapPropertyInfo)] :: [(Symbol, *)])

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

-- method DOMHTMLTextAreaElement::check_validity
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_check_validity" webkit_dom_html_text_area_element_check_validity :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

-- method DOMHTMLTextAreaElement::get_autocapitalize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_autocapitalize" webkit_dom_html_text_area_element_get_autocapitalize :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::get_autocorrect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_autocorrect" webkit_dom_html_text_area_element_get_autocorrect :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

-- method DOMHTMLTextAreaElement::get_autofocus
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_autofocus" webkit_dom_html_text_area_element_get_autofocus :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

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

foreign import ccall "webkit_dom_html_text_area_element_get_cols" webkit_dom_html_text_area_element_get_cols :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO Int64


dOMHTMLTextAreaElementGetCols ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m Int64
dOMHTMLTextAreaElementGetCols _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_cols _obj'
    touchManagedPtr _obj
    return result

-- method DOMHTMLTextAreaElement::get_default_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_default_value" webkit_dom_html_text_area_element_get_default_value :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::get_dir_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_dir_name" webkit_dom_html_text_area_element_get_dir_name :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::get_disabled
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_disabled" webkit_dom_html_text_area_element_get_disabled :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

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

foreign import ccall "webkit_dom_html_text_area_element_get_form" webkit_dom_html_text_area_element_get_form :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO (Ptr DOMHTMLFormElement)


dOMHTMLTextAreaElementGetForm ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m DOMHTMLFormElement
dOMHTMLTextAreaElementGetForm _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_form _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_text_area_element_get_form" result
    result' <- (newObject DOMHTMLFormElement) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "webkit_dom_html_text_area_element_get_labels" webkit_dom_html_text_area_element_get_labels :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO (Ptr DOMNodeList)


dOMHTMLTextAreaElementGetLabels ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m DOMNodeList
dOMHTMLTextAreaElementGetLabels _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_labels _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_text_area_element_get_labels" result
    result' <- (wrapObject DOMNodeList) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "webkit_dom_html_text_area_element_get_max_length" webkit_dom_html_text_area_element_get_max_length :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO Int64


dOMHTMLTextAreaElementGetMaxLength ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m Int64
dOMHTMLTextAreaElementGetMaxLength _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_max_length _obj'
    touchManagedPtr _obj
    return result

-- method DOMHTMLTextAreaElement::get_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_name" webkit_dom_html_text_area_element_get_name :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::get_placeholder
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_placeholder" webkit_dom_html_text_area_element_get_placeholder :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::get_read_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_read_only" webkit_dom_html_text_area_element_get_read_only :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

-- method DOMHTMLTextAreaElement::get_required
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_required" webkit_dom_html_text_area_element_get_required :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

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

foreign import ccall "webkit_dom_html_text_area_element_get_rows" webkit_dom_html_text_area_element_get_rows :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO Int64


dOMHTMLTextAreaElementGetRows ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m Int64
dOMHTMLTextAreaElementGetRows _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_rows _obj'
    touchManagedPtr _obj
    return result

-- method DOMHTMLTextAreaElement::get_selection_direction
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_selection_direction" webkit_dom_html_text_area_element_get_selection_direction :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

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

foreign import ccall "webkit_dom_html_text_area_element_get_selection_end" webkit_dom_html_text_area_element_get_selection_end :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO Int64


dOMHTMLTextAreaElementGetSelectionEnd ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m Int64
dOMHTMLTextAreaElementGetSelectionEnd _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_selection_end _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "webkit_dom_html_text_area_element_get_selection_start" webkit_dom_html_text_area_element_get_selection_start :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO Int64


dOMHTMLTextAreaElementGetSelectionStart ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m Int64
dOMHTMLTextAreaElementGetSelectionStart _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_selection_start _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "webkit_dom_html_text_area_element_get_text_length" webkit_dom_html_text_area_element_get_text_length :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO Word64


dOMHTMLTextAreaElementGetTextLength ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m Word64
dOMHTMLTextAreaElementGetTextLength _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_text_length _obj'
    touchManagedPtr _obj
    return result

-- method DOMHTMLTextAreaElement::get_validation_message
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_validation_message" webkit_dom_html_text_area_element_get_validation_message :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

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

foreign import ccall "webkit_dom_html_text_area_element_get_validity" webkit_dom_html_text_area_element_get_validity :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO (Ptr DOMValidityState)


dOMHTMLTextAreaElementGetValidity ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m DOMValidityState
dOMHTMLTextAreaElementGetValidity _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- webkit_dom_html_text_area_element_get_validity _obj'
    checkUnexpectedReturnNULL "webkit_dom_html_text_area_element_get_validity" result
    result' <- (wrapObject DOMValidityState) result
    touchManagedPtr _obj
    return result'

-- method DOMHTMLTextAreaElement::get_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_value" webkit_dom_html_text_area_element_get_value :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::get_will_validate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_will_validate" webkit_dom_html_text_area_element_get_will_validate :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

-- method DOMHTMLTextAreaElement::get_wrap
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_get_wrap" webkit_dom_html_text_area_element_get_wrap :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CString


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

-- method DOMHTMLTextAreaElement::is_edited
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_is_edited" webkit_dom_html_text_area_element_is_edited :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO CInt


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

-- method DOMHTMLTextAreaElement::select
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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_text_area_element_select" webkit_dom_html_text_area_element_select :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    IO ()


dOMHTMLTextAreaElementSelect ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    m ()
dOMHTMLTextAreaElementSelect _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    webkit_dom_html_text_area_element_select _obj'
    touchManagedPtr _obj
    return ()

-- method DOMHTMLTextAreaElement::set_autocapitalize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_autocapitalize" webkit_dom_html_text_area_element_set_autocapitalize :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_autocorrect
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_autocorrect" webkit_dom_html_text_area_element_set_autocorrect :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


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

-- method DOMHTMLTextAreaElement::set_autofocus
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_autofocus" webkit_dom_html_text_area_element_set_autofocus :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


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

-- method DOMHTMLTextAreaElement::set_cols
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, 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_text_area_element_set_cols" webkit_dom_html_text_area_element_set_cols :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    Int64 ->                                -- value : TBasicType TInt64
    IO ()


dOMHTMLTextAreaElementSetCols ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- value
    m ()
dOMHTMLTextAreaElementSetCols _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    webkit_dom_html_text_area_element_set_cols _obj' value
    touchManagedPtr _obj
    return ()

-- method DOMHTMLTextAreaElement::set_custom_validity
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "error", 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_text_area_element_set_custom_validity" webkit_dom_html_text_area_element_set_custom_validity :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- error : TBasicType TUTF8
    IO ()


dOMHTMLTextAreaElementSetCustomValidity ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- error
    m ()
dOMHTMLTextAreaElementSetCustomValidity _obj error_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    error_' <- textToCString error_
    webkit_dom_html_text_area_element_set_custom_validity _obj' error_'
    touchManagedPtr _obj
    freeMem error_'
    return ()

-- method DOMHTMLTextAreaElement::set_default_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_default_value" webkit_dom_html_text_area_element_set_default_value :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_dir_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_dir_name" webkit_dom_html_text_area_element_set_dir_name :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_disabled
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_disabled" webkit_dom_html_text_area_element_set_disabled :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


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

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

foreign import ccall "webkit_dom_html_text_area_element_set_max_length" webkit_dom_html_text_area_element_set_max_length :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    Int64 ->                                -- value : TBasicType TInt64
    Ptr (Ptr GError) ->                     -- error
    IO ()


dOMHTMLTextAreaElementSetMaxLength ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- value
    m ()
dOMHTMLTextAreaElementSetMaxLength _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    onException (do
        propagateGError $ webkit_dom_html_text_area_element_set_max_length _obj' value
        touchManagedPtr _obj
        return ()
     ) (do
        return ()
     )

-- method DOMHTMLTextAreaElement::set_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_name" webkit_dom_html_text_area_element_set_name :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_placeholder
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_placeholder" webkit_dom_html_text_area_element_set_placeholder :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_range_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selectionMode", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "replacement", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selectionMode", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : True
-- Skip return : False

foreign import ccall "webkit_dom_html_text_area_element_set_range_text" webkit_dom_html_text_area_element_set_range_text :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- replacement : TBasicType TUTF8
    Word64 ->                               -- start : TBasicType TUInt64
    Word64 ->                               -- end : TBasicType TUInt64
    CString ->                              -- selectionMode : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO ()


dOMHTMLTextAreaElementSetRangeText ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- replacement
    Word64 ->                               -- start
    Word64 ->                               -- end
    T.Text ->                               -- selectionMode
    m ()
dOMHTMLTextAreaElementSetRangeText _obj replacement start end selectionMode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    replacement' <- textToCString replacement
    selectionMode' <- textToCString selectionMode
    onException (do
        propagateGError $ webkit_dom_html_text_area_element_set_range_text _obj' replacement' start end selectionMode'
        touchManagedPtr _obj
        freeMem replacement'
        freeMem selectionMode'
        return ()
     ) (do
        freeMem replacement'
        freeMem selectionMode'
     )

-- method DOMHTMLTextAreaElement::set_read_only
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_read_only" webkit_dom_html_text_area_element_set_read_only :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


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

-- method DOMHTMLTextAreaElement::set_required
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_required" webkit_dom_html_text_area_element_set_required :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()


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

-- method DOMHTMLTextAreaElement::set_rows
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, 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_text_area_element_set_rows" webkit_dom_html_text_area_element_set_rows :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    Int64 ->                                -- value : TBasicType TInt64
    IO ()


dOMHTMLTextAreaElementSetRows ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- value
    m ()
dOMHTMLTextAreaElementSetRows _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    webkit_dom_html_text_area_element_set_rows _obj' value
    touchManagedPtr _obj
    return ()

-- method DOMHTMLTextAreaElement::set_selection_direction
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_selection_direction" webkit_dom_html_text_area_element_set_selection_direction :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_selection_end
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, 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_text_area_element_set_selection_end" webkit_dom_html_text_area_element_set_selection_end :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    Int64 ->                                -- value : TBasicType TInt64
    IO ()


dOMHTMLTextAreaElementSetSelectionEnd ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- value
    m ()
dOMHTMLTextAreaElementSetSelectionEnd _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    webkit_dom_html_text_area_element_set_selection_end _obj' value
    touchManagedPtr _obj
    return ()

-- method DOMHTMLTextAreaElement::set_selection_range
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "direction", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "direction", 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_text_area_element_set_selection_range" webkit_dom_html_text_area_element_set_selection_range :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    Int64 ->                                -- start : TBasicType TInt64
    Int64 ->                                -- end : TBasicType TInt64
    CString ->                              -- direction : TBasicType TUTF8
    IO ()


dOMHTMLTextAreaElementSetSelectionRange ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- start
    Int64 ->                                -- end
    T.Text ->                               -- direction
    m ()
dOMHTMLTextAreaElementSetSelectionRange _obj start end direction = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    direction' <- textToCString direction
    webkit_dom_html_text_area_element_set_selection_range _obj' start end direction'
    touchManagedPtr _obj
    freeMem direction'
    return ()

-- method DOMHTMLTextAreaElement::set_selection_start
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt64, 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_text_area_element_set_selection_start" webkit_dom_html_text_area_element_set_selection_start :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    Int64 ->                                -- value : TBasicType TInt64
    IO ()


dOMHTMLTextAreaElementSetSelectionStart ::
    (MonadIO m, DOMHTMLTextAreaElementK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- value
    m ()
dOMHTMLTextAreaElementSetSelectionStart _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    webkit_dom_html_text_area_element_set_selection_start _obj' value
    touchManagedPtr _obj
    return ()

-- method DOMHTMLTextAreaElement::set_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_value" webkit_dom_html_text_area_element_set_value :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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

-- method DOMHTMLTextAreaElement::set_wrap
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "WebKit" "DOMHTMLTextAreaElement", 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" "DOMHTMLTextAreaElement", 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_text_area_element_set_wrap" webkit_dom_html_text_area_element_set_wrap :: 
    Ptr DOMHTMLTextAreaElement ->           -- _obj : TInterface "WebKit" "DOMHTMLTextAreaElement"
    CString ->                              -- value : TBasicType TUTF8
    IO ()


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