{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This interface is implemented by elements which can perform some color
-- balance operation on video frames they process. For example, modifying
-- the brightness, contrast, hue or saturation.
-- 
-- Example elements are \'xvimagesink\' and \'colorbalance\'

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

module GI.GstVideo.Interfaces.ColorBalance
    ( 

-- * Exported types
    ColorBalance(..)                        ,
    IsColorBalance                          ,
    toColorBalance                          ,


 -- * 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"), [listChannels]("GI.GstVideo.Interfaces.ColorBalance#g:method:listChannels"), [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"), [valueChanged]("GI.GstVideo.Interfaces.ColorBalance#g:method:valueChanged"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBalanceType]("GI.GstVideo.Interfaces.ColorBalance#g:method:getBalanceType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getValue]("GI.GstVideo.Interfaces.ColorBalance#g:method:getValue").
-- 
-- ==== 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"), [setValue]("GI.GstVideo.Interfaces.ColorBalance#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveColorBalanceMethod               ,
#endif

-- ** getBalanceType #method:getBalanceType#

#if defined(ENABLE_OVERLOADING)
    ColorBalanceGetBalanceTypeMethodInfo    ,
#endif
    colorBalanceGetBalanceType              ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    ColorBalanceGetValueMethodInfo          ,
#endif
    colorBalanceGetValue                    ,


-- ** listChannels #method:listChannels#

#if defined(ENABLE_OVERLOADING)
    ColorBalanceListChannelsMethodInfo      ,
#endif
    colorBalanceListChannels                ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    ColorBalanceSetValueMethodInfo          ,
#endif
    colorBalanceSetValue                    ,


-- ** valueChanged #method:valueChanged#

#if defined(ENABLE_OVERLOADING)
    ColorBalanceValueChangedMethodInfo      ,
#endif
    colorBalanceValueChanged                ,




 -- * Signals


-- ** valueChanged #signal:valueChanged#

    ColorBalanceValueChangedCallback        ,
#if defined(ENABLE_OVERLOADING)
    ColorBalanceValueChangedSignalInfo      ,
#endif
    afterColorBalanceValueChanged           ,
    onColorBalanceValueChanged              ,




    ) 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
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Objects.ColorBalanceChannel as GstVideo.ColorBalanceChannel

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

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

foreign import ccall "gst_color_balance_get_type"
    c_gst_color_balance_get_type :: IO B.Types.GType

instance B.Types.TypedObject ColorBalance where
    glibType :: IO GType
glibType = IO GType
c_gst_color_balance_get_type

instance B.Types.GObject ColorBalance

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif

-- method ColorBalance::get_balance_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "balance"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "ColorBalance" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstColorBalance implementation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "ColorBalanceType" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_color_balance_get_balance_type" gst_color_balance_get_balance_type :: 
    Ptr ColorBalance ->                     -- balance : TInterface (Name {namespace = "GstVideo", name = "ColorBalance"})
    IO CUInt

-- | Get the t'GI.GstVideo.Enums.ColorBalanceType' of this implementation.
colorBalanceGetBalanceType ::
    (B.CallStack.HasCallStack, MonadIO m, IsColorBalance a) =>
    a
    -- ^ /@balance@/: The t'GI.GstVideo.Interfaces.ColorBalance.ColorBalance' implementation
    -> m GstVideo.Enums.ColorBalanceType
    -- ^ __Returns:__ A the t'GI.GstVideo.Enums.ColorBalanceType'.
colorBalanceGetBalanceType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColorBalance a) =>
a -> m ColorBalanceType
colorBalanceGetBalanceType a
balance = IO ColorBalanceType -> m ColorBalanceType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ColorBalanceType -> m ColorBalanceType)
-> IO ColorBalanceType -> m ColorBalanceType
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColorBalance
balance' <- a -> IO (Ptr ColorBalance)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
balance
    CUInt
result <- Ptr ColorBalance -> IO CUInt
gst_color_balance_get_balance_type Ptr ColorBalance
balance'
    let result' :: ColorBalanceType
result' = (Int -> ColorBalanceType
forall a. Enum a => Int -> a
toEnum (Int -> ColorBalanceType)
-> (CUInt -> Int) -> CUInt -> ColorBalanceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
balance
    ColorBalanceType -> IO ColorBalanceType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorBalanceType
result'

#if defined(ENABLE_OVERLOADING)
data ColorBalanceGetBalanceTypeMethodInfo
instance (signature ~ (m GstVideo.Enums.ColorBalanceType), MonadIO m, IsColorBalance a) => O.OverloadedMethod ColorBalanceGetBalanceTypeMethodInfo a signature where
    overloadedMethod = colorBalanceGetBalanceType

instance O.OverloadedMethodInfo ColorBalanceGetBalanceTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.ColorBalance.colorBalanceGetBalanceType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-ColorBalance.html#v:colorBalanceGetBalanceType"
        })


#endif

-- method ColorBalance::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "balance"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "ColorBalance" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstColorBalance instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "channel"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "ColorBalanceChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstColorBalanceChannel instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_color_balance_get_value" gst_color_balance_get_value :: 
    Ptr ColorBalance ->                     -- balance : TInterface (Name {namespace = "GstVideo", name = "ColorBalance"})
    Ptr GstVideo.ColorBalanceChannel.ColorBalanceChannel -> -- channel : TInterface (Name {namespace = "GstVideo", name = "ColorBalanceChannel"})
    IO Int32

-- | Retrieve the current value of the indicated channel, between min_value
-- and max_value.
-- 
-- See Also: The t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel'.@/min_value/@ and
--         t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel'.@/max_value/@ members of the
--         t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel' object.
colorBalanceGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsColorBalance a, GstVideo.ColorBalanceChannel.IsColorBalanceChannel b) =>
    a
    -- ^ /@balance@/: A t'GI.GstVideo.Interfaces.ColorBalance.ColorBalance' instance
    -> b
    -- ^ /@channel@/: A t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel' instance
    -> m Int32
    -- ^ __Returns:__ The current value of the channel.
colorBalanceGetValue :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsColorBalance a,
 IsColorBalanceChannel b) =>
a -> b -> m Int32
colorBalanceGetValue a
balance b
channel = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColorBalance
balance' <- a -> IO (Ptr ColorBalance)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
balance
    Ptr ColorBalanceChannel
channel' <- b -> IO (Ptr ColorBalanceChannel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
channel
    Int32
result <- Ptr ColorBalance -> Ptr ColorBalanceChannel -> IO Int32
gst_color_balance_get_value Ptr ColorBalance
balance' Ptr ColorBalanceChannel
channel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
balance
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
channel
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ColorBalanceGetValueMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsColorBalance a, GstVideo.ColorBalanceChannel.IsColorBalanceChannel b) => O.OverloadedMethod ColorBalanceGetValueMethodInfo a signature where
    overloadedMethod = colorBalanceGetValue

instance O.OverloadedMethodInfo ColorBalanceGetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.ColorBalance.colorBalanceGetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-ColorBalance.html#v:colorBalanceGetValue"
        })


#endif

-- method ColorBalance::list_channels
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "balance"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "ColorBalance" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstColorBalance instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "GstVideo" , name = "ColorBalanceChannel" }))
-- throws : False
-- Skip return : False

foreign import ccall "gst_color_balance_list_channels" gst_color_balance_list_channels :: 
    Ptr ColorBalance ->                     -- balance : TInterface (Name {namespace = "GstVideo", name = "ColorBalance"})
    IO (Ptr (GList (Ptr GstVideo.ColorBalanceChannel.ColorBalanceChannel)))

-- | Retrieve a list of the available channels.
colorBalanceListChannels ::
    (B.CallStack.HasCallStack, MonadIO m, IsColorBalance a) =>
    a
    -- ^ /@balance@/: A t'GI.GstVideo.Interfaces.ColorBalance.ColorBalance' instance
    -> m [GstVideo.ColorBalanceChannel.ColorBalanceChannel]
    -- ^ __Returns:__ A
    --          GList containing pointers to t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel'
    --          objects. The list is owned by the t'GI.GstVideo.Interfaces.ColorBalance.ColorBalance'
    --          instance and must not be freed.
colorBalanceListChannels :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColorBalance a) =>
a -> m [ColorBalanceChannel]
colorBalanceListChannels a
balance = IO [ColorBalanceChannel] -> m [ColorBalanceChannel]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ColorBalanceChannel] -> m [ColorBalanceChannel])
-> IO [ColorBalanceChannel] -> m [ColorBalanceChannel]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ColorBalance
balance' <- a -> IO (Ptr ColorBalance)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
balance
    Ptr (GList (Ptr ColorBalanceChannel))
result <- Ptr ColorBalance -> IO (Ptr (GList (Ptr ColorBalanceChannel)))
gst_color_balance_list_channels Ptr ColorBalance
balance'
    [Ptr ColorBalanceChannel]
result' <- Ptr (GList (Ptr ColorBalanceChannel))
-> IO [Ptr ColorBalanceChannel]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ColorBalanceChannel))
result
    [ColorBalanceChannel]
result'' <- (Ptr ColorBalanceChannel -> IO ColorBalanceChannel)
-> [Ptr ColorBalanceChannel] -> IO [ColorBalanceChannel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr ColorBalanceChannel -> ColorBalanceChannel)
-> Ptr ColorBalanceChannel -> IO ColorBalanceChannel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ColorBalanceChannel -> ColorBalanceChannel
GstVideo.ColorBalanceChannel.ColorBalanceChannel) [Ptr ColorBalanceChannel]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
balance
    [ColorBalanceChannel] -> IO [ColorBalanceChannel]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ColorBalanceChannel]
result''

#if defined(ENABLE_OVERLOADING)
data ColorBalanceListChannelsMethodInfo
instance (signature ~ (m [GstVideo.ColorBalanceChannel.ColorBalanceChannel]), MonadIO m, IsColorBalance a) => O.OverloadedMethod ColorBalanceListChannelsMethodInfo a signature where
    overloadedMethod = colorBalanceListChannels

instance O.OverloadedMethodInfo ColorBalanceListChannelsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.ColorBalance.colorBalanceListChannels",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-ColorBalance.html#v:colorBalanceListChannels"
        })


#endif

-- method ColorBalance::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "balance"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "ColorBalance" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstColorBalance instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "channel"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "ColorBalanceChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstColorBalanceChannel instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new value for the channel."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_color_balance_set_value" gst_color_balance_set_value :: 
    Ptr ColorBalance ->                     -- balance : TInterface (Name {namespace = "GstVideo", name = "ColorBalance"})
    Ptr GstVideo.ColorBalanceChannel.ColorBalanceChannel -> -- channel : TInterface (Name {namespace = "GstVideo", name = "ColorBalanceChannel"})
    Int32 ->                                -- value : TBasicType TInt
    IO ()

-- | Sets the current value of the channel to the passed value, which must
-- be between min_value and max_value.
-- 
-- See Also: The t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel'.@/min_value/@ and
--         t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel'.@/max_value/@ members of the
--         t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel' object.
colorBalanceSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsColorBalance a, GstVideo.ColorBalanceChannel.IsColorBalanceChannel b) =>
    a
    -- ^ /@balance@/: A t'GI.GstVideo.Interfaces.ColorBalance.ColorBalance' instance
    -> b
    -- ^ /@channel@/: A t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel' instance
    -> Int32
    -- ^ /@value@/: The new value for the channel.
    -> m ()
colorBalanceSetValue :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsColorBalance a,
 IsColorBalanceChannel b) =>
a -> b -> Int32 -> m ()
colorBalanceSetValue a
balance b
channel Int32
value = 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 ColorBalance
balance' <- a -> IO (Ptr ColorBalance)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
balance
    Ptr ColorBalanceChannel
channel' <- b -> IO (Ptr ColorBalanceChannel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
channel
    Ptr ColorBalance -> Ptr ColorBalanceChannel -> Int32 -> IO ()
gst_color_balance_set_value Ptr ColorBalance
balance' Ptr ColorBalanceChannel
channel' Int32
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
balance
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColorBalanceSetValueMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsColorBalance a, GstVideo.ColorBalanceChannel.IsColorBalanceChannel b) => O.OverloadedMethod ColorBalanceSetValueMethodInfo a signature where
    overloadedMethod = colorBalanceSetValue

instance O.OverloadedMethodInfo ColorBalanceSetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.ColorBalance.colorBalanceSetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-ColorBalance.html#v:colorBalanceSetValue"
        })


#endif

-- method ColorBalance::value_changed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "balance"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "ColorBalance" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstColorBalance instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "channel"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "ColorBalanceChannel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GstColorBalanceChannel whose value has changed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new value of the channel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_color_balance_value_changed" gst_color_balance_value_changed :: 
    Ptr ColorBalance ->                     -- balance : TInterface (Name {namespace = "GstVideo", name = "ColorBalance"})
    Ptr GstVideo.ColorBalanceChannel.ColorBalanceChannel -> -- channel : TInterface (Name {namespace = "GstVideo", name = "ColorBalanceChannel"})
    Int32 ->                                -- value : TBasicType TInt
    IO ()

-- | A helper function called by implementations of the GstColorBalance
-- interface. It fires the [ColorBalance::valueChanged]("GI.GstVideo.Interfaces.ColorBalance#g:signal:valueChanged") signal on the
-- instance, and the [ColorBalanceChannel::valueChanged]("GI.GstVideo.Objects.ColorBalanceChannel#g:signal:valueChanged") signal on the
-- channel object.
colorBalanceValueChanged ::
    (B.CallStack.HasCallStack, MonadIO m, IsColorBalance a, GstVideo.ColorBalanceChannel.IsColorBalanceChannel b) =>
    a
    -- ^ /@balance@/: A t'GI.GstVideo.Interfaces.ColorBalance.ColorBalance' instance
    -> b
    -- ^ /@channel@/: A t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel' whose value has changed
    -> Int32
    -- ^ /@value@/: The new value of the channel
    -> m ()
colorBalanceValueChanged :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsColorBalance a,
 IsColorBalanceChannel b) =>
a -> b -> Int32 -> m ()
colorBalanceValueChanged a
balance b
channel Int32
value = 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 ColorBalance
balance' <- a -> IO (Ptr ColorBalance)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
balance
    Ptr ColorBalanceChannel
channel' <- b -> IO (Ptr ColorBalanceChannel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
channel
    Ptr ColorBalance -> Ptr ColorBalanceChannel -> Int32 -> IO ()
gst_color_balance_value_changed Ptr ColorBalance
balance' Ptr ColorBalanceChannel
channel' Int32
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
balance
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
channel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ColorBalanceValueChangedMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsColorBalance a, GstVideo.ColorBalanceChannel.IsColorBalanceChannel b) => O.OverloadedMethod ColorBalanceValueChangedMethodInfo a signature where
    overloadedMethod = colorBalanceValueChanged

instance O.OverloadedMethodInfo ColorBalanceValueChangedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.ColorBalance.colorBalanceValueChanged",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-ColorBalance.html#v:colorBalanceValueChanged"
        })


#endif

-- signal ColorBalance::value-changed
-- | Fired when the value of the indicated channel has changed.
type ColorBalanceValueChangedCallback =
    GstVideo.ColorBalanceChannel.ColorBalanceChannel
    -- ^ /@channel@/: The t'GI.GstVideo.Objects.ColorBalanceChannel.ColorBalanceChannel'
    -> Int32
    -- ^ /@value@/: The new value
    -> IO ()

