{-# 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.WebKit2.Objects.PolicyDecision
    ( 

-- * Exported types
    PolicyDecision(..)                      ,
    IsPolicyDecision                        ,
    toPolicyDecision                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [download]("GI.WebKit2.Objects.PolicyDecision#g:method:download"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [ignore]("GI.WebKit2.Objects.PolicyDecision#g:method:ignore"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [use]("GI.WebKit2.Objects.PolicyDecision#g:method:use"), [useWithPolicies]("GI.WebKit2.Objects.PolicyDecision#g:method:useWithPolicies"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePolicyDecisionMethod             ,
#endif

-- ** download #method:download#

#if defined(ENABLE_OVERLOADING)
    PolicyDecisionDownloadMethodInfo        ,
#endif
    policyDecisionDownload                  ,


-- ** ignore #method:ignore#

#if defined(ENABLE_OVERLOADING)
    PolicyDecisionIgnoreMethodInfo          ,
#endif
    policyDecisionIgnore                    ,


-- ** use #method:use#

#if defined(ENABLE_OVERLOADING)
    PolicyDecisionUseMethodInfo             ,
#endif
    policyDecisionUse                       ,


-- ** useWithPolicies #method:useWithPolicies#

#if defined(ENABLE_OVERLOADING)
    PolicyDecisionUseWithPoliciesMethodInfo ,
#endif
    policyDecisionUseWithPolicies           ,




    ) 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.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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.WebKit2.Objects.WebsitePolicies as WebKit2.WebsitePolicies

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

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

foreign import ccall "webkit_policy_decision_get_type"
    c_webkit_policy_decision_get_type :: IO B.Types.GType

instance B.Types.TypedObject PolicyDecision where
    glibType :: IO GType
glibType = IO GType
c_webkit_policy_decision_get_type

instance B.Types.GObject PolicyDecision

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

instance O.HasParentTypes PolicyDecision
type instance O.ParentTypes PolicyDecision = '[GObject.Object.Object]

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

-- | Convert 'PolicyDecision' 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 PolicyDecision) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_policy_decision_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PolicyDecision -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PolicyDecision
P.Nothing = Ptr GValue -> Ptr PolicyDecision -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr PolicyDecision
forall a. Ptr a
FP.nullPtr :: FP.Ptr PolicyDecision)
    gvalueSet_ Ptr GValue
gv (P.Just PolicyDecision
obj) = PolicyDecision -> (Ptr PolicyDecision -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PolicyDecision
obj (Ptr GValue -> Ptr PolicyDecision -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PolicyDecision)
gvalueGet_ Ptr GValue
gv = do
        Ptr PolicyDecision
ptr <- Ptr GValue -> IO (Ptr PolicyDecision)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr PolicyDecision)
        if Ptr PolicyDecision
ptr Ptr PolicyDecision -> Ptr PolicyDecision -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr PolicyDecision
forall a. Ptr a
FP.nullPtr
        then PolicyDecision -> Maybe PolicyDecision
forall a. a -> Maybe a
P.Just (PolicyDecision -> Maybe PolicyDecision)
-> IO PolicyDecision -> IO (Maybe PolicyDecision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr PolicyDecision -> PolicyDecision)
-> Ptr PolicyDecision -> IO PolicyDecision
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr PolicyDecision -> PolicyDecision
PolicyDecision Ptr PolicyDecision
ptr
        else Maybe PolicyDecision -> IO (Maybe PolicyDecision)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PolicyDecision
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePolicyDecisionMethod (t :: Symbol) (o :: *) :: * where
    ResolvePolicyDecisionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePolicyDecisionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePolicyDecisionMethod "download" o = PolicyDecisionDownloadMethodInfo
    ResolvePolicyDecisionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePolicyDecisionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePolicyDecisionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePolicyDecisionMethod "ignore" o = PolicyDecisionIgnoreMethodInfo
    ResolvePolicyDecisionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePolicyDecisionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePolicyDecisionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePolicyDecisionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePolicyDecisionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePolicyDecisionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePolicyDecisionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePolicyDecisionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePolicyDecisionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePolicyDecisionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePolicyDecisionMethod "use" o = PolicyDecisionUseMethodInfo
    ResolvePolicyDecisionMethod "useWithPolicies" o = PolicyDecisionUseWithPoliciesMethodInfo
    ResolvePolicyDecisionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePolicyDecisionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePolicyDecisionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePolicyDecisionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePolicyDecisionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePolicyDecisionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePolicyDecisionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePolicyDecisionMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePolicyDecisionMethod t PolicyDecision, O.OverloadedMethod info PolicyDecision p) => OL.IsLabel t (PolicyDecision -> 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 ~ ResolvePolicyDecisionMethod t PolicyDecision, O.OverloadedMethod info PolicyDecision p, R.HasField t PolicyDecision p) => R.HasField t PolicyDecision p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PolicyDecision
type instance O.AttributeList PolicyDecision = PolicyDecisionAttributeList
type PolicyDecisionAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "webkit_policy_decision_download" webkit_policy_decision_download :: 
    Ptr PolicyDecision ->                   -- decision : TInterface (Name {namespace = "WebKit2", name = "PolicyDecision"})
    IO ()

-- | Spawn a download from this decision.
policyDecisionDownload ::
    (B.CallStack.HasCallStack, MonadIO m, IsPolicyDecision a) =>
    a
    -- ^ /@decision@/: a t'GI.WebKit2.Objects.PolicyDecision.PolicyDecision'
    -> m ()
policyDecisionDownload :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPolicyDecision a) =>
a -> m ()
policyDecisionDownload a
decision = 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 PolicyDecision
decision' <- a -> IO (Ptr PolicyDecision)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decision
    Ptr PolicyDecision -> IO ()
