{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.GObject.Objects.BindingGroup.BindingGroup' can be used to bind multiple properties
-- from an object collectively.
-- 
-- Use the various methods to bind properties from a single source
-- object to multiple destination objects. Properties can be bound
-- bidirectionally and are connected when the source object is set
-- with 'GI.GObject.Objects.BindingGroup.bindingGroupSetSource'.
-- 
-- /Since: 2.72/

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

module GI.GObject.Objects.BindingGroup
    ( 

-- * Exported types
    BindingGroup(..)                        ,
    IsBindingGroup                          ,
    toBindingGroup                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bind]("GI.GObject.Objects.BindingGroup#g:method:bind"), [bindFull]("GI.GObject.Objects.BindingGroup#g:method:bindFull"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [dupSource]("GI.GObject.Objects.BindingGroup#g:method:dupSource"), [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"), [setSource]("GI.GObject.Objects.BindingGroup#g:method:setSource").

#if defined(ENABLE_OVERLOADING)
    ResolveBindingGroupMethod               ,
#endif

-- ** bind #method:bind#

#if defined(ENABLE_OVERLOADING)
    BindingGroupBindMethodInfo              ,
#endif
    bindingGroupBind                        ,


-- ** bindFull #method:bindFull#

#if defined(ENABLE_OVERLOADING)
    BindingGroupBindFullMethodInfo          ,
#endif
    bindingGroupBindFull                    ,


-- ** dupSource #method:dupSource#

#if defined(ENABLE_OVERLOADING)
    BindingGroupDupSourceMethodInfo         ,
#endif
    bindingGroupDupSource                   ,


-- ** new #method:new#

    bindingGroupNew                         ,


-- ** setSource #method:setSource#

#if defined(ENABLE_OVERLOADING)
    BindingGroupSetSourceMethodInfo         ,
#endif
    bindingGroupSetSource                   ,




 -- * Properties


-- ** source #attr:source#
-- | The source object used for binding properties.
-- 
-- /Since: 2.72/

#if defined(ENABLE_OVERLOADING)
    BindingGroupSourcePropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    bindingGroupSource                      ,
#endif
    clearBindingGroupSource                 ,
    constructBindingGroupSource             ,
    getBindingGroupSource                   ,
    setBindingGroupSource                   ,




    ) 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.GObject.Flags as GObject.Flags
import {-# SOURCE #-} qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "g_binding_group_get_type"
    c_g_binding_group_get_type :: IO B.Types.GType

instance B.Types.TypedObject BindingGroup where
    glibType :: IO GType
glibType = IO GType
c_g_binding_group_get_type

instance B.Types.GObject BindingGroup

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "source"
   -- Type: TInterface (Name {namespace = "GObject", name = "Object"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@source@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' bindingGroup #source
-- @
getBindingGroupSource :: (MonadIO m, IsBindingGroup o) => o -> m (Maybe GObject.Object.Object)
getBindingGroupSource :: forall (m :: * -> *) o.
(MonadIO m, IsBindingGroup o) =>
o -> m (Maybe Object)
getBindingGroupSource o
obj = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Object -> Object) -> IO (Maybe Object)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"source" ManagedPtr Object -> Object
GObject.Object.Object

-- | Set the value of the “@source@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' bindingGroup [ #source 'Data.GI.Base.Attributes.:=' value ]
-- @
setBindingGroupSource :: (MonadIO m, IsBindingGroup o, GObject.Object.IsObject a) => o -> a -> m ()
setBindingGroupSource :: forall (m :: * -> *) o a.
(MonadIO m, IsBindingGroup o, IsObject a) =>
o -> a -> m ()
setBindingGroupSource o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"source" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@source@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBindingGroupSource :: (IsBindingGroup o, MIO.MonadIO m, GObject.Object.IsObject a) => a -> m (GValueConstruct o)
constructBindingGroupSource :: forall o (m :: * -> *) a.
(IsBindingGroup o, MonadIO m, IsObject a) =>
a -> m (GValueConstruct o)
constructBindingGroupSource a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"source" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@source@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #source
-- @
clearBindingGroupSource :: (MonadIO m, IsBindingGroup o) => o -> m ()
clearBindingGroupSource :: forall (m :: * -> *) o. (MonadIO m, IsBindingGroup o) => o -> m ()
clearBindingGroupSource o
obj = 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
$ o -> String -> Maybe Object -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"source" (Maybe Object
forall a. Maybe a
Nothing :: Maybe GObject.Object.Object)

#if defined(ENABLE_OVERLOADING)
data BindingGroupSourcePropertyInfo
instance AttrInfo BindingGroupSourcePropertyInfo where
    type AttrAllowedOps BindingGroupSourcePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BindingGroupSourcePropertyInfo = IsBindingGroup
    type AttrSetTypeConstraint BindingGroupSourcePropertyInfo = GObject.Object.IsObject
    type AttrTransferTypeConstraint BindingGroupSourcePropertyInfo = GObject.Object.IsObject
    type AttrTransferType BindingGroupSourcePropertyInfo = GObject.Object.Object
    type AttrGetType BindingGroupSourcePropertyInfo = (Maybe GObject.Object.Object)
    type AttrLabel BindingGroupSourcePropertyInfo = "source"
    type AttrOrigin BindingGroupSourcePropertyInfo = BindingGroup
    attrGet = getBindingGroupSource
    attrSet = setBindingGroupSource
    attrTransfer _ v = do
        unsafeCastTo GObject.Object.Object v
    attrConstruct = constructBindingGroupSource
    attrClear = clearBindingGroupSource
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Objects.BindingGroup.source"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.30/docs/GI-GObject-Objects-BindingGroup.html#g:attr:source"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BindingGroup
type instance O.AttributeList BindingGroup = BindingGroupAttributeList
type BindingGroupAttributeList = ('[ '("source", BindingGroupSourcePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
bindingGroupSource :: AttrLabelProxy "source"
bindingGroupSource = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "g_binding_group_new" g_binding_group_new :: 
    IO (Ptr BindingGroup)

-- | Creates a new t'GI.GObject.Objects.BindingGroup.BindingGroup'.
-- 
-- /Since: 2.72/
bindingGroupNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m BindingGroup
    -- ^ __Returns:__ a new t'GI.GObject.Objects.BindingGroup.BindingGroup'
bindingGroupNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m BindingGroup
bindingGroupNew  = IO BindingGroup -> m BindingGroup
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BindingGroup -> m BindingGroup)
-> IO BindingGroup -> m BindingGroup
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingGroup
result <- IO (Ptr BindingGroup)
g_binding_group_new
    Text -> Ptr BindingGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bindingGroupNew" Ptr BindingGroup
result
    BindingGroup
result' <- ((ManagedPtr BindingGroup -> BindingGroup)
-> Ptr BindingGroup -> IO BindingGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BindingGroup -> BindingGroup
BindingGroup) Ptr BindingGroup
result
    BindingGroup -> IO BindingGroup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BindingGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BindingGroup::bind
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GBindingGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property on the source to bind"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target #GObject"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property on @target to bind"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flags used to create the #GBinding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_binding_group_bind" g_binding_group_bind :: 
    Ptr BindingGroup ->                     -- self : TInterface (Name {namespace = "GObject", name = "BindingGroup"})
    CString ->                              -- source_property : TBasicType TUTF8
    Ptr GObject.Object.Object ->            -- target : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- target_property : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "GObject", name = "BindingFlags"})
    IO ()

-- | Creates a binding between /@sourceProperty@/ on the source object
-- and /@targetProperty@/ on /@target@/. Whenever the /@sourceProperty@/
-- is changed the /@targetProperty@/ is updated using the same value.
-- The binding flag 'GI.GObject.Flags.BindingFlagsSyncCreate' is automatically specified.
-- 
-- See 'GI.GObject.Objects.Object.objectBindProperty' for more information.
-- 
-- /Since: 2.72/
bindingGroupBind ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingGroup a, GObject.Object.IsObject b) =>
    a
    -- ^ /@self@/: the t'GI.GObject.Objects.BindingGroup.BindingGroup'
    -> T.Text
    -- ^ /@sourceProperty@/: the property on the source to bind
    -> b
    -- ^ /@target@/: the target t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@targetProperty@/: the property on /@target@/ to bind
    -> [GObject.Flags.BindingFlags]
    -- ^ /@flags@/: the flags used to create the t'GI.GObject.Objects.Binding.Binding'
    -> m ()
bindingGroupBind :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBindingGroup a, IsObject b) =>
a -> Text -> b -> Text -> [BindingFlags] -> m ()
bindingGroupBind a
self Text
sourceProperty b
target Text
targetProperty [BindingFlags]
flags = 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 BindingGroup
self' <- a -> IO (Ptr BindingGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
sourceProperty' <- Text -> IO CString
textToCString Text
sourceProperty
    Ptr Object
target' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
target
    CString
targetProperty' <- Text -> IO CString
textToCString Text
targetProperty
    let flags' :: CUInt
flags' = [BindingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BindingFlags]
flags
    Ptr BindingGroup
-> CString -> Ptr Object -> CString -> CUInt -> IO ()
g_binding_group_bind Ptr BindingGroup
self' CString
sourceProperty' Ptr Object
target' CString
targetProperty' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceProperty'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetProperty'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingGroupBindMethodInfo
instance (signature ~ (T.Text -> b -> T.Text -> [GObject.Flags.BindingFlags] -> m ()), MonadIO m, IsBindingGroup a, GObject.Object.IsObject b) => O.OverloadedMethod BindingGroupBindMethodInfo a signature where
    overloadedMethod = bindingGroupBind

instance O.OverloadedMethodInfo BindingGroupBindMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Objects.BindingGroup.bindingGroupBind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.30/docs/GI-GObject-Objects-BindingGroup.html#v:bindingGroupBind"
        })


#endif

-- method BindingGroup::bind_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GBindingGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property on the source to bind"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the target #GObject"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property on @target to bind"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flags used to create the #GBinding"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transform_to"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GClosure wrapping the\n    transformation function from the source object to the @target,\n    or %NULL to use the default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transform_from"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GClosure wrapping the\n    transformation function from the @target to the source object,\n    or %NULL to use the default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_binding_group_bind_with_closures" g_binding_group_bind_with_closures :: 
    Ptr BindingGroup ->                     -- self : TInterface (Name {namespace = "GObject", name = "BindingGroup"})
    CString ->                              -- source_property : TBasicType TUTF8
    Ptr GObject.Object.Object ->            -- target : TInterface (Name {namespace = "GObject", name = "Object"})
    CString ->                              -- target_property : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "GObject", name = "BindingFlags"})
    Ptr (GClosure ()) ->                    -- transform_to : TGClosure Nothing
    Ptr (GClosure ()) ->                    -- transform_from : TGClosure Nothing
    IO ()

-- | Creates a binding between /@sourceProperty@/ on the source object and
-- /@targetProperty@/ on /@target@/, allowing you to set the transformation
-- functions to be used by the binding. The binding flag
-- 'GI.GObject.Flags.BindingFlagsSyncCreate' is automatically specified.
-- 
-- This function is the language bindings friendly version of
-- @/g_binding_group_bind_property_full()/@, using @/GClosures/@
-- instead of function pointers.
-- 
-- See 'GI.GObject.Objects.Object.objectBindPropertyFull' for more information.
-- 
-- /Since: 2.72/
bindingGroupBindFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingGroup a, GObject.Object.IsObject b) =>
    a
    -- ^ /@self@/: the t'GI.GObject.Objects.BindingGroup.BindingGroup'
    -> T.Text
    -- ^ /@sourceProperty@/: the property on the source to bind
    -> b
    -- ^ /@target@/: the target t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@targetProperty@/: the property on /@target@/ to bind
    -> [GObject.Flags.BindingFlags]
    -- ^ /@flags@/: the flags used to create the t'GI.GObject.Objects.Binding.Binding'
    -> Maybe (GClosure c)
    -- ^ /@transformTo@/: a t'GI.GObject.Structs.Closure.Closure' wrapping the
    --     transformation function from the source object to the /@target@/,
    --     or 'P.Nothing' to use the default
    -> Maybe (GClosure d)
    -- ^ /@transformFrom@/: a t'GI.GObject.Structs.Closure.Closure' wrapping the
    --     transformation function from the /@target@/ to the source object,
    --     or 'P.Nothing' to use the default
    -> m ()
bindingGroupBindFull :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsBindingGroup a, IsObject b) =>
a
-> Text
-> b
-> Text
-> [BindingFlags]
-> Maybe (GClosure c)
-> Maybe (GClosure d)
-> m ()
bindingGroupBindFull a
self Text
sourceProperty b
target Text
targetProperty [BindingFlags]
flags Maybe (GClosure c)
transformTo Maybe (GClosure d)
transformFrom = 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 BindingGroup
self' <- a -> IO (Ptr BindingGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
sourceProperty' <- Text -> IO CString
textToCString Text
sourceProperty
    Ptr Object
target' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
target
    CString
targetProperty' <- Text -> IO CString
textToCString Text
targetProperty
    let flags' :: CUInt
flags' = [BindingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BindingFlags]
flags
    Ptr (GClosure ())
maybeTransformTo <- case Maybe (GClosure c)
transformTo of
        Maybe (GClosure c)
Nothing -> Ptr (GClosure ()) -> IO (Ptr (GClosure ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GClosure ())
forall a. Ptr a
nullPtr
        Just GClosure c
jTransformTo -> do
            Ptr (GClosure ())
jTransformTo' <- GClosure c -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure c
jTransformTo
            Ptr (GClosure ()) -> IO (Ptr (GClosure ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GClosure ())
jTransformTo'
    Ptr (GClosure ())
maybeTransformFrom <- case Maybe (GClosure d)
transformFrom of
        Maybe (GClosure d)
Nothing -> Ptr (GClosure ()) -> IO (Ptr (GClosure ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GClosure ())
forall a. Ptr a
nullPtr
        Just GClosure d
jTransformFrom -> do
            Ptr (GClosure ())
jTransformFrom' <- GClosure d -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure d
jTransformFrom
            Ptr (GClosure ()) -> IO (Ptr (GClosure ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GClosure ())
jTransformFrom'
    Ptr BindingGroup
-> CString
-> Ptr Object
-> CString
-> CUInt
-> Ptr (GClosure ())
-> Ptr (GClosure ())
-> IO ()
g_binding_group_bind_with_closures Ptr BindingGroup
self' CString
sourceProperty' Ptr Object
target' CString
targetProperty' CUInt
flags' Ptr (GClosure ())
maybeTransformTo Ptr (GClosure ())
maybeTransformFrom
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    Maybe (GClosure c) -> (GClosure c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GClosure c)
transformTo GClosure c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe (GClosure d) -> (GClosure d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GClosure d)
transformFrom GClosure d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceProperty'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetProperty'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingGroupBindFullMethodInfo
instance (signature ~ (T.Text -> b -> T.Text -> [GObject.Flags.BindingFlags] -> Maybe (GClosure c) -> Maybe (GClosure d) -> m ()), MonadIO m, IsBindingGroup a, GObject.Object.IsObject b) => O.OverloadedMethod BindingGroupBindFullMethodInfo a signature where
    overloadedMethod = bindingGroupBindFull

instance O.OverloadedMethodInfo BindingGroupBindFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Objects.BindingGroup.bindingGroupBindFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.30/docs/GI-GObject-Objects-BindingGroup.html#v:bindingGroupBindFull"
        })


#endif

-- method BindingGroup::dup_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GBindingGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "g_binding_group_dup_source" g_binding_group_dup_source :: 
    Ptr BindingGroup ->                     -- self : TInterface (Name {namespace = "GObject", name = "BindingGroup"})
    IO (Ptr GObject.Object.Object)

-- | Gets the source object used for binding properties.
-- 
-- /Since: 2.72/
bindingGroupDupSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingGroup a) =>
    a
    -- ^ /@self@/: the t'GI.GObject.Objects.BindingGroup.BindingGroup'
    -> m (Maybe GObject.Object.Object)
    -- ^ __Returns:__ a t'GI.GObject.Objects.Object.Object' or 'P.Nothing'.
bindingGroupDupSource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBindingGroup a) =>
a -> m (Maybe Object)
bindingGroupDupSource a
self = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BindingGroup
self' <- a -> IO (Ptr BindingGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
result <- Ptr BindingGroup -> IO (Ptr Object)
g_binding_group_dup_source Ptr BindingGroup
self'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result'
        Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data BindingGroupDupSourceMethodInfo