type C_ColorBalanceValueChangedCallback =
    Ptr ColorBalance ->                     -- object
    Ptr GstVideo.ColorBalanceChannel.ColorBalanceChannel ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ColorBalanceValueChangedCallback`.
foreign import ccall "wrapper"
    mk_ColorBalanceValueChangedCallback :: C_ColorBalanceValueChangedCallback -> IO (FunPtr C_ColorBalanceValueChangedCallback)

wrap_ColorBalanceValueChangedCallback :: 
    GObject a => (a -> ColorBalanceValueChangedCallback) ->
    C_ColorBalanceValueChangedCallback
wrap_ColorBalanceValueChangedCallback :: forall a.
GObject a =>
(a -> ColorBalanceValueChangedCallback)
-> C_ColorBalanceValueChangedCallback
wrap_ColorBalanceValueChangedCallback a -> ColorBalanceValueChangedCallback
gi'cb Ptr ColorBalance
gi'selfPtr Ptr ColorBalanceChannel
channel Int32
value Ptr ()
_ = do
    ColorBalanceChannel
channel' <- ((ManagedPtr ColorBalanceChannel -> ColorBalanceChannel)
-> Ptr ColorBalanceChannel -> IO ColorBalanceChannel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ColorBalanceChannel -> ColorBalanceChannel
GstVideo.ColorBalanceChannel.ColorBalanceChannel) Ptr ColorBalanceChannel
channel
    Ptr ColorBalance -> (ColorBalance -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr ColorBalance
gi'selfPtr ((ColorBalance -> IO ()) -> IO ())
-> (ColorBalance -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ColorBalance
gi'self -> a -> ColorBalanceValueChangedCallback
gi'cb (ColorBalance -> a
forall a b. Coercible a b => a -> b
Coerce.coerce ColorBalance
gi'self)  ColorBalanceChannel
channel' Int32
value


-- | Connect a signal handler for the [valueChanged](#signal:valueChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' colorBalance #valueChanged callback
-- @
-- 
-- 
onColorBalanceValueChanged :: (IsColorBalance a, MonadIO m) => a -> ((?self :: a) => ColorBalanceValueChangedCallback) -> m SignalHandlerId
onColorBalanceValueChanged :: forall a (m :: * -> *).
(IsColorBalance a, MonadIO m) =>
a
-> ((?self::a) => ColorBalanceValueChangedCallback)
-> m SignalHandlerId
onColorBalanceValueChanged a
obj (?self::a) => ColorBalanceValueChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ColorBalanceValueChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ColorBalanceValueChangedCallback
ColorBalanceValueChangedCallback
cb
    let wrapped' :: C_ColorBalanceValueChangedCallback
wrapped' = (a -> ColorBalanceValueChangedCallback)
-> C_ColorBalanceValueChangedCallback
forall a.
GObject a =>
(a -> ColorBalanceValueChangedCallback)
-> C_ColorBalanceValueChangedCallback
wrap_ColorBalanceValueChangedCallback a -> ColorBalanceValueChangedCallback
wrapped
    FunPtr C_ColorBalanceValueChangedCallback
wrapped'' <- C_ColorBalanceValueChangedCallback
-> IO (FunPtr C_ColorBalanceValueChangedCallback)
mk_ColorBalanceValueChangedCallback C_ColorBalanceValueChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ColorBalanceValueChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"value-changed" FunPtr C_ColorBalanceValueChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [valueChanged](#signal:valueChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' colorBalance #valueChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterColorBalanceValueChanged :: (IsColorBalance a, MonadIO m) => a -> ((?self :: a) => ColorBalanceValueChangedCallback) -> m SignalHandlerId
afterColorBalanceValueChanged :: forall a (m :: * -> *).
(IsColorBalance a, MonadIO m) =>
a
-> ((?self::a) => ColorBalanceValueChangedCallback)
-> m SignalHandlerId
afterColorBalanceValueChanged a
obj (?self::a) => ColorBalanceValueChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ColorBalanceValueChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ColorBalanceValueChangedCallback
ColorBalanceValueChangedCallback
cb
    let wrapped' :: C_ColorBalanceValueChangedCallback
wrapped' = (a -> ColorBalanceValueChangedCallback)
-> C_ColorBalanceValueChangedCallback
forall a.
GObject a =>
(a -> ColorBalanceValueChangedCallback)
-> C_ColorBalanceValueChangedCallback
wrap_ColorBalanceValueChangedCallback a -> ColorBalanceValueChangedCallback
wrapped
    FunPtr C_ColorBalanceValueChangedCallback
wrapped'' <- C_ColorBalanceValueChangedCallback
-> IO (FunPtr C_ColorBalanceValueChangedCallback)
mk_ColorBalanceValueChangedCallback C_ColorBalanceValueChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ColorBalanceValueChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"value-changed" FunPtr C_ColorBalanceValueChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ColorBalanceValueChangedSignalInfo
instance SignalInfo ColorBalanceValueChangedSignalInfo where
    type HaskellCallbackType ColorBalanceValueChangedSignalInfo = ColorBalanceValueChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ColorBalanceValueChangedCallback cb
        cb'' <- mk_ColorBalanceValueChangedCallback cb'
        connectSignalFunPtr obj "value-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Interfaces.ColorBalance::value-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Interfaces-ColorBalance.html#g:signal:valueChanged"})

#endif

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

#endif