webkit_policy_decision_download Ptr PolicyDecision
decision'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decision
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PolicyDecisionDownloadMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPolicyDecision a) => O.OverloadedMethod PolicyDecisionDownloadMethodInfo a signature where
    overloadedMethod = policyDecisionDownload

instance O.OverloadedMethodInfo PolicyDecisionDownloadMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.PolicyDecision.policyDecisionDownload",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-PolicyDecision.html#v:policyDecisionDownload"
        }


#endif

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

foreign import ccall "webkit_policy_decision_ignore" webkit_policy_decision_ignore :: 
    Ptr PolicyDecision ->                   -- decision : TInterface (Name {namespace = "WebKit2", name = "PolicyDecision"})
    IO ()

-- | Ignore the action which triggered this decision. For instance, for a
-- t'GI.WebKit2.Objects.ResponsePolicyDecision.ResponsePolicyDecision', this would cancel the request.
policyDecisionIgnore ::
    (B.CallStack.HasCallStack, MonadIO m, IsPolicyDecision a) =>
    a
    -- ^ /@decision@/: a t'GI.WebKit2.Objects.PolicyDecision.PolicyDecision'
    -> m ()
policyDecisionIgnore :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPolicyDecision a) =>
a -> m ()
policyDecisionIgnore a
decision = 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 PolicyDecision
decision' <- a -> IO (Ptr PolicyDecision)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decision
    Ptr PolicyDecision -> IO ()
webkit_policy_decision_ignore Ptr PolicyDecision
decision'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decision
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PolicyDecisionIgnoreMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPolicyDecision a) => O.OverloadedMethod PolicyDecisionIgnoreMethodInfo a signature where
    overloadedMethod = policyDecisionIgnore

instance O.OverloadedMethodInfo PolicyDecisionIgnoreMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.PolicyDecision.policyDecisionIgnore",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-PolicyDecision.html#v:policyDecisionIgnore"
        }


#endif

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

foreign import ccall "webkit_policy_decision_use" webkit_policy_decision_use :: 
    Ptr PolicyDecision ->                   -- decision : TInterface (Name {namespace = "WebKit2", name = "PolicyDecision"})
    IO ()

-- | Accept the action which triggered this decision.
policyDecisionUse ::
    (B.CallStack.HasCallStack, MonadIO m, IsPolicyDecision a) =>
    a
    -- ^ /@decision@/: a t'GI.WebKit2.Objects.PolicyDecision.PolicyDecision'
    -> m ()
policyDecisionUse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPolicyDecision a) =>
a -> m ()
policyDecisionUse a
decision = 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 PolicyDecision
decision' <- a -> IO (Ptr PolicyDecision)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decision
    Ptr PolicyDecision -> IO ()
webkit_policy_decision_use Ptr PolicyDecision
decision'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decision
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PolicyDecisionUseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPolicyDecision a) => O.OverloadedMethod PolicyDecisionUseMethodInfo a signature where
    overloadedMethod = policyDecisionUse

instance O.OverloadedMethodInfo PolicyDecisionUseMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.PolicyDecision.policyDecisionUse",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-PolicyDecision.html#v:policyDecisionUse"
        }


#endif

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

foreign import ccall "webkit_policy_decision_use_with_policies" webkit_policy_decision_use_with_policies :: 
    Ptr PolicyDecision ->                   -- decision : TInterface (Name {namespace = "WebKit2", name = "PolicyDecision"})
    Ptr WebKit2.WebsitePolicies.WebsitePolicies -> -- policies : TInterface (Name {namespace = "WebKit2", name = "WebsitePolicies"})
    IO ()

-- | Accept the navigation action which triggered this decision, and
-- continue with /@policies@/ affecting all subsequent loads of resources
-- in the origin associated with the accepted navigation action.
-- 
-- For example, a navigation decision to a video sharing website may
-- be accepted under the priviso no movies are allowed to autoplay. The
-- autoplay policy in this case would be set in the /@policies@/.
-- 
-- /Since: 2.30/
policyDecisionUseWithPolicies ::
    (B.CallStack.HasCallStack, MonadIO m, IsPolicyDecision a, WebKit2.WebsitePolicies.IsWebsitePolicies b) =>
    a
    -- ^ /@decision@/: a t'GI.WebKit2.Objects.PolicyDecision.PolicyDecision'
    -> b
    -- ^ /@policies@/: a t'GI.WebKit2.Objects.WebsitePolicies.WebsitePolicies'
    -> m ()
policyDecisionUseWithPolicies :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPolicyDecision a,
 IsWebsitePolicies b) =>
a -> b -> m ()
policyDecisionUseWithPolicies a
decision b
policies = 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 PolicyDecision
decision' <- a -> IO (Ptr PolicyDecision)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
decision
    Ptr WebsitePolicies
policies' <- b -> IO (Ptr WebsitePolicies)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
policies
    Ptr PolicyDecision -> Ptr WebsitePolicies -> IO ()
webkit_policy_decision_use_with_policies Ptr PolicyDecision
decision' Ptr WebsitePolicies
policies'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
decision
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
policies
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PolicyDecisionUseWithPoliciesMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPolicyDecision a, WebKit2.WebsitePolicies.IsWebsitePolicies b) => O.OverloadedMethod PolicyDecisionUseWithPoliciesMethodInfo a signature where
    overloadedMethod = policyDecisionUseWithPolicies

instance O.OverloadedMethodInfo PolicyDecisionUseWithPoliciesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.PolicyDecision.policyDecisionUseWithPolicies",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-PolicyDecision.html#v:policyDecisionUseWithPolicies"
        }


#endif