{-# 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.DOMDOMImplementation
    ( 

-- * Exported types
    DOMDOMImplementation(..)                ,
    IsDOMDOMImplementation                  ,
    toDOMDOMImplementation                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDOMDOMImplementationMethod       ,
#endif


-- ** createCssStyleSheet #method:createCssStyleSheet#

#if defined(ENABLE_OVERLOADING)
    DOMDOMImplementationCreateCssStyleSheetMethodInfo,
#endif
    dOMDOMImplementationCreateCssStyleSheet ,


-- ** createDocument #method:createDocument#

#if defined(ENABLE_OVERLOADING)
    DOMDOMImplementationCreateDocumentMethodInfo,
#endif
    dOMDOMImplementationCreateDocument      ,


-- ** createDocumentType #method:createDocumentType#

#if defined(ENABLE_OVERLOADING)
    DOMDOMImplementationCreateDocumentTypeMethodInfo,
#endif
    dOMDOMImplementationCreateDocumentType  ,


-- ** createHtmlDocument #method:createHtmlDocument#

#if defined(ENABLE_OVERLOADING)
    DOMDOMImplementationCreateHtmlDocumentMethodInfo,
#endif
    dOMDOMImplementationCreateHtmlDocument  ,


-- ** hasFeature #method:hasFeature#

#if defined(ENABLE_OVERLOADING)
    DOMDOMImplementationHasFeatureMethodInfo,
#endif
    dOMDOMImplementationHasFeature          ,




    ) 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.DOMCSSStyleSheet as WebKit2WebExtension.DOMCSSStyleSheet
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMDocument as WebKit2WebExtension.DOMDocument
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMDocumentType as WebKit2WebExtension.DOMDocumentType
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMHTMLDocument as WebKit2WebExtension.DOMHTMLDocument
import {-# SOURCE #-} qualified GI.WebKit2WebExtension.Objects.DOMObject as WebKit2WebExtension.DOMObject

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

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

foreign import ccall "webkit_dom_dom_implementation_get_type"
    c_webkit_dom_dom_implementation_get_type :: IO B.Types.GType

instance B.Types.TypedObject DOMDOMImplementation where
    glibType :: IO GType
glibType = IO GType
c_webkit_dom_dom_implementation_get_type

instance B.Types.GObject DOMDOMImplementation

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDOMDOMImplementationMethod (t :: Symbol) (o :: *) :: * where
    ResolveDOMDOMImplementationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDOMDOMImplementationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDOMDOMImplementationMethod "createCssStyleSheet" o = DOMDOMImplementationCreateCssStyleSheetMethodInfo
    ResolveDOMDOMImplementationMethod "createDocument" o = DOMDOMImplementationCreateDocumentMethodInfo
    ResolveDOMDOMImplementationMethod "createDocumentType" o = DOMDOMImplementationCreateDocumentTypeMethodInfo
    ResolveDOMDOMImplementationMethod "createHtmlDocument" o = DOMDOMImplementationCreateHtmlDocumentMethodInfo
    ResolveDOMDOMImplementationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDOMDOMImplementationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDOMDOMImplementationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDOMDOMImplementationMethod "hasFeature" o = DOMDOMImplementationHasFeatureMethodInfo
    ResolveDOMDOMImplementationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDOMDOMImplementationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDOMDOMImplementationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDOMDOMImplementationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDOMDOMImplementationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDOMDOMImplementationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDOMDOMImplementationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDOMDOMImplementationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDOMDOMImplementationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDOMDOMImplementationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDOMDOMImplementationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDOMDOMImplementationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDOMDOMImplementationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDOMDOMImplementationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDOMDOMImplementationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDOMDOMImplementationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDOMDOMImplementationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDOMDOMImplementationMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DOMDOMImplementation
type instance O.AttributeList DOMDOMImplementation = DOMDOMImplementationAttributeList
type DOMDOMImplementationAttributeList = ('[ '("coreObject", WebKit2WebExtension.DOMObject.DOMObjectCoreObjectPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method DOMDOMImplementation::create_css_style_sheet
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension"
--                   , name = "DOMDOMImplementation"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMImplementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , 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 = "media"
--           , 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
--               (TInterface
--                  Name
--                    { namespace = "WebKit2WebExtension" , name = "DOMCSSStyleSheet" })
-- throws : True
-- Skip return : False

foreign import ccall "webkit_dom_dom_implementation_create_css_style_sheet" webkit_dom_dom_implementation_create_css_style_sheet :: 
    Ptr DOMDOMImplementation ->             -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMImplementation"})
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- media : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2WebExtension.DOMCSSStyleSheet.DOMCSSStyleSheet)

{-# DEPRECATED dOMDOMImplementationCreateCssStyleSheet ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMDOMImplementationCreateCssStyleSheet ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMImplementation a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMImplementation.DOMDOMImplementation'
    -> T.Text
    -- ^ /@title@/: A @/gchar/@
    -> T.Text
    -- ^ /@media@/: A @/gchar/@
    -> m WebKit2WebExtension.DOMCSSStyleSheet.DOMCSSStyleSheet
    -- ^ __Returns:__ A t'GI.WebKit2WebExtension.Objects.DOMCSSStyleSheet.DOMCSSStyleSheet' /(Can throw 'Data.GI.Base.GError.GError')/
dOMDOMImplementationCreateCssStyleSheet :: a -> Text -> Text -> m DOMCSSStyleSheet
dOMDOMImplementationCreateCssStyleSheet a
self Text
title Text
media = IO DOMCSSStyleSheet -> m DOMCSSStyleSheet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DOMCSSStyleSheet -> m DOMCSSStyleSheet)
-> IO DOMCSSStyleSheet -> m DOMCSSStyleSheet
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMImplementation
self' <- a -> IO (Ptr DOMDOMImplementation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    CString
media' <- Text -> IO CString
textToCString Text
media
    IO DOMCSSStyleSheet -> IO () -> IO DOMCSSStyleSheet
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr DOMCSSStyleSheet
result <- (Ptr (Ptr GError) -> IO (Ptr DOMCSSStyleSheet))
-> IO (Ptr DOMCSSStyleSheet)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr DOMCSSStyleSheet))
 -> IO (Ptr DOMCSSStyleSheet))
-> (Ptr (Ptr GError) -> IO (Ptr DOMCSSStyleSheet))
-> IO (Ptr DOMCSSStyleSheet)
forall a b. (a -> b) -> a -> b
$ Ptr DOMDOMImplementation
-> CString
-> CString
-> Ptr (Ptr GError)
-> IO (Ptr DOMCSSStyleSheet)
webkit_dom_dom_implementation_create_css_style_sheet Ptr DOMDOMImplementation
self' CString
title' CString
media'
        Text -> Ptr DOMCSSStyleSheet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dOMDOMImplementationCreateCssStyleSheet" Ptr DOMCSSStyleSheet
result
        DOMCSSStyleSheet
result' <- ((ManagedPtr DOMCSSStyleSheet -> DOMCSSStyleSheet)
-> Ptr DOMCSSStyleSheet -> IO DOMCSSStyleSheet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DOMCSSStyleSheet -> DOMCSSStyleSheet
WebKit2WebExtension.DOMCSSStyleSheet.DOMCSSStyleSheet) Ptr DOMCSSStyleSheet
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
media'
        DOMCSSStyleSheet -> IO DOMCSSStyleSheet
forall (m :: * -> *) a. Monad m => a -> m a
return DOMCSSStyleSheet
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
media'
     )

#if defined(ENABLE_OVERLOADING)
data DOMDOMImplementationCreateCssStyleSheetMethodInfo
instance (signature ~ (T.Text -> T.Text -> m WebKit2WebExtension.DOMCSSStyleSheet.DOMCSSStyleSheet), MonadIO m, IsDOMDOMImplementation a) => O.MethodInfo DOMDOMImplementationCreateCssStyleSheetMethodInfo a signature where
    overloadedMethod = dOMDOMImplementationCreateCssStyleSheet

#endif

