{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A render node applying a blending function between its two child nodes.

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

module GI.Gsk.Objects.BlendNode
    ( 

-- * Exported types
    BlendNode(..)                           ,
    IsBlendNode                             ,
    toBlendNode                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [draw]("GI.Gsk.Objects.RenderNode#g:method:draw"), [ref]("GI.Gsk.Objects.RenderNode#g:method:ref"), [serialize]("GI.Gsk.Objects.RenderNode#g:method:serialize"), [unref]("GI.Gsk.Objects.RenderNode#g:method:unref"), [writeToFile]("GI.Gsk.Objects.RenderNode#g:method:writeToFile").
-- 
-- ==== Getters
-- [getBlendMode]("GI.Gsk.Objects.BlendNode#g:method:getBlendMode"), [getBottomChild]("GI.Gsk.Objects.BlendNode#g:method:getBottomChild"), [getBounds]("GI.Gsk.Objects.RenderNode#g:method:getBounds"), [getNodeType]("GI.Gsk.Objects.RenderNode#g:method:getNodeType"), [getTopChild]("GI.Gsk.Objects.BlendNode#g:method:getTopChild").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBlendNodeMethod                  ,
#endif

-- ** getBlendMode #method:getBlendMode#

#if defined(ENABLE_OVERLOADING)
    BlendNodeGetBlendModeMethodInfo         ,
#endif
    blendNodeGetBlendMode                   ,


-- ** getBottomChild #method:getBottomChild#

#if defined(ENABLE_OVERLOADING)
    BlendNodeGetBottomChildMethodInfo       ,
#endif
    blendNodeGetBottomChild                 ,


-- ** getTopChild #method:getTopChild#

#if defined(ENABLE_OVERLOADING)
    BlendNodeGetTopChildMethodInfo          ,
#endif
    blendNodeGetTopChild                    ,


-- ** new #method:new#

    blendNodeNew                            ,




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

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

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

foreign import ccall "gsk_blend_node_get_type"
    c_gsk_blend_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject BlendNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_blend_node_get_type

-- | Type class for types which can be safely cast to `BlendNode`, for instance with `toBlendNode`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf BlendNode o) => IsBlendNode o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf BlendNode o) => IsBlendNode o

instance O.HasParentTypes BlendNode
type instance O.ParentTypes BlendNode = '[Gsk.RenderNode.RenderNode]

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

--- XXX Missing getter and/or setter, so no GValue instance could be generated.
#if defined(ENABLE_OVERLOADING)
type family ResolveBlendNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveBlendNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveBlendNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveBlendNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveBlendNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveBlendNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveBlendNodeMethod "getBlendMode" o = BlendNodeGetBlendModeMethodInfo
    ResolveBlendNodeMethod "getBottomChild" o = BlendNodeGetBottomChildMethodInfo
    ResolveBlendNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveBlendNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveBlendNodeMethod "getTopChild" o = BlendNodeGetTopChildMethodInfo
    ResolveBlendNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr BlendNode where
    boxedPtrCopy :: BlendNode -> IO BlendNode
boxedPtrCopy = BlendNode -> IO BlendNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: BlendNode -> IO ()
boxedPtrFree = \BlendNode
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method BlendNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "bottom"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The bottom node to be drawn"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "RenderNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The node to be blended onto the @bottom node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "blend_mode"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BlendMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The blend mode to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "BlendNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_blend_node_new" gsk_blend_node_new :: 
    Ptr Gsk.RenderNode.RenderNode ->        -- bottom : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    Ptr Gsk.RenderNode.RenderNode ->        -- top : TInterface (Name {namespace = "Gsk", name = "RenderNode"})
    CUInt ->                                -- blend_mode : TInterface (Name {namespace = "Gsk", name = "BlendMode"})
    IO (Ptr BlendNode)

-- | Creates a @GskRenderNode@ that will use /@blendMode@/ to blend the /@top@/
-- node onto the /@bottom@/ node.
blendNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gsk.RenderNode.IsRenderNode a, Gsk.RenderNode.IsRenderNode b) =>
    a
    -- ^ /@bottom@/: The bottom node to be drawn
    -> b
    -- ^ /@top@/: The node to be blended onto the /@bottom@/ node
    -> Gsk.Enums.BlendMode
    -- ^ /@blendMode@/: The blend mode to use
    -> m BlendNode
    -- ^ __Returns:__ A new @GskRenderNode@
blendNodeNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRenderNode a, IsRenderNode b) =>
a -> b -> BlendMode -> m BlendNode
blendNodeNew a
bottom b
top BlendMode
blendMode = IO BlendNode -> m BlendNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlendNode -> m BlendNode) -> IO BlendNode -> m BlendNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr RenderNode
bottom' <- a -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
bottom
    Ptr RenderNode
top' <- b -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
top
    let blendMode' :: CUInt
blendMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (BlendMode -> Int) -> BlendMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlendMode -> Int
forall a. Enum a => a -> Int
fromEnum) BlendMode
blendMode
    Ptr BlendNode
result <- Ptr RenderNode -> Ptr RenderNode -> CUInt -> IO (Ptr BlendNode)
gsk_blend_node_new Ptr RenderNode
bottom' Ptr RenderNode
top' CUInt
blendMode'
    Text -> Ptr BlendNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blendNodeNew" Ptr BlendNode
result
    BlendNode
result' <- ((ManagedPtr BlendNode -> BlendNode)
-> Ptr BlendNode -> IO BlendNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr BlendNode -> BlendNode
BlendNode) Ptr BlendNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
bottom
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
top
    BlendNode -> IO BlendNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BlendNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BlendNode::get_blend_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BlendNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a blending `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "BlendMode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_blend_node_get_blend_mode" gsk_blend_node_get_blend_mode :: 
    Ptr BlendNode ->                        -- node : TInterface (Name {namespace = "Gsk", name = "BlendNode"})
    IO CUInt

-- | Retrieves the blend mode used by /@node@/.
blendNodeGetBlendMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlendNode a) =>
    a
    -- ^ /@node@/: a blending @GskRenderNode@
    -> m Gsk.Enums.BlendMode
    -- ^ __Returns:__ the blend mode
blendNodeGetBlendMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBlendNode a) =>
a -> m BlendMode
blendNodeGetBlendMode a
node = IO BlendMode -> m BlendMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BlendMode -> m BlendMode) -> IO BlendMode -> m BlendMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlendNode
node' <- a -> IO (Ptr BlendNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    CUInt
result <- Ptr BlendNode -> IO CUInt
gsk_blend_node_get_blend_mode Ptr BlendNode
node'
    let result' :: BlendMode
result' = (Int -> BlendMode
forall a. Enum a => Int -> a
toEnum (Int -> BlendMode) -> (CUInt -> Int) -> CUInt -> BlendMode
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
node
    BlendMode -> IO BlendMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BlendMode
result'

#if defined(ENABLE_OVERLOADING)
data BlendNodeGetBlendModeMethodInfo
instance (signature ~ (m Gsk.Enums.BlendMode), MonadIO m, IsBlendNode a) => O.OverloadedMethod BlendNodeGetBlendModeMethodInfo a signature where
    overloadedMethod = blendNodeGetBlendMode

instance O.OverloadedMethodInfo BlendNodeGetBlendModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.BlendNode.blendNodeGetBlendMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-BlendNode.html#v:blendNodeGetBlendMode"
        })


#endif

-- method BlendNode::get_bottom_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BlendNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a blending `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RenderNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_blend_node_get_bottom_child" gsk_blend_node_get_bottom_child :: 
    Ptr BlendNode ->                        -- node : TInterface (Name {namespace = "Gsk", name = "BlendNode"})
    IO (Ptr Gsk.RenderNode.RenderNode)

-- | Retrieves the bottom @GskRenderNode@ child of the /@node@/.
blendNodeGetBottomChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlendNode a) =>
    a
    -- ^ /@node@/: a blending @GskRenderNode@
    -> m Gsk.RenderNode.RenderNode
    -- ^ __Returns:__ the bottom child node
blendNodeGetBottomChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBlendNode a) =>
a -> m RenderNode
blendNodeGetBottomChild a
node = IO RenderNode -> m RenderNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderNode -> m RenderNode) -> IO RenderNode -> m RenderNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlendNode
node' <- a -> IO (Ptr BlendNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RenderNode
result <- Ptr BlendNode -> IO (Ptr RenderNode)
gsk_blend_node_get_bottom_child Ptr BlendNode
node'
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blendNodeGetBottomChild" Ptr RenderNode
result
    RenderNode
result' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RenderNode -> IO RenderNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
data BlendNodeGetBottomChildMethodInfo
instance (signature ~ (m Gsk.RenderNode.RenderNode), MonadIO m, IsBlendNode a) => O.OverloadedMethod BlendNodeGetBottomChildMethodInfo a signature where
    overloadedMethod = blendNodeGetBottomChild

instance O.OverloadedMethodInfo BlendNodeGetBottomChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.BlendNode.blendNodeGetBottomChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-BlendNode.html#v:blendNodeGetBottomChild"
        })


#endif

-- method BlendNode::get_top_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "BlendNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a blending `GskRenderNode`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gsk" , name = "RenderNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_blend_node_get_top_child" gsk_blend_node_get_top_child :: 
    Ptr BlendNode ->                        -- node : TInterface (Name {namespace = "Gsk", name = "BlendNode"})
    IO (Ptr Gsk.RenderNode.RenderNode)

-- | Retrieves the top @GskRenderNode@ child of the /@node@/.
blendNodeGetTopChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsBlendNode a) =>
    a
    -- ^ /@node@/: a blending @GskRenderNode@
    -> m Gsk.RenderNode.RenderNode
    -- ^ __Returns:__ the top child node
blendNodeGetTopChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsBlendNode a) =>
a -> m RenderNode
blendNodeGetTopChild a
node = IO RenderNode -> m RenderNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RenderNode -> m RenderNode) -> IO RenderNode -> m RenderNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr BlendNode
node' <- a -> IO (Ptr BlendNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RenderNode
result <- Ptr BlendNode -> IO (Ptr RenderNode)
gsk_blend_node_get_top_child Ptr BlendNode
node'
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"blendNodeGetTopChild" Ptr RenderNode
result
    RenderNode
result' <- ((ManagedPtr RenderNode -> RenderNode)
-> Ptr RenderNode -> IO RenderNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr RenderNode -> RenderNode
Gsk.RenderNode.RenderNode) Ptr RenderNode
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    RenderNode -> IO RenderNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
data BlendNodeGetTopChildMethodInfo
instance (signature ~ (m Gsk.RenderNode.RenderNode), MonadIO m, IsBlendNode a) => O.OverloadedMethod BlendNodeGetTopChildMethodInfo a signature where
    overloadedMethod = blendNodeGetTopChild

instance O.OverloadedMethodInfo BlendNodeGetTopChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gsk.Objects.BlendNode.blendNodeGetTopChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gsk-4.0.5/docs/GI-Gsk-Objects-BlendNode.html#v:blendNodeGetTopChild"
        })


#endif