{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This query represents a user\'s choice to allow or deny access to \"powerful features\" of the
-- platform, as specified in the <https://w3c.github.io/permissions/ Permissions W3C
-- Specification>.
-- 
-- When signalled by the t'GI.WebKit2.Objects.WebView.WebView' through the @query-permission-state@ signal, the application
-- has to eventually respond, via @webkit_permission_state_query_finish()@, whether it grants,
-- denies or requests a dedicated permission prompt for the given query.
-- 
-- When a t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery' is not handled by the user, the user-agent is instructed to
-- @prompt@ the user for the given permission.

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

module GI.WebKit2.Structs.PermissionStateQuery
    ( 

-- * Exported types
    PermissionStateQuery(..)                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [finish]("GI.WebKit2.Structs.PermissionStateQuery#g:method:finish"), [ref]("GI.WebKit2.Structs.PermissionStateQuery#g:method:ref"), [unref]("GI.WebKit2.Structs.PermissionStateQuery#g:method:unref").
-- 
-- ==== Getters
-- [getName]("GI.WebKit2.Structs.PermissionStateQuery#g:method:getName"), [getSecurityOrigin]("GI.WebKit2.Structs.PermissionStateQuery#g:method:getSecurityOrigin").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolvePermissionStateQueryMethod       ,
#endif

-- ** finish #method:finish#

#if defined(ENABLE_OVERLOADING)
    PermissionStateQueryFinishMethodInfo    ,
#endif
    permissionStateQueryFinish              ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    PermissionStateQueryGetNameMethodInfo   ,
#endif
    permissionStateQueryGetName             ,


-- ** getSecurityOrigin #method:getSecurityOrigin#

#if defined(ENABLE_OVERLOADING)
    PermissionStateQueryGetSecurityOriginMethodInfo,
#endif
    permissionStateQueryGetSecurityOrigin   ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    PermissionStateQueryRefMethodInfo       ,
#endif
    permissionStateQueryRef                 ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    PermissionStateQueryUnrefMethodInfo     ,
#endif
    permissionStateQueryUnref               ,




    ) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R

import {-# SOURCE #-} qualified GI.WebKit2.Enums as WebKit2.Enums
import {-# SOURCE #-} qualified GI.WebKit2.Structs.SecurityOrigin as WebKit2.SecurityOrigin

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

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

foreign import ccall "webkit_permission_state_query_get_type" c_webkit_permission_state_query_get_type :: 
    IO GType

type instance O.ParentTypes PermissionStateQuery = '[]
instance O.HasParentTypes PermissionStateQuery

instance B.Types.TypedObject PermissionStateQuery where
    glibType :: IO GType
glibType = IO GType
c_webkit_permission_state_query_get_type

instance B.Types.GBoxed PermissionStateQuery

-- | Convert 'PermissionStateQuery' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe PermissionStateQuery) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_permission_state_query_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PermissionStateQuery -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PermissionStateQuery
P.Nothing = Ptr GValue -> Ptr PermissionStateQuery -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr PermissionStateQuery
forall a. Ptr a
FP.nullPtr :: FP.Ptr PermissionStateQuery)
    gvalueSet_ Ptr GValue
gv (P.Just PermissionStateQuery
obj) = PermissionStateQuery
-> (Ptr PermissionStateQuery -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PermissionStateQuery
obj (Ptr GValue -> Ptr PermissionStateQuery -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PermissionStateQuery)
gvalueGet_ Ptr GValue
gv = do
        Ptr PermissionStateQuery
ptr <- Ptr GValue -> IO (Ptr PermissionStateQuery)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr PermissionStateQuery)
        if Ptr PermissionStateQuery
ptr Ptr PermissionStateQuery -> Ptr PermissionStateQuery -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr PermissionStateQuery
forall a. Ptr a
FP.nullPtr
        then PermissionStateQuery -> Maybe PermissionStateQuery
forall a. a -> Maybe a
P.Just (PermissionStateQuery -> Maybe PermissionStateQuery)
-> IO PermissionStateQuery -> IO (Maybe PermissionStateQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr PermissionStateQuery -> PermissionStateQuery)
-> Ptr PermissionStateQuery -> IO PermissionStateQuery
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr PermissionStateQuery -> PermissionStateQuery
PermissionStateQuery Ptr PermissionStateQuery
ptr
        else Maybe PermissionStateQuery -> IO (Maybe PermissionStateQuery)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PermissionStateQuery
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PermissionStateQuery
type instance O.AttributeList PermissionStateQuery = PermissionStateQueryAttributeList
type PermissionStateQueryAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method PermissionStateQuery::finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PermissionStateQuery" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPermissionStateQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PermissionState" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPermissionState"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_permission_state_query_finish" webkit_permission_state_query_finish :: 
    Ptr PermissionStateQuery ->             -- query : TInterface (Name {namespace = "WebKit2", name = "PermissionStateQuery"})
    CUInt ->                                -- state : TInterface (Name {namespace = "WebKit2", name = "PermissionState"})
    IO ()

-- | Notify the web-engine of the selected permission state for the given query. This function should
-- only be called as a response to the @WebKitWebView::query-permission-state@ signal.
-- 
-- /Since: 2.40/
permissionStateQueryFinish ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PermissionStateQuery
    -- ^ /@query@/: a t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery'
    -> WebKit2.Enums.PermissionState
    -- ^ /@state@/: a t'GI.WebKit2.Enums.PermissionState'
    -> m ()
permissionStateQueryFinish :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PermissionStateQuery -> PermissionState -> m ()
permissionStateQueryFinish PermissionStateQuery
query PermissionState
state = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PermissionStateQuery
query' <- PermissionStateQuery -> IO (Ptr PermissionStateQuery)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PermissionStateQuery
query
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (PermissionState -> Int) -> PermissionState -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PermissionState -> Int
forall a. Enum a => a -> Int
fromEnum) PermissionState
state
    Ptr PermissionStateQuery -> CUInt -> IO ()
webkit_permission_state_query_finish Ptr PermissionStateQuery
query' CUInt
state'
    PermissionStateQuery -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PermissionStateQuery
query
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PermissionStateQueryFinishMethodInfo
instance (signature ~ (WebKit2.Enums.PermissionState -> m ()), MonadIO m) => O.OverloadedMethod PermissionStateQueryFinishMethodInfo PermissionStateQuery signature where
    overloadedMethod = permissionStateQueryFinish

instance O.OverloadedMethodInfo PermissionStateQueryFinishMethodInfo PermissionStateQuery where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Structs.PermissionStateQuery.permissionStateQueryFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Structs-PermissionStateQuery.html#v:permissionStateQueryFinish"
        })


#endif

-- method PermissionStateQuery::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PermissionStateQuery" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPermissionStateQuery"
--                 , 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_permission_state_query_get_name" webkit_permission_state_query_get_name :: 
    Ptr PermissionStateQuery ->             -- query : TInterface (Name {namespace = "WebKit2", name = "PermissionStateQuery"})
    IO CString

-- | Get the permission name for which access is being queried.
-- 
-- /Since: 2.40/
permissionStateQueryGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PermissionStateQuery
    -- ^ /@query@/: a t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery'
    -> m T.Text
    -- ^ __Returns:__ the permission name for /@query@/
permissionStateQueryGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PermissionStateQuery -> m Text
permissionStateQueryGetName PermissionStateQuery
query = IO Text -> m Text
forall a. IO a -> m a
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 PermissionStateQuery
query' <- PermissionStateQuery -> IO (Ptr PermissionStateQuery)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PermissionStateQuery
query
    CString
result <- Ptr PermissionStateQuery -> IO CString
webkit_permission_state_query_get_name Ptr PermissionStateQuery
query'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"permissionStateQueryGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    PermissionStateQuery -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PermissionStateQuery
query
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PermissionStateQueryGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod PermissionStateQueryGetNameMethodInfo PermissionStateQuery signature where
    overloadedMethod = permissionStateQueryGetName

instance O.OverloadedMethodInfo PermissionStateQueryGetNameMethodInfo PermissionStateQuery where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Structs.PermissionStateQuery.permissionStateQueryGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Structs-PermissionStateQuery.html#v:permissionStateQueryGetName"
        })


#endif

-- method PermissionStateQuery::get_security_origin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PermissionStateQuery" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPermissionStateQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "SecurityOrigin" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_permission_state_query_get_security_origin" webkit_permission_state_query_get_security_origin :: 
    Ptr PermissionStateQuery ->             -- query : TInterface (Name {namespace = "WebKit2", name = "PermissionStateQuery"})
    IO (Ptr WebKit2.SecurityOrigin.SecurityOrigin)

-- | Get the permission origin for which access is being queried.
-- 
-- /Since: 2.40/
permissionStateQueryGetSecurityOrigin ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PermissionStateQuery
    -- ^ /@query@/: a t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery'
    -> m WebKit2.SecurityOrigin.SecurityOrigin
    -- ^ __Returns:__ A t'GI.WebKit2.Structs.SecurityOrigin.SecurityOrigin' representing the origin from which the
    -- /@query@/ was emitted.
permissionStateQueryGetSecurityOrigin :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PermissionStateQuery -> m SecurityOrigin
permissionStateQueryGetSecurityOrigin PermissionStateQuery
query = IO SecurityOrigin -> m SecurityOrigin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SecurityOrigin -> m SecurityOrigin)
-> IO SecurityOrigin -> m SecurityOrigin
forall a b. (a -> b) -> a -> b
$ do
    Ptr PermissionStateQuery
query' <- PermissionStateQuery -> IO (Ptr PermissionStateQuery)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PermissionStateQuery
query
    Ptr SecurityOrigin
result <- Ptr PermissionStateQuery -> IO (Ptr SecurityOrigin)
webkit_permission_state_query_get_security_origin Ptr PermissionStateQuery
query'
    Text -> Ptr SecurityOrigin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"permissionStateQueryGetSecurityOrigin" Ptr SecurityOrigin
result
    SecurityOrigin
result' <- ((ManagedPtr SecurityOrigin -> SecurityOrigin)
-> Ptr SecurityOrigin -> IO SecurityOrigin
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr SecurityOrigin -> SecurityOrigin
WebKit2.SecurityOrigin.SecurityOrigin) Ptr SecurityOrigin
result
    PermissionStateQuery -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PermissionStateQuery
query
    SecurityOrigin -> IO SecurityOrigin
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SecurityOrigin
result'

#if defined(ENABLE_OVERLOADING)
data PermissionStateQueryGetSecurityOriginMethodInfo
instance (signature ~ (m WebKit2.SecurityOrigin.SecurityOrigin), MonadIO m) => O.OverloadedMethod PermissionStateQueryGetSecurityOriginMethodInfo PermissionStateQuery signature where
    overloadedMethod = permissionStateQueryGetSecurityOrigin

instance O.OverloadedMethodInfo PermissionStateQueryGetSecurityOriginMethodInfo PermissionStateQuery where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Structs.PermissionStateQuery.permissionStateQueryGetSecurityOrigin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Structs-PermissionStateQuery.html#v:permissionStateQueryGetSecurityOrigin"
        })


#endif

-- method PermissionStateQuery::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PermissionStateQuery" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPermissionStateQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "PermissionStateQuery" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_permission_state_query_ref" webkit_permission_state_query_ref :: 
    Ptr PermissionStateQuery ->             -- query : TInterface (Name {namespace = "WebKit2", name = "PermissionStateQuery"})
    IO (Ptr PermissionStateQuery)

-- | Atomically increments the reference count of /@query@/ by one.
-- 
-- This function is MT-safe and may be called from any thread.
-- 
-- /Since: 2.40/
permissionStateQueryRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PermissionStateQuery
    -- ^ /@query@/: a t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery'
    -> m PermissionStateQuery
    -- ^ __Returns:__ The passed t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery'
permissionStateQueryRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PermissionStateQuery -> m PermissionStateQuery
permissionStateQueryRef PermissionStateQuery
query = IO PermissionStateQuery -> m PermissionStateQuery
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PermissionStateQuery -> m PermissionStateQuery)
-> IO PermissionStateQuery -> m PermissionStateQuery
forall a b. (a -> b) -> a -> b
$ do
    Ptr PermissionStateQuery
query' <- PermissionStateQuery -> IO (Ptr PermissionStateQuery)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PermissionStateQuery
query
    Ptr PermissionStateQuery
result <- Ptr PermissionStateQuery -> IO (Ptr PermissionStateQuery)
webkit_permission_state_query_ref Ptr PermissionStateQuery
query'
    Text -> Ptr PermissionStateQuery -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"permissionStateQueryRef" Ptr PermissionStateQuery
result
    PermissionStateQuery
result' <- ((ManagedPtr PermissionStateQuery -> PermissionStateQuery)
-> Ptr PermissionStateQuery -> IO PermissionStateQuery
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PermissionStateQuery -> PermissionStateQuery
PermissionStateQuery) Ptr PermissionStateQuery
result
    PermissionStateQuery -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PermissionStateQuery
query
    PermissionStateQuery -> IO PermissionStateQuery
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PermissionStateQuery
result'

#if defined(ENABLE_OVERLOADING)
data PermissionStateQueryRefMethodInfo
instance (signature ~ (m PermissionStateQuery), MonadIO m) => O.OverloadedMethod PermissionStateQueryRefMethodInfo PermissionStateQuery signature where
    overloadedMethod = permissionStateQueryRef

instance O.OverloadedMethodInfo PermissionStateQueryRefMethodInfo PermissionStateQuery where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Structs.PermissionStateQuery.permissionStateQueryRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Structs-PermissionStateQuery.html#v:permissionStateQueryRef"
        })


#endif

-- method PermissionStateQuery::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "query"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PermissionStateQuery" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPermissionStateQuery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_permission_state_query_unref" webkit_permission_state_query_unref :: 
    Ptr PermissionStateQuery ->             -- query : TInterface (Name {namespace = "WebKit2", name = "PermissionStateQuery"})
    IO ()

-- | Atomically decrements the reference count of /@query@/ by one.
-- 
-- If the reference count drops to 0, all memory allocated by t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery' is
-- released. This function is MT-safe and may be called from any thread.
-- 
-- /Since: 2.40/
permissionStateQueryUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PermissionStateQuery
    -- ^ /@query@/: a t'GI.WebKit2.Structs.PermissionStateQuery.PermissionStateQuery'
    -> m ()
permissionStateQueryUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PermissionStateQuery -> m ()
permissionStateQueryUnref PermissionStateQuery
query = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PermissionStateQuery
query' <- PermissionStateQuery -> IO (Ptr PermissionStateQuery)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PermissionStateQuery
query
    Ptr PermissionStateQuery -> IO ()
webkit_permission_state_query_unref Ptr PermissionStateQuery
query'
    PermissionStateQuery -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PermissionStateQuery
query
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PermissionStateQueryUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PermissionStateQueryUnrefMethodInfo PermissionStateQuery signature where
    overloadedMethod = permissionStateQueryUnref

instance O.OverloadedMethodInfo PermissionStateQueryUnrefMethodInfo PermissionStateQuery where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Structs.PermissionStateQuery.permissionStateQueryUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.30/docs/GI-WebKit2-Structs-PermissionStateQuery.html#v:permissionStateQueryUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePermissionStateQueryMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePermissionStateQueryMethod "finish" o = PermissionStateQueryFinishMethodInfo
    ResolvePermissionStateQueryMethod "ref" o = PermissionStateQueryRefMethodInfo
    ResolvePermissionStateQueryMethod "unref" o = PermissionStateQueryUnrefMethodInfo
    ResolvePermissionStateQueryMethod "getName" o = PermissionStateQueryGetNameMethodInfo
    ResolvePermissionStateQueryMethod "getSecurityOrigin" o = PermissionStateQueryGetSecurityOriginMethodInfo
    ResolvePermissionStateQueryMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePermissionStateQueryMethod t PermissionStateQuery, O.OverloadedMethod info PermissionStateQuery p, R.HasField t PermissionStateQuery p) => R.HasField t PermissionStateQuery p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePermissionStateQueryMethod t PermissionStateQuery, O.OverloadedMethodInfo info PermissionStateQuery) => OL.IsLabel t (O.MethodProxy info PermissionStateQuery) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif