{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Gsk.Objects.ContainerNode
    ( 

-- * Exported types
    ContainerNode(..)                       ,
    IsContainerNode                         ,
    toContainerNode                         ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveContainerNodeMethod              ,
#endif


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    ContainerNodeGetChildMethodInfo         ,
#endif
    containerNodeGetChild                   ,


-- ** getNChildren #method:getNChildren#

#if defined(ENABLE_OVERLOADING)
    ContainerNodeGetNChildrenMethodInfo     ,
#endif
    containerNodeGetNChildren               ,


-- ** new #method:new#

    containerNodeNew                        ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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 {-# SOURCE #-} qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode

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

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

foreign import ccall "gsk_container_node_get_type"
    c_gsk_container_node_get_type :: IO B.Types.GType

instance B.Types.TypedObject ContainerNode where
    glibType :: IO GType
glibType = IO GType
c_gsk_container_node_get_type

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveContainerNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveContainerNodeMethod "draw" o = Gsk.RenderNode.RenderNodeDrawMethodInfo
    ResolveContainerNodeMethod "ref" o = Gsk.RenderNode.RenderNodeRefMethodInfo
    ResolveContainerNodeMethod "serialize" o = Gsk.RenderNode.RenderNodeSerializeMethodInfo
    ResolveContainerNodeMethod "unref" o = Gsk.RenderNode.RenderNodeUnrefMethodInfo
    ResolveContainerNodeMethod "writeToFile" o = Gsk.RenderNode.RenderNodeWriteToFileMethodInfo
    ResolveContainerNodeMethod "getBounds" o = Gsk.RenderNode.RenderNodeGetBoundsMethodInfo
    ResolveContainerNodeMethod "getChild" o = ContainerNodeGetChildMethodInfo
    ResolveContainerNodeMethod "getNChildren" o = ContainerNodeGetNChildrenMethodInfo
    ResolveContainerNodeMethod "getNodeType" o = Gsk.RenderNode.RenderNodeGetNodeTypeMethodInfo
    ResolveContainerNodeMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveContainerNodeMethod t ContainerNode, O.MethodInfo info ContainerNode p) => OL.IsLabel t (ContainerNode -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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


-- method ContainerNode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "children"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Gsk" , name = "RenderNode" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The children of the node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_children"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of children in the @children array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_children"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Number of children in the @children array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "Gsk" , name = "ContainerNode" })
-- throws : False
-- Skip return : False

foreign import ccall "gsk_container_node_new" gsk_container_node_new :: 
    Ptr (Ptr Gsk.RenderNode.RenderNode) ->  -- children : TCArray False (-1) 1 (TInterface (Name {namespace = "Gsk", name = "RenderNode"}))
    Word32 ->                               -- n_children : TBasicType TUInt
    IO (Ptr ContainerNode)

-- | Creates a new t'GI.Gsk.Objects.RenderNode.RenderNode' instance for holding the given /@children@/.
-- The new node will acquire a reference to each of the children.
containerNodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Gsk.RenderNode.RenderNode]
    -- ^ /@children@/: The children of the node
    -> m ContainerNode
    -- ^ __Returns:__ the new t'GI.Gsk.Objects.RenderNode.RenderNode'
containerNodeNew :: [RenderNode] -> m ContainerNode
containerNodeNew [RenderNode]
children = IO ContainerNode -> m ContainerNode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContainerNode -> m ContainerNode)
-> IO ContainerNode -> m ContainerNode
forall a b. (a -> b) -> a -> b
$ do
    let nChildren :: Word32
nChildren = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [RenderNode] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [RenderNode]
children
    [Ptr RenderNode]
children' <- (RenderNode -> IO (Ptr RenderNode))
-> [RenderNode] -> IO [Ptr RenderNode]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RenderNode -> IO (Ptr RenderNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [RenderNode]
children
    Ptr (Ptr RenderNode)
children'' <- [Ptr RenderNode] -> IO (Ptr (Ptr RenderNode))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr RenderNode]
children'
    Ptr ContainerNode
result <- Ptr (Ptr RenderNode) -> Word32 -> IO (Ptr ContainerNode)
gsk_container_node_new Ptr (Ptr RenderNode)
children'' Word32
nChildren
    Text -> Ptr ContainerNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"containerNodeNew" Ptr ContainerNode
result
    ContainerNode
result' <- ((ManagedPtr ContainerNode -> ContainerNode)
-> Ptr ContainerNode -> IO ContainerNode
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ContainerNode -> ContainerNode
ContainerNode) Ptr ContainerNode
result
    (RenderNode -> IO ()) -> [RenderNode] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenderNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [RenderNode]
children
    Ptr (Ptr RenderNode) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr RenderNode)
children''
    ContainerNode -> IO ContainerNode
forall (m :: * -> *) a. Monad m => a -> m a
return ContainerNode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContainerNode::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Gsk" , name = "ContainerNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a container #GskRenderNode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the child to get"
--                 , 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_container_node_get_child" gsk_container_node_get_child :: 
    Ptr ContainerNode ->                    -- node : TInterface (Name {namespace = "Gsk", name = "ContainerNode"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Gsk.RenderNode.RenderNode)

-- | Gets one of the children of /@container@/.
containerNodeGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainerNode a) =>
    a
    -- ^ /@node@/: a container t'GI.Gsk.Objects.RenderNode.RenderNode'
    -> Word32
    -- ^ /@idx@/: the position of the child to get
    -> m Gsk.RenderNode.RenderNode
    -- ^ __Returns:__ the /@idx@/\'th child of /@container@/
containerNodeGetChild :: a -> Word32 -> m RenderNode
containerNodeGetChild a
node Word32
idx = IO RenderNode -> m RenderNode
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 ContainerNode
node' <- a -> IO (Ptr ContainerNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Ptr RenderNode
result <- Ptr ContainerNode -> Word32 -> IO (Ptr RenderNode)
gsk_container_node_get_child Ptr ContainerNode
node' Word32
idx
    Text -> Ptr RenderNode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"containerNodeGetChild" 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 (m :: * -> *) a. Monad m => a -> m a
return RenderNode
result'

#if defined(ENABLE_OVERLOADING)
data ContainerNodeGetChildMethodInfo
instance (signature ~ (Word32 -> m Gsk.RenderNode.RenderNode), MonadIO m, IsContainerNode a) => O.MethodInfo ContainerNodeGetChildMethodInfo a signature where
    overloadedMethod = containerNodeGetChild

#endif

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

foreign import ccall "gsk_container_node_get_n_children" gsk_container_node_get_n_children :: 
    Ptr ContainerNode ->                    -- node : TInterface (Name {namespace = "Gsk", name = "ContainerNode"})
    IO Word32

-- | Retrieves the number of direct children of /@node@/.
containerNodeGetNChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsContainerNode a) =>
    a
    -- ^ /@node@/: a container t'GI.Gsk.Objects.RenderNode.RenderNode'
    -> m Word32
    -- ^ __Returns:__ the number of children of the t'GI.Gsk.Objects.RenderNode.RenderNode'
containerNodeGetNChildren :: a -> m Word32
containerNodeGetNChildren a
node = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContainerNode
node' <- a -> IO (Ptr ContainerNode)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
node
    Word32
result <- Ptr ContainerNode -> IO Word32
gsk_container_node_get_n_children Ptr ContainerNode
node'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
node
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ContainerNodeGetNChildrenMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsContainerNode a) => O.MethodInfo ContainerNodeGetNChildrenMethodInfo a signature where
    overloadedMethod = containerNodeGetNChildren

#endif