{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An iterator structure that allows to efficiently iterate over a
-- section of the scene graph.
-- 
-- The contents of the t'GI.Clutter.Structs.ActorIter.ActorIter' structure
-- are private and should only be accessed using the provided API.
-- 
-- /Since: 1.10/

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

module GI.Clutter.Structs.ActorIter
    ( 

-- * Exported types
    ActorIter(..)                           ,
    newZeroActorIter                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [destroy]("GI.Clutter.Structs.ActorIter#g:method:destroy"), [init]("GI.Clutter.Structs.ActorIter#g:method:init"), [isValid]("GI.Clutter.Structs.ActorIter#g:method:isValid"), [next]("GI.Clutter.Structs.ActorIter#g:method:next"), [prev]("GI.Clutter.Structs.ActorIter#g:method:prev"), [remove]("GI.Clutter.Structs.ActorIter#g:method:remove").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveActorIterMethod                  ,
#endif

-- ** destroy #method:destroy#

#if defined(ENABLE_OVERLOADING)
    ActorIterDestroyMethodInfo              ,
#endif
    actorIterDestroy                        ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    ActorIterInitMethodInfo                 ,
#endif
    actorIterInit                           ,


-- ** isValid #method:isValid#

#if defined(ENABLE_OVERLOADING)
    ActorIterIsValidMethodInfo              ,
#endif
    actorIterIsValid                        ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    ActorIterNextMethodInfo                 ,
#endif
    actorIterNext                           ,


-- ** prev #method:prev#

#if defined(ENABLE_OVERLOADING)
    ActorIterPrevMethodInfo                 ,
#endif
    actorIterPrev                           ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ActorIterRemoveMethodInfo               ,
#endif
    actorIterRemove                         ,




    ) 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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.Cairo.Structs.RectangleInt as Cairo.RectangleInt
import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Animatable as Clutter.Animatable
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Container as Clutter.Container
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Content as Clutter.Content
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.Action as Clutter.Action
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Animation as Clutter.Animation
import {-# SOURCE #-} qualified GI.Clutter.Objects.Animator as Clutter.Animator
import {-# SOURCE #-} qualified GI.Clutter.Objects.Backend as Clutter.Backend
import {-# SOURCE #-} qualified GI.Clutter.Objects.ChildMeta as Clutter.ChildMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Constraint as Clutter.Constraint
import {-# SOURCE #-} qualified GI.Clutter.Objects.DeviceManager as Clutter.DeviceManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.Effect as Clutter.Effect
import {-# SOURCE #-} qualified GI.Clutter.Objects.Group as Clutter.Group
import {-# SOURCE #-} qualified GI.Clutter.Objects.InputDevice as Clutter.InputDevice
import {-# SOURCE #-} qualified GI.Clutter.Objects.Interval as Clutter.Interval
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutManager as Clutter.LayoutManager
import {-# SOURCE #-} qualified GI.Clutter.Objects.LayoutMeta as Clutter.LayoutMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Script as Clutter.Script
import {-# SOURCE #-} qualified GI.Clutter.Objects.Shader as Clutter.Shader
import {-# SOURCE #-} qualified GI.Clutter.Objects.Stage as Clutter.Stage
import {-# SOURCE #-} qualified GI.Clutter.Objects.State as Clutter.State
import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import {-# SOURCE #-} qualified GI.Clutter.Objects.Transition as Clutter.Transition
import {-# SOURCE #-} qualified GI.Clutter.Structs.ActorBox as Clutter.ActorBox
import {-# SOURCE #-} qualified GI.Clutter.Structs.AnimatorKey as Clutter.AnimatorKey
import {-# SOURCE #-} qualified GI.Clutter.Structs.ButtonEvent as Clutter.ButtonEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Color as Clutter.Color
import {-# SOURCE #-} qualified GI.Clutter.Structs.CrossingEvent as Clutter.CrossingEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.EventSequence as Clutter.EventSequence
import {-# SOURCE #-} qualified GI.Clutter.Structs.Fog as Clutter.Fog
import {-# SOURCE #-} qualified GI.Clutter.Structs.Geometry as Clutter.Geometry
import {-# SOURCE #-} qualified GI.Clutter.Structs.KeyEvent as Clutter.KeyEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Margin as Clutter.Margin
import {-# SOURCE #-} qualified GI.Clutter.Structs.Matrix as Clutter.Matrix
import {-# SOURCE #-} qualified GI.Clutter.Structs.MotionEvent as Clutter.MotionEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.PaintVolume as Clutter.PaintVolume
import {-# SOURCE #-} qualified GI.Clutter.Structs.Perspective as Clutter.Perspective
import {-# SOURCE #-} qualified GI.Clutter.Structs.Point as Clutter.Point
import {-# SOURCE #-} qualified GI.Clutter.Structs.Rect as Clutter.Rect
import {-# SOURCE #-} qualified GI.Clutter.Structs.ScrollEvent as Clutter.ScrollEvent
import {-# SOURCE #-} qualified GI.Clutter.Structs.Size as Clutter.Size
import {-# SOURCE #-} qualified GI.Clutter.Structs.StateKey as Clutter.StateKey
import {-# SOURCE #-} qualified GI.Clutter.Structs.Vertex as Clutter.Vertex
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Json.Structs.Node as Json.Node
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.Layout as Pango.Layout

#else
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor

#endif

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

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

instance BoxedPtr ActorIter where
    boxedPtrCopy :: ActorIter -> IO ActorIter
boxedPtrCopy = \ActorIter
p -> ActorIter -> (Ptr ActorIter -> IO ActorIter) -> IO ActorIter
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ActorIter
p (Int -> Ptr ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
40 (Ptr ActorIter -> IO (Ptr ActorIter))
-> (Ptr ActorIter -> IO ActorIter) -> Ptr ActorIter -> IO ActorIter
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ActorIter -> ActorIter)
-> Ptr ActorIter -> IO ActorIter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ActorIter -> ActorIter
ActorIter)
    boxedPtrFree :: ActorIter -> IO ()
boxedPtrFree = \ActorIter
x -> ActorIter -> (Ptr ActorIter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ActorIter
x Ptr ActorIter -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ActorIter where
    boxedPtrCalloc :: IO (Ptr ActorIter)
boxedPtrCalloc = Int -> IO (Ptr ActorIter)
forall a. Int -> IO (Ptr a)
callocBytes Int
40


-- | Construct a `ActorIter` struct initialized to zero.
newZeroActorIter :: MonadIO m => m ActorIter
newZeroActorIter :: forall (m :: * -> *). MonadIO m => m ActorIter
newZeroActorIter = IO ActorIter -> m ActorIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActorIter -> m ActorIter) -> IO ActorIter -> m ActorIter
forall a b. (a -> b) -> a -> b
$ IO (Ptr ActorIter)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ActorIter)
-> (Ptr ActorIter -> IO ActorIter) -> IO ActorIter
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ActorIter -> ActorIter)
-> Ptr ActorIter -> IO ActorIter
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActorIter -> ActorIter
ActorIter

instance tag ~ 'AttrSet => Constructible ActorIter tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ActorIter -> ActorIter)
-> [AttrOp ActorIter tag] -> m ActorIter
new ManagedPtr ActorIter -> ActorIter
_ [AttrOp ActorIter tag]
attrs = do
        ActorIter
o <- m ActorIter
forall (m :: * -> *). MonadIO m => m ActorIter
newZeroActorIter
        ActorIter -> [AttrOp ActorIter 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ActorIter
o [AttrOp ActorIter tag]
[AttrOp ActorIter 'AttrSet]
attrs
        ActorIter -> m ActorIter
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorIter
o



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

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

foreign import ccall "clutter_actor_iter_destroy" clutter_actor_iter_destroy :: 
    Ptr ActorIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ActorIter"})
    IO ()

-- | Safely destroys the t'GI.Clutter.Objects.Actor.Actor' currently pointer to by the iterator
-- from its parent.
-- 
-- This function can only be called after 'GI.Clutter.Structs.ActorIter.actorIterNext' or
-- 'GI.Clutter.Structs.ActorIter.actorIterPrev' returned 'P.True', and cannot be called more
-- than once for the same actor.
-- 
-- This function will call 'GI.Clutter.Objects.Actor.actorDestroy' internally.
-- 
-- /Since: 1.10/
actorIterDestroy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorIter
    -- ^ /@iter@/: a t'GI.Clutter.Structs.ActorIter.ActorIter'
    -> m ()
actorIterDestroy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorIter -> m ()
actorIterDestroy ActorIter
iter = 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 ActorIter
iter' <- ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorIter
iter
    Ptr ActorIter -> IO ()
clutter_actor_iter_destroy Ptr ActorIter
iter'
    ActorIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorIter
iter
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ActorIterDestroyMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ActorIterDestroyMethodInfo ActorIter signature where
    overloadedMethod = actorIterDestroy

instance O.OverloadedMethodInfo ActorIterDestroyMethodInfo ActorIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorIter.actorIterDestroy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Structs-ActorIter.html#v:actorIterDestroy"
        })


#endif

-- method ActorIter::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_iter_init" clutter_actor_iter_init :: 
    Ptr ActorIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ActorIter"})
    Ptr Clutter.Actor.Actor ->              -- root : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Initializes a t'GI.Clutter.Structs.ActorIter.ActorIter', which can then be used to iterate
-- efficiently over a section of the scene graph, and associates it
-- with /@root@/.
-- 
-- Modifying the scene graph section that contains /@root@/ will invalidate
-- the iterator.
-- 
-- 
-- === /C code/
-- >
-- >  ClutterActorIter iter;
-- >  ClutterActor *child;
-- >
-- >  clutter_actor_iter_init (&iter, container);
-- >  while (clutter_actor_iter_next (&iter, &child))
-- >    {
-- >      // do something with child
-- >    }
-- 
-- 
-- /Since: 1.10/
actorIterInit ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    ActorIter
    -- ^ /@iter@/: a t'GI.Clutter.Structs.ActorIter.ActorIter'
    -> a
    -- ^ /@root@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> m ()
actorIterInit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
ActorIter -> a -> m ()
actorIterInit ActorIter
iter a
root = 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 ActorIter
iter' <- ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorIter
iter
    Ptr Actor
root' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
root
    Ptr ActorIter -> Ptr Actor -> IO ()
clutter_actor_iter_init Ptr ActorIter
iter' Ptr Actor
root'
    ActorIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorIter
iter
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
root
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ActorIterInitMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, Clutter.Actor.IsActor a) => O.OverloadedMethod ActorIterInitMethodInfo ActorIter signature where
    overloadedMethod = actorIterInit

instance O.OverloadedMethodInfo ActorIterInitMethodInfo ActorIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorIter.actorIterInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Structs-ActorIter.html#v:actorIterInit"
        })


#endif

-- method ActorIter::is_valid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_iter_is_valid" clutter_actor_iter_is_valid :: 
    Ptr ActorIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ActorIter"})
    IO CInt

-- | Checks whether a t'GI.Clutter.Structs.ActorIter.ActorIter' is still valid.
-- 
-- An iterator is considered valid if it has been initialized, and
-- if the t'GI.Clutter.Objects.Actor.Actor' that it refers to hasn\'t been modified after
-- the initialization.
-- 
-- /Since: 1.12/
actorIterIsValid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorIter
    -- ^ /@iter@/: a t'GI.Clutter.Structs.ActorIter.ActorIter'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the iterator is valid, and 'P.False' otherwise
actorIterIsValid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorIter -> m Bool
actorIterIsValid ActorIter
iter = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorIter
iter' <- ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorIter
iter
    CInt
result <- Ptr ActorIter -> IO CInt
clutter_actor_iter_is_valid Ptr ActorIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ActorIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorIter
iter
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ActorIterIsValidMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod ActorIterIsValidMethodInfo ActorIter signature where
    overloadedMethod = actorIterIsValid

instance O.OverloadedMethodInfo ActorIterIsValidMethodInfo ActorIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorIter.actorIterIsValid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Structs-ActorIter.html#v:actorIterIsValid"
        })


#endif

-- method ActorIter::next
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #ClutterActor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_iter_next" clutter_actor_iter_next :: 
    Ptr ActorIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ActorIter"})
    Ptr (Ptr Clutter.Actor.Actor) ->        -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO CInt

-- | Advances the /@iter@/ and retrieves the next child of the root t'GI.Clutter.Objects.Actor.Actor'
-- that was used to initialize the @/ClutterActorIterator/@.
-- 
-- If the iterator can advance, this function returns 'P.True' and sets the
-- /@child@/ argument.
-- 
-- If the iterator cannot advance, this function returns 'P.False', and
-- the contents of /@child@/ are undefined.
-- 
-- /Since: 1.10/
actorIterNext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorIter
    -- ^ /@iter@/: a t'GI.Clutter.Structs.ActorIter.ActorIter'
    -> m ((Bool, Clutter.Actor.Actor))
    -- ^ __Returns:__ 'P.True' if the iterator could advance, and 'P.False' otherwise.
actorIterNext :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorIter -> m (Bool, Actor)
actorIterNext ActorIter
iter = IO (Bool, Actor) -> m (Bool, Actor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Actor) -> m (Bool, Actor))
-> IO (Bool, Actor) -> m (Bool, Actor)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorIter
iter' <- ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorIter
iter
    Ptr (Ptr Actor)
child <- IO (Ptr (Ptr Actor))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Clutter.Actor.Actor))
    CInt
result <- Ptr ActorIter -> Ptr (Ptr Actor) -> IO CInt
clutter_actor_iter_next Ptr ActorIter
iter' Ptr (Ptr Actor)
child
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Actor
child' <- Ptr (Ptr Actor) -> IO (Ptr Actor)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Actor)
child
    Actor
child'' <- ((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
child'
    ActorIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorIter
iter
    Ptr (Ptr Actor) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Actor)
child
    (Bool, Actor) -> IO (Bool, Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Actor
child'')

#if defined(ENABLE_OVERLOADING)
data ActorIterNextMethodInfo
instance (signature ~ (m ((Bool, Clutter.Actor.Actor))), MonadIO m) => O.OverloadedMethod ActorIterNextMethodInfo ActorIter signature where
    overloadedMethod = actorIterNext

instance O.OverloadedMethodInfo ActorIterNextMethodInfo ActorIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorIter.actorIterNext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Structs-ActorIter.html#v:actorIterNext"
        })


#endif

-- method ActorIter::prev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ActorIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActorIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #ClutterActor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_actor_iter_prev" clutter_actor_iter_prev :: 
    Ptr ActorIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ActorIter"})
    Ptr (Ptr Clutter.Actor.Actor) ->        -- child : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO CInt

-- | Advances the /@iter@/ and retrieves the previous child of the root
-- t'GI.Clutter.Objects.Actor.Actor' that was used to initialize the @/ClutterActorIterator/@.
-- 
-- If the iterator can advance, this function returns 'P.True' and sets the
-- /@child@/ argument.
-- 
-- If the iterator cannot advance, this function returns 'P.False', and
-- the contents of /@child@/ are undefined.
-- 
-- /Since: 1.10/
actorIterPrev ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorIter
    -- ^ /@iter@/: a t'GI.Clutter.Structs.ActorIter.ActorIter'
    -> m ((Bool, Clutter.Actor.Actor))
    -- ^ __Returns:__ 'P.True' if the iterator could advance, and 'P.False' otherwise.
actorIterPrev :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorIter -> m (Bool, Actor)
actorIterPrev ActorIter
iter = IO (Bool, Actor) -> m (Bool, Actor)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Actor) -> m (Bool, Actor))
-> IO (Bool, Actor) -> m (Bool, Actor)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ActorIter
iter' <- ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorIter
iter
    Ptr (Ptr Actor)
child <- IO (Ptr (Ptr Actor))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Clutter.Actor.Actor))
    CInt
result <- Ptr ActorIter -> Ptr (Ptr Actor) -> IO CInt
clutter_actor_iter_prev Ptr ActorIter
iter' Ptr (Ptr Actor)
child
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Actor
child' <- Ptr (Ptr Actor) -> IO (Ptr Actor)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Actor)
child
    Actor
child'' <- ((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
child'
    ActorIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorIter
iter
    Ptr (Ptr Actor) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Actor)
child
    (Bool, Actor) -> IO (Bool, Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Actor
child'')

#if defined(ENABLE_OVERLOADING)
data ActorIterPrevMethodInfo
instance (signature ~ (m ((Bool, Clutter.Actor.Actor))), MonadIO m) => O.OverloadedMethod ActorIterPrevMethodInfo ActorIter signature where
    overloadedMethod = actorIterPrev

instance O.OverloadedMethodInfo ActorIterPrevMethodInfo ActorIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorIter.actorIterPrev",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Structs-ActorIter.html#v:actorIterPrev"
        })


#endif

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

foreign import ccall "clutter_actor_iter_remove" clutter_actor_iter_remove :: 
    Ptr ActorIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ActorIter"})
    IO ()

-- | Safely removes the t'GI.Clutter.Objects.Actor.Actor' currently pointer to by the iterator
-- from its parent.
-- 
-- This function can only be called after 'GI.Clutter.Structs.ActorIter.actorIterNext' or
-- 'GI.Clutter.Structs.ActorIter.actorIterPrev' returned 'P.True', and cannot be called more
-- than once for the same actor.
-- 
-- This function will call 'GI.Clutter.Objects.Actor.actorRemoveChild' internally.
-- 
-- /Since: 1.10/
actorIterRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ActorIter
    -- ^ /@iter@/: a t'GI.Clutter.Structs.ActorIter.ActorIter'
    -> m ()
actorIterRemove :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ActorIter -> m ()
actorIterRemove ActorIter
iter = 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 ActorIter
iter' <- ActorIter -> IO (Ptr ActorIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ActorIter
iter
    Ptr ActorIter -> IO ()
clutter_actor_iter_remove Ptr ActorIter
iter'
    ActorIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ActorIter
iter
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ActorIterRemoveMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ActorIterRemoveMethodInfo ActorIter signature where
    overloadedMethod = actorIterRemove

instance O.OverloadedMethodInfo ActorIterRemoveMethodInfo ActorIter where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.ActorIter.actorIterRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.6/docs/GI-Clutter-Structs-ActorIter.html#v:actorIterRemove"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveActorIterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveActorIterMethod "destroy" o = ActorIterDestroyMethodInfo
    ResolveActorIterMethod "init" o = ActorIterInitMethodInfo
    ResolveActorIterMethod "isValid" o = ActorIterIsValidMethodInfo
    ResolveActorIterMethod "next" o = ActorIterNextMethodInfo
    ResolveActorIterMethod "prev" o = ActorIterPrevMethodInfo
    ResolveActorIterMethod "remove" o = ActorIterRemoveMethodInfo
    ResolveActorIterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif