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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Interfaces.Content.Content' structure is an opaque type
-- whose members cannot be acccessed directly.
-- 
-- /Since: 1.10/

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

module GI.Clutter.Interfaces.Content
    ( 

-- * Exported types
    Content(..)                             ,
    IsContent                               ,
    toContent                               ,


 -- * 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"), [invalidate]("GI.Clutter.Interfaces.Content#g:method:invalidate"), [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"), [getPreferredSize]("GI.Clutter.Interfaces.Content#g:method:getPreferredSize"), [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)
    ResolveContentMethod                    ,
#endif

-- ** getPreferredSize #method:getPreferredSize#

#if defined(ENABLE_OVERLOADING)
    ContentGetPreferredSizeMethodInfo       ,
#endif
    contentGetPreferredSize                 ,


-- ** invalidate #method:invalidate#

#if defined(ENABLE_OVERLOADING)
    ContentInvalidateMethodInfo             ,
#endif
    contentInvalidate                       ,




 -- * Signals


-- ** attached #signal:attached#

    ContentAttachedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ContentAttachedSignalInfo               ,
#endif
    afterContentAttached                    ,
    onContentAttached                       ,


-- ** detached #signal:detached#

    ContentDetachedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ContentDetachedSignalInfo               ,
#endif
    afterContentDetached                    ,
    onContentDetached                       ,




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

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

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

foreign import ccall "clutter_content_get_type"
    c_clutter_content_get_type :: IO B.Types.GType

instance B.Types.TypedObject Content where
    glibType :: IO GType
glibType = IO GType
c_clutter_content_get_type

instance B.Types.GObject Content

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif

-- method Content::get_preferred_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "content"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Content" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the natural width of the content"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the natural height of the content"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_content_get_preferred_size" clutter_content_get_preferred_size :: 
    Ptr Content ->                          -- content : TInterface (Name {namespace = "Clutter", name = "Content"})
    Ptr CFloat ->                           -- width : TBasicType TFloat
    Ptr CFloat ->                           -- height : TBasicType TFloat
    IO CInt

-- | Retrieves the natural size of the /@content@/, if any.
-- 
-- The natural size of a t'GI.Clutter.Interfaces.Content.Content' is defined as the size the content
-- would have regardless of the allocation of the actor that is painting it,
-- for instance the size of an image data.
-- 
-- /Since: 1.10/
contentGetPreferredSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsContent a) =>
    a
    -- ^ /@content@/: a t'GI.Clutter.Interfaces.Content.Content'
    -> m ((Bool, Float, Float))
    -- ^ __Returns:__ 'P.True' if the content has a preferred size, and 'P.False'
    --   otherwise
contentGetPreferredSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContent a) =>
a -> m (Bool, Float, Float)
contentGetPreferredSize a
content = IO (Bool, Float, Float) -> m (Bool, Float, Float)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Float, Float) -> m (Bool, Float, Float))
-> IO (Bool, Float, Float) -> m (Bool, Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Content
content' <- a -> IO (Ptr Content)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
content
    Ptr CFloat
width <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
height <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    CInt
result <- Ptr Content -> Ptr CFloat -> Ptr CFloat -> IO CInt
clutter_content_get_preferred_size Ptr Content
content' Ptr CFloat
width Ptr CFloat
height
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CFloat
width' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
width
    let width'' :: Float
width'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
width'
    CFloat
height' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
height
    let height'' :: Float
height'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
content
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
width
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
height
    (Bool, Float, Float) -> IO (Bool, Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Float
width'', Float
height'')

#if defined(ENABLE_OVERLOADING)
data ContentGetPreferredSizeMethodInfo
instance (signature ~ (m ((Bool, Float, Float))), MonadIO m, IsContent a) => O.OverloadedMethod ContentGetPreferredSizeMethodInfo a signature where
    overloadedMethod = contentGetPreferredSize

instance O.OverloadedMethodInfo ContentGetPreferredSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Content.contentGetPreferredSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Content.html#v:contentGetPreferredSize"
        })


#endif

-- method Content::invalidate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "content"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Content" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterContent" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_content_invalidate" clutter_content_invalidate :: 
    Ptr Content ->                          -- content : TInterface (Name {namespace = "Clutter", name = "Content"})
    IO ()

-- | Invalidates a t'GI.Clutter.Interfaces.Content.Content'.
-- 
-- This function should be called by t'GI.Clutter.Interfaces.Content.Content' implementations when
-- they change the way a the content should be painted regardless of the
-- actor state.
-- 
-- /Since: 1.10/
contentInvalidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsContent a) =>
    a
    -- ^ /@content@/: a t'GI.Clutter.Interfaces.Content.Content'
    -> m ()
contentInvalidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContent a) =>
a -> m ()
contentInvalidate a
content = 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 Content
content' <- a -> IO (Ptr Content)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
content
    Ptr Content -> IO ()
clutter_content_invalidate Ptr Content
content'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
content
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContentInvalidateMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContent a) => O.OverloadedMethod ContentInvalidateMethodInfo a signature where
    overloadedMethod = contentInvalidate

instance O.OverloadedMethodInfo ContentInvalidateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Content.contentInvalidate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Content.html#v:contentInvalidate"
        })


#endif

-- signal Content::attached
-- | This signal is emitted each time a t'GI.Clutter.Interfaces.Content.Content' implementation is
-- assigned to a t'GI.Clutter.Objects.Actor.Actor'.
-- 
-- /Since: 1.10/
type ContentAttachedCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> IO ()

type C_ContentAttachedCallback =
    Ptr Content ->                          -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ContentAttachedCallback :: 
    GObject a => (a -> ContentAttachedCallback) ->
    C_ContentAttachedCallback
wrap_ContentAttachedCallback :: forall a.
GObject a =>
(a -> ContentAttachedCallback) -> C_ContentAttachedCallback
wrap_ContentAttachedCallback a -> ContentAttachedCallback
gi'cb Ptr Content
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    Ptr Content -> (Content -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Content
gi'selfPtr ((Content -> IO ()) -> IO ()) -> (Content -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Content
gi'self -> a -> ContentAttachedCallback
gi'cb (Content -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Content
gi'self)  Actor
actor'


-- | Connect a signal handler for the [attached](#signal:attached) 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' content #attached callback
-- @
-- 
-- 
onContentAttached :: (IsContent a, MonadIO m) => a -> ((?self :: a) => ContentAttachedCallback) -> m SignalHandlerId
onContentAttached :: forall a (m :: * -> *).
(IsContent a, MonadIO m) =>
a -> ((?self::a) => ContentAttachedCallback) -> m SignalHandlerId
onContentAttached a
obj (?self::a) => ContentAttachedCallback
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 -> ContentAttachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ContentAttachedCallback
ContentAttachedCallback
cb
    let wrapped' :: C_ContentAttachedCallback
wrapped' = (a -> ContentAttachedCallback) -> C_ContentAttachedCallback
forall a.
GObject a =>
(a -> ContentAttachedCallback) -> C_ContentAttachedCallback
wrap_ContentAttachedCallback a -> ContentAttachedCallback
wrapped
    FunPtr C_ContentAttachedCallback
wrapped'' <- C_ContentAttachedCallback -> IO (FunPtr C_ContentAttachedCallback)
mk_ContentAttachedCallback C_ContentAttachedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContentAttachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"attached" FunPtr C_ContentAttachedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [attached](#signal:attached) 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' content #attached 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.
-- 
afterContentAttached :: (IsContent a, MonadIO m) => a -> ((?self :: a) => ContentAttachedCallback) -> m SignalHandlerId
afterContentAttached :: forall a (m :: * -> *).
(IsContent a, MonadIO m) =>
a -> ((?self::a) => ContentAttachedCallback) -> m SignalHandlerId
afterContentAttached a
obj (?self::a) => ContentAttachedCallback
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 -> ContentAttachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ContentAttachedCallback
ContentAttachedCallback
cb
    let wrapped' :: C_ContentAttachedCallback
wrapped' = (a -> ContentAttachedCallback) -> C_ContentAttachedCallback
forall a.
GObject a =>
(a -> ContentAttachedCallback) -> C_ContentAttachedCallback
wrap_ContentAttachedCallback a -> ContentAttachedCallback
wrapped
    FunPtr C_ContentAttachedCallback
wrapped'' <- C_ContentAttachedCallback -> IO (FunPtr C_ContentAttachedCallback)
mk_ContentAttachedCallback C_ContentAttachedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContentAttachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"attached" FunPtr C_ContentAttachedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContentAttachedSignalInfo
instance SignalInfo ContentAttachedSignalInfo where
    type HaskellCallbackType ContentAttachedSignalInfo = ContentAttachedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContentAttachedCallback cb
        cb'' <- mk_ContentAttachedCallback cb'
        connectSignalFunPtr obj "attached" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Content::attached"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Content.html#g:signal:attached"})

#endif

-- signal Content::detached
-- | This signal is emitted each time a t'GI.Clutter.Interfaces.Content.Content' implementation is
-- removed from a t'GI.Clutter.Objects.Actor.Actor'.
-- 
-- /Since: 1.10/
type ContentDetachedCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> IO ()

type C_ContentDetachedCallback =
    Ptr Content ->                          -- object
    Ptr Clutter.Actor.Actor ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ContentDetachedCallback :: 
    GObject a => (a -> ContentDetachedCallback) ->
    C_ContentDetachedCallback
wrap_ContentDetachedCallback :: forall a.
GObject a =>
(a -> ContentAttachedCallback) -> C_ContentAttachedCallback
wrap_ContentDetachedCallback a -> ContentAttachedCallback
gi'cb Ptr Content
gi'selfPtr Ptr Actor
actor Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    Ptr Content -> (Content -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Content
gi'selfPtr ((Content -> IO ()) -> IO ()) -> (Content -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Content
gi'self -> a -> ContentAttachedCallback
gi'cb (Content -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Content
gi'self)  Actor
actor'


-- | Connect a signal handler for the [detached](#signal:detached) 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' content #detached callback
-- @
-- 
-- 
onContentDetached :: (IsContent a, MonadIO m) => a -> ((?self :: a) => ContentDetachedCallback) -> m SignalHandlerId
onContentDetached :: forall a (m :: * -> *).
(IsContent a, MonadIO m) =>
a -> ((?self::a) => ContentAttachedCallback) -> m SignalHandlerId
onContentDetached a
obj (?self::a) => ContentAttachedCallback
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 -> ContentAttachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ContentAttachedCallback
ContentAttachedCallback
cb
    let wrapped' :: C_ContentAttachedCallback
wrapped' = (a -> ContentAttachedCallback) -> C_ContentAttachedCallback
forall a.
GObject a =>
(a -> ContentAttachedCallback) -> C_ContentAttachedCallback
wrap_ContentDetachedCallback a -> ContentAttachedCallback
wrapped
    FunPtr C_ContentAttachedCallback
wrapped'' <- C_ContentAttachedCallback -> IO (FunPtr C_ContentAttachedCallback)
mk_ContentDetachedCallback C_ContentAttachedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContentAttachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"detached" FunPtr C_ContentAttachedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [detached](#signal:detached) 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' content #detached 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.
-- 
afterContentDetached :: (IsContent a, MonadIO m) => a -> ((?self :: a) => ContentDetachedCallback) -> m SignalHandlerId
afterContentDetached :: forall a (m :: * -> *).
(IsContent a, MonadIO m) =>
a -> ((?self::a) => ContentAttachedCallback) -> m SignalHandlerId
afterContentDetached a
obj (?self::a) => ContentAttachedCallback
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 -> ContentAttachedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ContentAttachedCallback
ContentAttachedCallback
cb
    let wrapped' :: C_ContentAttachedCallback
wrapped' = (a -> ContentAttachedCallback) -> C_ContentAttachedCallback
forall a.
GObject a =>
(a -> ContentAttachedCallback) -> C_ContentAttachedCallback
wrap_ContentDetachedCallback a -> ContentAttachedCallback
wrapped
    FunPtr C_ContentAttachedCallback
wrapped'' <- C_ContentAttachedCallback -> IO (FunPtr C_ContentAttachedCallback)
mk_ContentDetachedCallback C_ContentAttachedCallback
wrapped'
    a
-> Text
-> FunPtr C_ContentAttachedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"detached" FunPtr C_ContentAttachedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ContentDetachedSignalInfo
instance SignalInfo ContentDetachedSignalInfo where
    type HaskellCallbackType ContentDetachedSignalInfo = ContentDetachedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ContentDetachedCallback cb
        cb'' <- mk_ContentDetachedCallback cb'
        connectSignalFunPtr obj "detached" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Content::detached"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Content.html#g:signal:detached"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Content = ContentSignalList
type ContentSignalList = ('[ '("attached", ContentAttachedSignalInfo), '("detached", ContentDetachedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif