{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Interface for miscellaneous [class/@session@/] features.
-- 
-- t'GI.Soup.Interfaces.SessionFeature.SessionFeature' is the interface used by classes that extend
-- the functionality of a [class/@session@/]. Some features like HTTP
-- authentication handling are implemented internally via
-- @SoupSessionFeature@s. Other features can be added to the session
-- by the application. (Eg, [class/@logger@/], [class/@cookieJar@/].)
-- 
-- See [method/@session@/.add_feature], etc, to add a feature to a session.

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

module GI.Soup.Interfaces.SessionFeature
    ( 

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


 -- * 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"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [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"), [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)
    ResolveSessionFeatureMethod             ,
#endif



    ) 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 qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "soup_session_feature_get_type"
    c_soup_session_feature_get_type :: IO B.Types.GType

instance B.Types.TypedObject SessionFeature where
    glibType :: IO GType
glibType = IO GType
c_soup_session_feature_get_type

instance B.Types.GObject SessionFeature

-- | Type class for types which can be safely cast to `SessionFeature`, for instance with `toSessionFeature`.
class (SP.GObject o, O.IsDescendantOf SessionFeature o) => IsSessionFeature o
instance (SP.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 :: (MIO.MonadIO m, IsSessionFeature o) => o -> m SessionFeature
toSessionFeature :: forall (m :: * -> *) o.
(MonadIO m, IsSessionFeature o) =>
o -> m SessionFeature
toSessionFeature = IO SessionFeature -> m SessionFeature
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SessionFeature -> SessionFeature
SessionFeature

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSessionFeatureMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSessionFeatureMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSessionFeatureMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSessionFeatureMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSessionFeatureMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSessionFeatureMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    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 "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.OverloadedMethod 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

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

#endif

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

#endif

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

#endif