{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a git proxy options.

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

module GI.Ggit.Objects.ProxyOptions
    ( 

-- * Exported types
    ProxyOptions(..)                        ,
    IsProxyOptions                          ,
    toProxyOptions                          ,


 -- * 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)
    ResolveProxyOptionsMethod               ,
#endif

-- ** new #method:new#

    proxyOptionsNew                         ,




    ) 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.Coerce as Coerce
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

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

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

foreign import ccall "ggit_proxy_options_get_type"
    c_ggit_proxy_options_get_type :: IO B.Types.GType

instance B.Types.TypedObject ProxyOptions where
    glibType :: IO GType
glibType = IO GType
c_ggit_proxy_options_get_type

instance B.Types.GObject ProxyOptions

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

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

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

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

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

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method ProxyOptions::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "ProxyOptions" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_proxy_options_new" ggit_proxy_options_new :: 
    IO (Ptr ProxyOptions)

-- | Create a new proxy options object.
proxyOptionsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe ProxyOptions)
    -- ^ __Returns:__ a t'GI.Ggit.Objects.ProxyOptions.ProxyOptions'.
proxyOptionsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe ProxyOptions)
proxyOptionsNew  = IO (Maybe ProxyOptions) -> m (Maybe ProxyOptions)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ProxyOptions) -> m (Maybe ProxyOptions))
-> IO (Maybe ProxyOptions) -> m (Maybe ProxyOptions)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProxyOptions
result <- IO (Ptr ProxyOptions)
ggit_proxy_options_new
    Maybe ProxyOptions
maybeResult <- Ptr ProxyOptions
-> (Ptr ProxyOptions -> IO ProxyOptions) -> IO (Maybe ProxyOptions)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ProxyOptions
result ((Ptr ProxyOptions -> IO ProxyOptions) -> IO (Maybe ProxyOptions))
-> (Ptr ProxyOptions -> IO ProxyOptions) -> IO (Maybe ProxyOptions)
forall a b. (a -> b) -> a -> b
$ \Ptr ProxyOptions
result' -> do
        ProxyOptions
result'' <- ((ManagedPtr ProxyOptions -> ProxyOptions)
-> Ptr ProxyOptions -> IO ProxyOptions
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ProxyOptions -> ProxyOptions
ProxyOptions) Ptr ProxyOptions
result'
        ProxyOptions -> IO ProxyOptions
forall (m :: * -> *) a. Monad m => a -> m a
return ProxyOptions
result''
    Maybe ProxyOptions -> IO (Maybe ProxyOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProxyOptions
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif