{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.WebKit2WebExtension.Objects.DOMDOMTokenList
    ( 

-- * Exported types
    DOMDOMTokenList(..)                     ,
    IsDOMDOMTokenList                       ,
    toDOMDOMTokenList                       ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveDOMDOMTokenListMethod            ,
#endif


-- ** contains #method:contains#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListContainsMethodInfo       ,
#endif
    dOMDOMTokenListContains                 ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListGetLengthMethodInfo      ,
#endif
    dOMDOMTokenListGetLength                ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListGetValueMethodInfo       ,
#endif
    dOMDOMTokenListGetValue                 ,


-- ** item #method:item#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListItemMethodInfo           ,
#endif
    dOMDOMTokenListItem                     ,


-- ** replace #method:replace#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListReplaceMethodInfo        ,
#endif
    dOMDOMTokenListReplace                  ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListSetValueMethodInfo       ,
#endif
    dOMDOMTokenListSetValue                 ,


-- ** toggle #method:toggle#

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListToggleMethodInfo         ,
#endif
    dOMDOMTokenListToggle                   ,




 -- * Properties
-- ** length #attr:length#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListLengthPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    dOMDOMTokenListLength                   ,
#endif
    getDOMDOMTokenListLength                ,


-- ** value #attr:value#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DOMDOMTokenListValuePropertyInfo        ,
#endif
    constructDOMDOMTokenListValue           ,
#if defined(ENABLE_OVERLOADING)
    dOMDOMTokenListValue                    ,
#endif
    getDOMDOMTokenListValue                 ,
    setDOMDOMTokenListValue                 ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMObject as WebKit2WebExtension.DOMObject

-- | Memory-managed wrapper type.
newtype DOMDOMTokenList = DOMDOMTokenList (SP.ManagedPtr DOMDOMTokenList)
    deriving (DOMDOMTokenList -> DOMDOMTokenList -> Bool
(DOMDOMTokenList -> DOMDOMTokenList -> Bool)
-> (DOMDOMTokenList -> DOMDOMTokenList -> Bool)
-> Eq DOMDOMTokenList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DOMDOMTokenList -> DOMDOMTokenList -> Bool
$c/= :: DOMDOMTokenList -> DOMDOMTokenList -> Bool
== :: DOMDOMTokenList -> DOMDOMTokenList -> Bool
$c== :: DOMDOMTokenList -> DOMDOMTokenList -> Bool
Eq)

instance SP.ManagedPtrNewtype DOMDOMTokenList where
    toManagedPtr :: DOMDOMTokenList -> ManagedPtr DOMDOMTokenList
toManagedPtr (DOMDOMTokenList ManagedPtr DOMDOMTokenList
p) = ManagedPtr DOMDOMTokenList
p

foreign import ccall "webkit_dom_dom_token_list_get_type"
    c_webkit_dom_dom_token_list_get_type :: IO B.Types.GType

instance B.Types.TypedObject DOMDOMTokenList where
    glibType :: IO GType
glibType = IO GType
c_webkit_dom_dom_token_list_get_type

instance B.Types.GObject DOMDOMTokenList

-- | Convert 'DOMDOMTokenList' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue DOMDOMTokenList where
    toGValue :: DOMDOMTokenList -> IO GValue
toGValue DOMDOMTokenList
o = do
        GType
gtype <- IO GType
c_webkit_dom_dom_token_list_get_type
        DOMDOMTokenList -> (Ptr DOMDOMTokenList -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DOMDOMTokenList
o (GType
-> (GValue -> Ptr DOMDOMTokenList -> IO ())
-> Ptr DOMDOMTokenList
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr DOMDOMTokenList -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO DOMDOMTokenList
fromGValue GValue
gv = do
        Ptr DOMDOMTokenList
ptr <- GValue -> IO (Ptr DOMDOMTokenList)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr DOMDOMTokenList)
        (ManagedPtr DOMDOMTokenList -> DOMDOMTokenList)
-> Ptr DOMDOMTokenList -> IO DOMDOMTokenList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DOMDOMTokenList -> DOMDOMTokenList
DOMDOMTokenList Ptr DOMDOMTokenList
ptr
        
    

-- | Type class for types which can be safely cast to `DOMDOMTokenList`, for instance with `toDOMDOMTokenList`.
class (SP.GObject o, O.IsDescendantOf DOMDOMTokenList o) => IsDOMDOMTokenList o
instance (SP.GObject o, O.IsDescendantOf DOMDOMTokenList o) => IsDOMDOMTokenList o

instance O.HasParentTypes DOMDOMTokenList
type instance O.ParentTypes DOMDOMTokenList = '[WebKit2WebExtension.DOMObject.DOMObject, GObject.Object.Object]

-- | Cast to `DOMDOMTokenList`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toDOMDOMTokenList :: (MonadIO m, IsDOMDOMTokenList o) => o -> m DOMDOMTokenList
toDOMDOMTokenList :: o -> m DOMDOMTokenList
toDOMDOMTokenList = IO DOMDOMTokenList -> m DOMDOMTokenList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DOMDOMTokenList -> m DOMDOMTokenList)
-> (o -> IO DOMDOMTokenList) -> o -> m DOMDOMTokenList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DOMDOMTokenList -> DOMDOMTokenList)
-> o -> IO DOMDOMTokenList
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr DOMDOMTokenList -> DOMDOMTokenList
DOMDOMTokenList

#if defined(ENABLE_OVERLOADING)
type family ResolveDOMDOMTokenListMethod (t :: Symbol) (o :: *) :: * where
    ResolveDOMDOMTokenListMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDOMDOMTokenListMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDOMDOMTokenListMethod "contains" o = DOMDOMTokenListContainsMethodInfo
    ResolveDOMDOMTokenListMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDOMDOMTokenListMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDOMDOMTokenListMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDOMDOMTokenListMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDOMDOMTokenListMethod "item" o = DOMDOMTokenListItemMethodInfo
    ResolveDOMDOMTokenListMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDOMDOMTokenListMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDOMDOMTokenListMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDOMDOMTokenListMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDOMDOMTokenListMethod "replace" o = DOMDOMTokenListReplaceMethodInfo
    ResolveDOMDOMTokenListMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDOMDOMTokenListMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDOMDOMTokenListMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDOMDOMTokenListMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDOMDOMTokenListMethod "toggle" o = DOMDOMTokenListToggleMethodInfo
    ResolveDOMDOMTokenListMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDOMDOMTokenListMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDOMDOMTokenListMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDOMDOMTokenListMethod "getLength" o = DOMDOMTokenListGetLengthMethodInfo
    ResolveDOMDOMTokenListMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDOMDOMTokenListMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDOMDOMTokenListMethod "getValue" o = DOMDOMTokenListGetValueMethodInfo
    ResolveDOMDOMTokenListMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDOMDOMTokenListMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDOMDOMTokenListMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDOMDOMTokenListMethod "setValue" o = DOMDOMTokenListSetValueMethodInfo
    ResolveDOMDOMTokenListMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDOMDOMTokenListMethod t DOMDOMTokenList, O.MethodInfo info DOMDOMTokenList p) => OL.IsLabel t (DOMDOMTokenList -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- VVV Prop "length"
   -- Type: TBasicType TULong
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@length@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMDOMTokenList #length
-- @
getDOMDOMTokenListLength :: (MonadIO m, IsDOMDOMTokenList o) => o -> m CULong
getDOMDOMTokenListLength :: o -> m CULong
getDOMDOMTokenListLength o
obj = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ o -> String -> IO CULong
forall a. GObject a => a -> String -> IO CULong
B.Properties.getObjectPropertyULong o
obj String
"length"

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListLengthPropertyInfo
instance AttrInfo DOMDOMTokenListLengthPropertyInfo where
    type AttrAllowedOps DOMDOMTokenListLengthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DOMDOMTokenListLengthPropertyInfo = IsDOMDOMTokenList
    type AttrSetTypeConstraint DOMDOMTokenListLengthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DOMDOMTokenListLengthPropertyInfo = (~) ()
    type AttrTransferType DOMDOMTokenListLengthPropertyInfo = ()
    type AttrGetType DOMDOMTokenListLengthPropertyInfo = CULong
    type AttrLabel DOMDOMTokenListLengthPropertyInfo = "length"
    type AttrOrigin DOMDOMTokenListLengthPropertyInfo = DOMDOMTokenList
    attrGet = getDOMDOMTokenListLength
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "value"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@value@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dOMDOMTokenList #value
-- @
getDOMDOMTokenListValue :: (MonadIO m, IsDOMDOMTokenList o) => o -> m (Maybe T.Text)
getDOMDOMTokenListValue :: o -> m (Maybe Text)
getDOMDOMTokenListValue o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"value"

-- | Set the value of the “@value@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dOMDOMTokenList [ #value 'Data.GI.Base.Attributes.:=' value ]
-- @
setDOMDOMTokenListValue :: (MonadIO m, IsDOMDOMTokenList o) => o -> T.Text -> m ()
setDOMDOMTokenListValue :: o -> Text -> m ()
setDOMDOMTokenListValue o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"value" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@value@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDOMDOMTokenListValue :: (IsDOMDOMTokenList o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDOMDOMTokenListValue :: Text -> m (GValueConstruct o)
constructDOMDOMTokenListValue Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"value" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListValuePropertyInfo
instance AttrInfo DOMDOMTokenListValuePropertyInfo where
    type AttrAllowedOps DOMDOMTokenListValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DOMDOMTokenListValuePropertyInfo = IsDOMDOMTokenList
    type AttrSetTypeConstraint DOMDOMTokenListValuePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DOMDOMTokenListValuePropertyInfo = (~) T.Text
    type AttrTransferType DOMDOMTokenListValuePropertyInfo = T.Text
    type AttrGetType DOMDOMTokenListValuePropertyInfo = (Maybe T.Text)
    type AttrLabel DOMDOMTokenListValuePropertyInfo = "value"
    type AttrOrigin DOMDOMTokenListValuePropertyInfo = DOMDOMTokenList
    attrGet = getDOMDOMTokenListValue
    attrSet = setDOMDOMTokenListValue
    attrTransfer _ v = do
        return v
    attrConstruct = constructDOMDOMTokenListValue
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DOMDOMTokenList
type instance O.AttributeList DOMDOMTokenList = DOMDOMTokenListAttributeList
type DOMDOMTokenListAttributeList = ('[ '("coreObject", WebKit2WebExtension.DOMObject.DOMObjectCoreObjectPropertyInfo), '("length", DOMDOMTokenListLengthPropertyInfo), '("value", DOMDOMTokenListValuePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dOMDOMTokenListLength :: AttrLabelProxy "length"
dOMDOMTokenListLength = AttrLabelProxy

dOMDOMTokenListValue :: AttrLabelProxy "value"
dOMDOMTokenListValue = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DOMDOMTokenList = DOMDOMTokenListSignalList
type DOMDOMTokenListSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method DOMDOMTokenList::contains
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "token"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_contains" webkit_dom_dom_token_list_contains :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    CString ->                              -- token : TBasicType TUTF8
    IO CInt

{-# DEPRECATED dOMDOMTokenListContains ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListContains ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> T.Text
    -- ^ /@token@/: A @/gchar/@
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMDOMTokenListContains :: a -> Text -> m Bool
dOMDOMTokenListContains a
self Text
token = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
token' <- Text -> IO CString
textToCString Text
token
    CInt
result <- Ptr DOMDOMTokenList -> CString -> IO CInt
webkit_dom_dom_token_list_contains Ptr DOMDOMTokenList
self' CString
token'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
token'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListContainsMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListContainsMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListContains

#endif

-- method DOMDOMTokenList::get_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_get_length" webkit_dom_dom_token_list_get_length :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    IO CULong

{-# DEPRECATED dOMDOMTokenListGetLength ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListGetLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> m CULong
    -- ^ __Returns:__ A @/gulong/@
dOMDOMTokenListGetLength :: a -> m CULong
dOMDOMTokenListGetLength a
self = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CULong
result <- Ptr DOMDOMTokenList -> IO CULong
webkit_dom_dom_token_list_get_length Ptr DOMDOMTokenList
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CULong -> IO CULong
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListGetLengthMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListGetLengthMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListGetLength

#endif

-- method DOMDOMTokenList::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_get_value" webkit_dom_dom_token_list_get_value :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    IO CString

{-# DEPRECATED dOMDOMTokenListGetValue ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> m T.Text
    -- ^ __Returns:__ A @/gchar/@
dOMDOMTokenListGetValue :: a -> m Text
dOMDOMTokenListGetValue a
self = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr DOMDOMTokenList -> IO CString
webkit_dom_dom_token_list_get_value Ptr DOMDOMTokenList
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dOMDOMTokenListGetValue" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListGetValueMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListGetValueMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListGetValue

#endif

-- method DOMDOMTokenList::item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TULong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gulong" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_item" webkit_dom_dom_token_list_item :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    CULong ->                               -- index : TBasicType TULong
    IO CString

{-# DEPRECATED dOMDOMTokenListItem ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> CULong
    -- ^ /@index@/: A @/gulong/@
    -> m T.Text
    -- ^ __Returns:__ A @/gchar/@
dOMDOMTokenListItem :: a -> CULong -> m Text
dOMDOMTokenListItem a
self CULong
index = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr DOMDOMTokenList -> CULong -> IO CString
webkit_dom_dom_token_list_item Ptr DOMDOMTokenList
self' CULong
index
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dOMDOMTokenListItem" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListItemMethodInfo
instance (signature ~ (CULong -> m T.Text), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListItemMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListItem

#endif

-- method DOMDOMTokenList::replace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "token"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "newToken"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_replace" webkit_dom_dom_token_list_replace :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    CString ->                              -- token : TBasicType TUTF8
    CString ->                              -- newToken : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO ()

{-# DEPRECATED dOMDOMTokenListReplace ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListReplace ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> T.Text
    -- ^ /@token@/: A @/gchar/@
    -> T.Text
    -- ^ /@newToken@/: A @/gchar/@
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dOMDOMTokenListReplace :: a -> Text -> Text -> m ()
dOMDOMTokenListReplace a
self Text
token Text
newToken = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
token' <- Text -> IO CString
textToCString Text
token
    CString
newToken' <- Text -> IO CString
textToCString Text
newToken
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DOMDOMTokenList
-> CString -> CString -> Ptr (Ptr GError) -> IO ()
webkit_dom_dom_token_list_replace Ptr DOMDOMTokenList
self' CString
token' CString
newToken'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
token'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newToken'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
token'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newToken'
     )

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListReplaceMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListReplaceMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListReplace

#endif

-- method DOMDOMTokenList::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_set_value" webkit_dom_dom_token_list_set_value :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    CString ->                              -- value : TBasicType TUTF8
    IO ()

{-# DEPRECATED dOMDOMTokenListSetValue ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> T.Text
    -- ^ /@value@/: A @/gchar/@
    -> m ()
dOMDOMTokenListSetValue :: a -> Text -> m ()
dOMDOMTokenListSetValue a
self Text
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr DOMDOMTokenList -> CString -> IO ()
webkit_dom_dom_token_list_set_value Ptr DOMDOMTokenList
self' CString
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListSetValueMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListSetValueMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListSetValue

#endif

-- method DOMDOMTokenList::toggle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDOMTokenList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMTokenList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "token"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "force"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "webkit_dom_dom_token_list_toggle" webkit_dom_dom_token_list_toggle :: 
    Ptr DOMDOMTokenList ->                  -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMTokenList"})
    CString ->                              -- token : TBasicType TUTF8
    CInt ->                                 -- force : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED dOMDOMTokenListToggle ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
-- 
-- /Since: 2.16/
dOMDOMTokenListToggle ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMTokenList a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMTokenList.DOMDOMTokenList'
    -> T.Text
    -- ^ /@token@/: A @/gchar/@
    -> Bool
    -- ^ /@force@/: A t'P.Bool'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
dOMDOMTokenListToggle :: a -> Text -> Bool -> m ()
dOMDOMTokenListToggle a
self Text
token Bool
force = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMTokenList
self' <- a -> IO (Ptr DOMDOMTokenList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
token' <- Text -> IO CString
textToCString Text
token
    let force' :: CInt
force' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
force
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr DOMDOMTokenList
-> CString -> CInt -> Ptr (Ptr GError) -> IO CInt
webkit_dom_dom_token_list_toggle Ptr DOMDOMTokenList
self' CString
token' CInt
force'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
token'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
token'
     )

#if defined(ENABLE_OVERLOADING)
data DOMDOMTokenListToggleMethodInfo
instance (signature ~ (T.Text -> Bool -> m ()), MonadIO m, IsDOMDOMTokenList a) => O.MethodInfo DOMDOMTokenListToggleMethodInfo a signature where
    overloadedMethod = dOMDOMTokenListToggle

#endif