{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An object that implement some sort of optional feature for
-- t'GI.Soup.Objects.Session.Session'.
-- 
-- /Since: 2.24/

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

module GI.Soup.Interfaces.SessionFeature
    ( 

-- * Exported types
    SessionFeature(..)                      ,
    noSessionFeature                        ,
    IsSessionFeature                        ,
    toSessionFeature                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveSessionFeatureMethod             ,
#endif


-- ** addFeature #method:addFeature#

#if defined(ENABLE_OVERLOADING)
    SessionFeatureAddFeatureMethodInfo      ,
#endif
    sessionFeatureAddFeature                ,


-- ** attach #method:attach#

#if defined(ENABLE_OVERLOADING)
    SessionFeatureAttachMethodInfo          ,
#endif
    sessionFeatureAttach                    ,


-- ** detach #method:detach#

#if defined(ENABLE_OVERLOADING)
    SessionFeatureDetachMethodInfo          ,
#endif
    sessionFeatureDetach                    ,


-- ** hasFeature #method:hasFeature#

#if defined(ENABLE_OVERLOADING)
    SessionFeatureHasFeatureMethodInfo      ,
#endif
    sessionFeatureHasFeature                ,


-- ** removeFeature #method:removeFeature#

#if defined(ENABLE_OVERLOADING)
    SessionFeatureRemoveFeatureMethodInfo   ,
#endif
    sessionFeatureRemoveFeature             ,




    ) 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.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 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.Soup.Objects.Session as Soup.Session

-- interface SessionFeature 
-- | Memory-managed wrapper type.
newtype SessionFeature = SessionFeature (ManagedPtr SessionFeature)
    deriving (SessionFeature -> SessionFeature -> Bool
(SessionFeature -> SessionFeature -> Bool)
-> (SessionFeature -> SessionFeature -> Bool) -> Eq SessionFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionFeature -> SessionFeature -> Bool
$c/= :: SessionFeature -> SessionFeature -> Bool
== :: SessionFeature -> SessionFeature -> Bool
$c== :: SessionFeature -> SessionFeature -> Bool
Eq)
-- | A convenience alias for `Nothing` :: `Maybe` `SessionFeature`.
noSessionFeature :: Maybe SessionFeature
noSessionFeature :: Maybe SessionFeature
noSessionFeature = Maybe SessionFeature
forall a. Maybe a
Nothing

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

#endif

foreign import ccall "soup_session_feature_get_type"
    c_soup_session_feature_get_type :: IO GType

instance GObject SessionFeature where
    gobjectType :: IO GType
gobjectType = IO GType
c_soup_session_feature_get_type
    

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

-- | Type class for types which can be safely cast to `SessionFeature`, for instance with `toSessionFeature`.
class (GObject o, O.IsDescendantOf SessionFeature o) => IsSessionFeature o
instance (GObject o, O.IsDescendantOf SessionFeature o) => IsSessionFeature o

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSessionFeatureMethod (t :: Symbol) (o :: *) :: * where
    ResolveSessionFeatureMethod "addFeature" o = SessionFeatureAddFeatureMethodInfo
    ResolveSessionFeatureMethod "attach" o = SessionFeatureAttachMethodInfo
    ResolveSessionFeatureMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSessionFeatureMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSessionFeatureMethod "detach" o = SessionFeatureDetachMethodInfo
    ResolveSessionFeatureMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSessionFeatureMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSessionFeatureMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSessionFeatureMethod "hasFeature" o = SessionFeatureHasFeatureMethodInfo
    ResolveSessionFeatureMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSessionFeatureMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSessionFeatureMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSessionFeatureMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSessionFeatureMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSessionFeatureMethod "removeFeature" o = SessionFeatureRemoveFeatureMethodInfo
    ResolveSessionFeatureMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSessionFeatureMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSessionFeatureMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSessionFeatureMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSessionFeatureMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSessionFeatureMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSessionFeatureMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSessionFeatureMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSessionFeatureMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSessionFeatureMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSessionFeatureMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSessionFeatureMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSessionFeatureMethod l o = O.MethodResolutionFailed l o

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

#endif

-- method SessionFeature::add_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the \"base\" feature"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of a \"sub-feature\""
--                 , 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 "soup_session_feature_add_feature" soup_session_feature_add_feature :: 
    Ptr SessionFeature ->                   -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Adds a \"sub-feature\" of type /@type@/ to the base feature /@feature@/.
-- This is used for features that can be extended with multiple
-- different types. Eg, the authentication manager can be extended
-- with subtypes of t'GI.Soup.Objects.Auth.Auth'.
-- 
-- /Since: 2.34/
sessionFeatureAddFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSessionFeature a) =>
    a
    -- ^ /@feature@/: the \"base\" feature
    -> GType
    -- ^ /@type@/: the t'GType' of a \"sub-feature\"
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@feature@/ accepted /@type@/ as a subfeature.
sessionFeatureAddFeature :: a -> GType -> m Bool
sessionFeatureAddFeature feature :: a
feature type_ :: GType
type_ = 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 SessionFeature
feature' <- a -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
feature
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr SessionFeature -> CGType -> IO CInt
soup_session_feature_add_feature Ptr SessionFeature
feature' CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
feature
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SessionFeatureAddFeatureMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m, IsSessionFeature a) => O.MethodInfo SessionFeatureAddFeatureMethodInfo a signature where
    overloadedMethod = sessionFeatureAddFeature

#endif

-- method SessionFeature::attach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_feature_attach" soup_session_feature_attach :: 
    Ptr SessionFeature ->                   -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    Ptr Soup.Session.Session ->             -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO ()

-- | /No description available in the introspection data./
sessionFeatureAttach ::
    (B.CallStack.HasCallStack, MonadIO m, IsSessionFeature a, Soup.Session.IsSession b) =>
    a
    -> b
    -> m ()
sessionFeatureAttach :: a -> b -> m ()
sessionFeatureAttach feature :: a
feature session :: b
session = 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 SessionFeature
feature' <- a -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
feature
    Ptr Session
session' <- b -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
session
    Ptr SessionFeature -> Ptr Session -> IO ()
soup_session_feature_attach Ptr SessionFeature
feature' Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
feature
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
session
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionFeatureAttachMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSessionFeature a, Soup.Session.IsSession b) => O.MethodInfo SessionFeatureAttachMethodInfo a signature where
    overloadedMethod = sessionFeatureAttach

#endif

-- method SessionFeature::detach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Session" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_session_feature_detach" soup_session_feature_detach :: 
    Ptr SessionFeature ->                   -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    Ptr Soup.Session.Session ->             -- session : TInterface (Name {namespace = "Soup", name = "Session"})
    IO ()

-- | /No description available in the introspection data./
sessionFeatureDetach ::
    (B.CallStack.HasCallStack, MonadIO m, IsSessionFeature a, Soup.Session.IsSession b) =>
    a
    -> b
    -> m ()
sessionFeatureDetach :: a -> b -> m ()
sessionFeatureDetach feature :: a
feature session :: b
session = 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 SessionFeature
feature' <- a -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
feature
    Ptr Session
session' <- b -> IO (Ptr Session)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
session
    Ptr SessionFeature -> Ptr Session -> IO ()
soup_session_feature_detach Ptr SessionFeature
feature' Ptr Session
session'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
feature
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
session
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SessionFeatureDetachMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSessionFeature a, Soup.Session.IsSession b) => O.MethodInfo SessionFeatureDetachMethodInfo a signature where
    overloadedMethod = sessionFeatureDetach

#endif

-- method SessionFeature::has_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the \"base\" feature"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of a \"sub-feature\""
--                 , 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 "soup_session_feature_has_feature" soup_session_feature_has_feature :: 
    Ptr SessionFeature ->                   -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Tests if /@feature@/ has a \"sub-feature\" of type /@type@/. See
-- 'GI.Soup.Interfaces.SessionFeature.sessionFeatureAddFeature'.
-- 
-- /Since: 2.34/
sessionFeatureHasFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSessionFeature a) =>
    a
    -- ^ /@feature@/: the \"base\" feature
    -> GType
    -- ^ /@type@/: the t'GType' of a \"sub-feature\"
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@feature@/ has a subfeature of type /@type@/
sessionFeatureHasFeature :: a -> GType -> m Bool
sessionFeatureHasFeature feature :: a
feature type_ :: GType
type_ = 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 SessionFeature
feature' <- a -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
feature
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr SessionFeature -> CGType -> IO CInt
soup_session_feature_has_feature Ptr SessionFeature
feature' CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
feature
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SessionFeatureHasFeatureMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m, IsSessionFeature a) => O.MethodInfo SessionFeatureHasFeatureMethodInfo a signature where
    overloadedMethod = sessionFeatureHasFeature

#endif

-- method SessionFeature::remove_feature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "feature"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SessionFeature" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the \"base\" feature"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of a \"sub-feature\""
--                 , 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 "soup_session_feature_remove_feature" soup_session_feature_remove_feature :: 
    Ptr SessionFeature ->                   -- feature : TInterface (Name {namespace = "Soup", name = "SessionFeature"})
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Removes the \"sub-feature\" of type /@type@/ from the base feature
-- /@feature@/. See 'GI.Soup.Interfaces.SessionFeature.sessionFeatureAddFeature'.
-- 
-- /Since: 2.34/
sessionFeatureRemoveFeature ::
    (B.CallStack.HasCallStack, MonadIO m, IsSessionFeature a) =>
    a
    -- ^ /@feature@/: the \"base\" feature
    -> GType
    -- ^ /@type@/: the t'GType' of a \"sub-feature\"
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@type@/ was removed from /@feature@/
sessionFeatureRemoveFeature :: a -> GType -> m Bool
sessionFeatureRemoveFeature feature :: a
feature type_ :: GType
type_ = 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 SessionFeature
feature' <- a -> IO (Ptr SessionFeature)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
feature
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr SessionFeature -> CGType -> IO CInt
soup_session_feature_remove_feature Ptr SessionFeature
feature' CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
feature
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SessionFeatureRemoveFeatureMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m, IsSessionFeature a) => O.MethodInfo SessionFeatureRemoveFeatureMethodInfo a signature where
    overloadedMethod = sessionFeatureRemoveFeature

#endif