instance (signature ~ (m (Maybe GObject.Object.Object)), MonadIO m, IsBindingGroup a) => O.OverloadedMethod BindingGroupDupSourceMethodInfo a signature where
    overloadedMethod = bindingGroupDupSource

instance O.OverloadedMethodInfo BindingGroupDupSourceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Objects.BindingGroup.bindingGroupDupSource",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.30/docs/GI-GObject-Objects-BindingGroup.html#v:bindingGroupDupSource"
        })


#endif

-- method BindingGroup::set_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GBindingGroup" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source #GObject,\n  or %NULL to clear it"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_binding_group_set_source" g_binding_group_set_source :: 
    Ptr BindingGroup ->                     -- self : TInterface (Name {namespace = "GObject", name = "BindingGroup"})
    Ptr GObject.Object.Object ->            -- source : TInterface (Name {namespace = "GObject", name = "Object"})
    IO ()

-- | Sets /@source@/ as the source object used for creating property
-- bindings. If there is already a source object all bindings from it
-- will be removed.
-- 
-- Note that all properties that have been bound must exist on /@source@/.
-- 
-- /Since: 2.72/
bindingGroupSetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsBindingGroup a, GObject.Object.IsObject b) =>
    a
    -- ^ /@self@/: the t'GI.GObject.Objects.BindingGroup.BindingGroup'
    -> Maybe (b)
    -- ^ /@source@/: the source t'GI.GObject.Objects.Object.Object',
    --   or 'P.Nothing' to clear it
    -> m ()
bindingGroupSetSource :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBindingGroup a, IsObject b) =>
a -> Maybe b -> m ()
bindingGroupSetSource a
self Maybe b
source = 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 BindingGroup
self' <- a -> IO (Ptr BindingGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
maybeSource <- case Maybe b
source of
        Maybe b
Nothing -> Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just b
jSource -> do
            Ptr Object
jSource' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSource
            Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jSource'
    Ptr BindingGroup -> Ptr Object -> IO ()
g_binding_group_set_source Ptr BindingGroup
self' Ptr Object
maybeSource
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
source b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BindingGroupSetSourceMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsBindingGroup a, GObject.Object.IsObject b) => O.OverloadedMethod BindingGroupSetSourceMethodInfo a signature where
    overloadedMethod = bindingGroupSetSource

instance O.OverloadedMethodInfo BindingGroupSetSourceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Objects.BindingGroup.bindingGroupSetSource",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.30/docs/GI-GObject-Objects-BindingGroup.html#v:bindingGroupSetSource"
        })


#endif