-- method DOMDOMImplementation::create_document
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension"
--                   , name = "DOMDOMImplementation"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMImplementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "namespaceURI"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #gchar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "qualifiedName"
--           , 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 = "doctype"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension" , name = "DOMDocumentType" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDocumentType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2WebExtension" , name = "DOMDocument" })
-- throws : True
-- Skip return : False

foreign import ccall "webkit_dom_dom_implementation_create_document" webkit_dom_dom_implementation_create_document :: 
    Ptr DOMDOMImplementation ->             -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMImplementation"})
    CString ->                              -- namespaceURI : TBasicType TUTF8
    CString ->                              -- qualifiedName : TBasicType TUTF8
    Ptr WebKit2WebExtension.DOMDocumentType.DOMDocumentType -> -- doctype : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDocumentType"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2WebExtension.DOMDocument.DOMDocument)

{-# DEPRECATED dOMDOMImplementationCreateDocument ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMDOMImplementationCreateDocument ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMImplementation a, WebKit2WebExtension.DOMDocumentType.IsDOMDocumentType b) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMImplementation.DOMDOMImplementation'
    -> Maybe (T.Text)
    -- ^ /@namespaceURI@/: A @/gchar/@
    -> T.Text
    -- ^ /@qualifiedName@/: A @/gchar/@
    -> Maybe (b)
    -- ^ /@doctype@/: A t'GI.WebKit2WebExtension.Objects.DOMDocumentType.DOMDocumentType'
    -> m WebKit2WebExtension.DOMDocument.DOMDocument
    -- ^ __Returns:__ A t'GI.WebKit2WebExtension.Objects.DOMDocument.DOMDocument' /(Can throw 'Data.GI.Base.GError.GError')/
dOMDOMImplementationCreateDocument :: a -> Maybe Text -> Text -> Maybe b -> m DOMDocument
dOMDOMImplementationCreateDocument a
self Maybe Text
namespaceURI Text
qualifiedName Maybe b
doctype = IO DOMDocument -> m DOMDocument
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DOMDocument -> m DOMDocument)
-> IO DOMDocument -> m DOMDocument
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMImplementation
self' <- a -> IO (Ptr DOMDOMImplementation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeNamespaceURI <- case Maybe Text
namespaceURI of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jNamespaceURI -> do
            CString
jNamespaceURI' <- Text -> IO CString
textToCString Text
jNamespaceURI
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jNamespaceURI'
    CString
qualifiedName' <- Text -> IO CString
textToCString Text
qualifiedName
    Ptr DOMDocumentType
maybeDoctype <- case Maybe b
doctype of
        Maybe b
Nothing -> Ptr DOMDocumentType -> IO (Ptr DOMDocumentType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DOMDocumentType
forall a. Ptr a
nullPtr
        Just b
jDoctype -> do
            Ptr DOMDocumentType
jDoctype' <- b -> IO (Ptr DOMDocumentType)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jDoctype
            Ptr DOMDocumentType -> IO (Ptr DOMDocumentType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DOMDocumentType
jDoctype'
    IO DOMDocument -> IO () -> IO DOMDocument
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr DOMDocument
result <- (Ptr (Ptr GError) -> IO (Ptr DOMDocument)) -> IO (Ptr DOMDocument)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr DOMDocument))
 -> IO (Ptr DOMDocument))
-> (Ptr (Ptr GError) -> IO (Ptr DOMDocument))
-> IO (Ptr DOMDocument)
forall a b. (a -> b) -> a -> b
$ Ptr DOMDOMImplementation
-> CString
-> CString
-> Ptr DOMDocumentType
-> Ptr (Ptr GError)
-> IO (Ptr DOMDocument)
webkit_dom_dom_implementation_create_document Ptr DOMDOMImplementation
self' CString
maybeNamespaceURI CString
qualifiedName' Ptr DOMDocumentType
maybeDoctype
        Text -> Ptr DOMDocument -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dOMDOMImplementationCreateDocument" Ptr DOMDocument
result
        DOMDocument
result' <- ((ManagedPtr DOMDocument -> DOMDocument)
-> Ptr DOMDocument -> IO DOMDocument
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DOMDocument -> DOMDocument
WebKit2WebExtension.DOMDocument.DOMDocument) Ptr DOMDocument
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
doctype b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeNamespaceURI
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
qualifiedName'
        DOMDocument -> IO DOMDocument
forall (m :: * -> *) a. Monad m => a -> m a
return DOMDocument
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeNamespaceURI
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
qualifiedName'
     )

#if defined(ENABLE_OVERLOADING)
data DOMDOMImplementationCreateDocumentMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (b) -> m WebKit2WebExtension.DOMDocument.DOMDocument), MonadIO m, IsDOMDOMImplementation a, WebKit2WebExtension.DOMDocumentType.IsDOMDocumentType b) => O.MethodInfo DOMDOMImplementationCreateDocumentMethodInfo a signature where
    overloadedMethod = dOMDOMImplementationCreateDocument

#endif

-- method DOMDOMImplementation::create_document_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension"
--                   , name = "DOMDOMImplementation"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMImplementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "qualifiedName"
--           , 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 = "publicId"
--           , 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 = "systemId"
--           , 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
--               (TInterface
--                  Name
--                    { namespace = "WebKit2WebExtension" , name = "DOMDocumentType" })
-- throws : True
-- Skip return : False

foreign import ccall "webkit_dom_dom_implementation_create_document_type" webkit_dom_dom_implementation_create_document_type :: 
    Ptr DOMDOMImplementation ->             -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMImplementation"})
    CString ->                              -- qualifiedName : TBasicType TUTF8
    CString ->                              -- publicId : TBasicType TUTF8
    CString ->                              -- systemId : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr WebKit2WebExtension.DOMDocumentType.DOMDocumentType)

{-# DEPRECATED dOMDOMImplementationCreateDocumentType ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMDOMImplementationCreateDocumentType ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMImplementation a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMImplementation.DOMDOMImplementation'
    -> T.Text
    -- ^ /@qualifiedName@/: A @/gchar/@
    -> T.Text
    -- ^ /@publicId@/: A @/gchar/@
    -> T.Text
    -- ^ /@systemId@/: A @/gchar/@
    -> m WebKit2WebExtension.DOMDocumentType.DOMDocumentType
    -- ^ __Returns:__ A t'GI.WebKit2WebExtension.Objects.DOMDocumentType.DOMDocumentType' /(Can throw 'Data.GI.Base.GError.GError')/
dOMDOMImplementationCreateDocumentType :: a -> Text -> Text -> Text -> m DOMDocumentType
dOMDOMImplementationCreateDocumentType a
self Text
qualifiedName Text
publicId Text
systemId = IO DOMDocumentType -> m DOMDocumentType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DOMDocumentType -> m DOMDocumentType)
-> IO DOMDocumentType -> m DOMDocumentType
forall a b. (a -> b) -> a -> b
$ do
    Ptr DOMDOMImplementation
self' <- a -> IO (Ptr DOMDOMImplementation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
qualifiedName' <- Text -> IO CString
textToCString Text
qualifiedName
    CString
publicId' <- Text -> IO CString
textToCString Text
publicId
    CString
systemId' <- Text -> IO CString
textToCString Text
systemId
    IO DOMDocumentType -> IO () -> IO DOMDocumentType
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr DOMDocumentType
result <- (Ptr (Ptr GError) -> IO (Ptr DOMDocumentType))
-> IO (Ptr DOMDocumentType)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr DOMDocumentType))
 -> IO (Ptr DOMDocumentType))
-> (Ptr (Ptr GError) -> IO (Ptr DOMDocumentType))
-> IO (Ptr DOMDocumentType)
forall a b. (a -> b) -> a -> b
$ Ptr DOMDOMImplementation
-> CString
-> CString
-> CString
-> Ptr (Ptr GError)
-> IO (Ptr DOMDocumentType)
webkit_dom_dom_implementation_create_document_type Ptr DOMDOMImplementation
self' CString
qualifiedName' CString
publicId' CString
systemId'
        Text -> Ptr DOMDocumentType -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dOMDOMImplementationCreateDocumentType" Ptr DOMDocumentType
result
        DOMDocumentType
result' <- ((ManagedPtr DOMDocumentType -> DOMDocumentType)
-> Ptr DOMDocumentType -> IO DOMDocumentType
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DOMDocumentType -> DOMDocumentType
WebKit2WebExtension.DOMDocumentType.DOMDocumentType) Ptr DOMDocumentType
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
qualifiedName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
publicId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
systemId'
        DOMDocumentType -> IO DOMDocumentType
forall (m :: * -> *) a. Monad m => a -> m a
return DOMDocumentType
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
qualifiedName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
publicId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
systemId'
     )

#if defined(ENABLE_OVERLOADING)
data DOMDOMImplementationCreateDocumentTypeMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> m WebKit2WebExtension.DOMDocumentType.DOMDocumentType), MonadIO m, IsDOMDOMImplementation a) => O.MethodInfo DOMDOMImplementationCreateDocumentTypeMethodInfo a signature where
    overloadedMethod = dOMDOMImplementationCreateDocumentType

#endif

-- method DOMDOMImplementation::create_html_document
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension"
--                   , name = "DOMDOMImplementation"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMImplementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , 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
--               (TInterface
--                  Name
--                    { namespace = "WebKit2WebExtension" , name = "DOMHTMLDocument" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_dom_dom_implementation_create_html_document" webkit_dom_dom_implementation_create_html_document :: 
    Ptr DOMDOMImplementation ->             -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMImplementation"})
    CString ->                              -- title : TBasicType TUTF8
    IO (Ptr WebKit2WebExtension.DOMHTMLDocument.DOMHTMLDocument)

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

#if defined(ENABLE_OVERLOADING)
data DOMDOMImplementationCreateHtmlDocumentMethodInfo
instance (signature ~ (T.Text -> m WebKit2WebExtension.DOMHTMLDocument.DOMHTMLDocument), MonadIO m, IsDOMDOMImplementation a) => O.MethodInfo DOMDOMImplementationCreateHtmlDocumentMethodInfo a signature where
    overloadedMethod = dOMDOMImplementationCreateHtmlDocument

#endif

-- method DOMDOMImplementation::has_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "WebKit2WebExtension"
--                   , name = "DOMDOMImplementation"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitDOMDOMImplementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "feature"
--           , 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 = "version"
--           , 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_implementation_has_feature" webkit_dom_dom_implementation_has_feature :: 
    Ptr DOMDOMImplementation ->             -- self : TInterface (Name {namespace = "WebKit2WebExtension", name = "DOMDOMImplementation"})
    CString ->                              -- feature : TBasicType TUTF8
    CString ->                              -- version : TBasicType TUTF8
    IO CInt

{-# DEPRECATED dOMDOMImplementationHasFeature ["(Since version 2.22)","Use JavaScriptCore API instead"] #-}
-- | /No description available in the introspection data./
dOMDOMImplementationHasFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsDOMDOMImplementation a) =>
    a
    -- ^ /@self@/: A t'GI.WebKit2WebExtension.Objects.DOMDOMImplementation.DOMDOMImplementation'
    -> T.Text
    -- ^ /@feature@/: A @/gchar/@
    -> T.Text
    -- ^ /@version@/: A @/gchar/@
    -> m Bool
    -- ^ __Returns:__ A t'P.Bool'
dOMDOMImplementationHasFeature :: a -> Text -> Text -> m Bool
dOMDOMImplementationHasFeature a
self Text
feature Text
version = 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 DOMDOMImplementation
self' <- a -> IO (Ptr DOMDOMImplementation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
feature' <- Text -> IO CString
textToCString Text
feature
    CString
version' <- Text -> IO CString
textToCString Text
version
    CInt
result <- Ptr DOMDOMImplementation -> CString -> CString -> IO CInt
webkit_dom_dom_implementation_has_feature Ptr DOMDOMImplementation
self' CString
feature' CString
version'
    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
feature'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
version'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

#endif