{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Base class for list models iters. The t'GI.Clutter.Objects.ModelIter.ModelIter' structure
-- contains only private data and should be manipulated using the
-- provided API.
-- 
-- /Since: 0.6/

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

module GI.Clutter.Objects.ModelIter
    ( 

-- * Exported types
    ModelIter(..)                           ,
    IsModelIter                             ,
    toModelIter                             ,


 -- * 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"), [copy]("GI.Clutter.Objects.ModelIter#g:method:copy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFirst]("GI.Clutter.Objects.ModelIter#g:method:isFirst"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLast]("GI.Clutter.Objects.ModelIter#g:method:isLast"), [next]("GI.Clutter.Objects.ModelIter#g:method:next"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prev]("GI.Clutter.Objects.ModelIter#g:method:prev"), [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"), [getModel]("GI.Clutter.Objects.ModelIter#g:method:getModel"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRow]("GI.Clutter.Objects.ModelIter#g:method:getRow"), [getValue]("GI.Clutter.Objects.ModelIter#g:method:getValue").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setValue]("GI.Clutter.Objects.ModelIter#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveModelIterMethod                  ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    ModelIterCopyMethodInfo                 ,
#endif
    modelIterCopy                           ,


-- ** getModel #method:getModel#

#if defined(ENABLE_OVERLOADING)
    ModelIterGetModelMethodInfo             ,
#endif
    modelIterGetModel                       ,


-- ** getRow #method:getRow#

#if defined(ENABLE_OVERLOADING)
    ModelIterGetRowMethodInfo               ,
#endif
    modelIterGetRow                         ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    ModelIterGetValueMethodInfo             ,
#endif
    modelIterGetValue                       ,


-- ** isFirst #method:isFirst#

#if defined(ENABLE_OVERLOADING)
    ModelIterIsFirstMethodInfo              ,
#endif
    modelIterIsFirst                        ,


-- ** isLast #method:isLast#

#if defined(ENABLE_OVERLOADING)
    ModelIterIsLastMethodInfo               ,
#endif
    modelIterIsLast                         ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    ModelIterNextMethodInfo                 ,
#endif
    modelIterNext                           ,


-- ** prev #method:prev#

#if defined(ENABLE_OVERLOADING)
    ModelIterPrevMethodInfo                 ,
#endif
    modelIterPrev                           ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    ModelIterSetValueMethodInfo             ,
#endif
    modelIterSetValue                       ,




 -- * Properties


-- ** model #attr:model#
-- | A reference to the t'GI.Clutter.Objects.Model.Model' that this iter belongs to.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    ModelIterModelPropertyInfo              ,
#endif
    clearModelIterModel                     ,
    constructModelIterModel                 ,
    getModelIterModel                       ,
#if defined(ENABLE_OVERLOADING)
    modelIterModel                          ,
#endif
    setModelIterModel                       ,


-- ** row #attr:row#
-- | The row number to which this iter points to.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    ModelIterRowPropertyInfo                ,
#endif
    constructModelIterRow                   ,
    getModelIterRow                         ,
#if defined(ENABLE_OVERLOADING)
    modelIterRow                            ,
#endif
    setModelIterRow                         ,




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

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

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

foreign import ccall "clutter_model_iter_get_type"
    c_clutter_model_iter_get_type :: IO B.Types.GType

instance B.Types.TypedObject ModelIter where
    glibType :: IO GType
glibType = IO GType
c_clutter_model_iter_get_type

instance B.Types.GObject ModelIter

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveModelIterMethod (t :: Symbol) (o :: *) :: * where
    ResolveModelIterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveModelIterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveModelIterMethod "copy" o = ModelIterCopyMethodInfo
    ResolveModelIterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveModelIterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveModelIterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveModelIterMethod "isFirst" o = ModelIterIsFirstMethodInfo
    ResolveModelIterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveModelIterMethod "isLast" o = ModelIterIsLastMethodInfo
    ResolveModelIterMethod "next" o = ModelIterNextMethodInfo
    ResolveModelIterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveModelIterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveModelIterMethod "prev" o = ModelIterPrevMethodInfo
    ResolveModelIterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveModelIterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveModelIterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveModelIterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveModelIterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveModelIterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveModelIterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveModelIterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveModelIterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveModelIterMethod "getModel" o = ModelIterGetModelMethodInfo
    ResolveModelIterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveModelIterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveModelIterMethod "getRow" o = ModelIterGetRowMethodInfo
    ResolveModelIterMethod "getValue" o = ModelIterGetValueMethodInfo
    ResolveModelIterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveModelIterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveModelIterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveModelIterMethod "setValue" o = ModelIterSetValueMethodInfo
    ResolveModelIterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "model"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Model"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' modelIter #model
-- @
getModelIterModel :: (MonadIO m, IsModelIter o) => o -> m Clutter.Model.Model
getModelIterModel :: forall (m :: * -> *) o. (MonadIO m, IsModelIter o) => o -> m Model
getModelIterModel o
obj = IO Model -> m Model
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Model -> m Model) -> IO Model -> m Model
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Model) -> IO Model
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getModelIterModel" (IO (Maybe Model) -> IO Model) -> IO (Maybe Model) -> IO Model
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Model -> Model) -> IO (Maybe Model)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"model" ManagedPtr Model -> Model
Clutter.Model.Model

-- | Set the value of the “@model@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' modelIter [ #model 'Data.GI.Base.Attributes.:=' value ]
-- @
setModelIterModel :: (MonadIO m, IsModelIter o, Clutter.Model.IsModel a) => o -> a -> m ()
setModelIterModel :: forall (m :: * -> *) o a.
(MonadIO m, IsModelIter o, IsModel a) =>
o -> a -> m ()
setModelIterModel o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@model@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructModelIterModel :: (IsModelIter o, MIO.MonadIO m, Clutter.Model.IsModel a) => a -> m (GValueConstruct o)
constructModelIterModel :: forall o (m :: * -> *) a.
(IsModelIter o, MonadIO m, IsModel a) =>
a -> m (GValueConstruct o)
constructModelIterModel a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"model" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@model@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #model
-- @
clearModelIterModel :: (MonadIO m, IsModelIter o) => o -> m ()
clearModelIterModel :: forall (m :: * -> *) o. (MonadIO m, IsModelIter o) => o -> m ()
clearModelIterModel o
obj = 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
$ o -> String -> Maybe Model -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"model" (Maybe Model
forall a. Maybe a
Nothing :: Maybe Clutter.Model.Model)

#if defined(ENABLE_OVERLOADING)
data ModelIterModelPropertyInfo
instance AttrInfo ModelIterModelPropertyInfo where
    type AttrAllowedOps ModelIterModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ModelIterModelPropertyInfo = IsModelIter
    type AttrSetTypeConstraint ModelIterModelPropertyInfo = Clutter.Model.IsModel
    type AttrTransferTypeConstraint ModelIterModelPropertyInfo = Clutter.Model.IsModel
    type AttrTransferType ModelIterModelPropertyInfo = Clutter.Model.Model
    type AttrGetType ModelIterModelPropertyInfo = Clutter.Model.Model
    type AttrLabel ModelIterModelPropertyInfo = "model"
    type AttrOrigin ModelIterModelPropertyInfo = ModelIter
    attrGet = getModelIterModel
    attrSet = setModelIterModel
    attrTransfer _ v = do
        unsafeCastTo Clutter.Model.Model v
    attrConstruct = constructModelIterModel
    attrClear = clearModelIterModel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ModelIter.model"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-ModelIter.html#g:attr:model"
        })
#endif

-- VVV Prop "row"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@row@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' modelIter #row
-- @
getModelIterRow :: (MonadIO m, IsModelIter o) => o -> m Word32
getModelIterRow :: forall (m :: * -> *) o. (MonadIO m, IsModelIter o) => o -> m Word32
getModelIterRow o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"row"

-- | Set the value of the “@row@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' modelIter [ #row 'Data.GI.Base.Attributes.:=' value ]
-- @
setModelIterRow :: (MonadIO m, IsModelIter o) => o -> Word32 -> m ()
setModelIterRow :: forall (m :: * -> *) o.
(MonadIO m, IsModelIter o) =>
o -> Word32 -> m ()
setModelIterRow o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"row" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@row@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructModelIterRow :: (IsModelIter o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructModelIterRow :: forall o (m :: * -> *).
(IsModelIter o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructModelIterRow Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"row" Word32
val

#if defined(ENABLE_OVERLOADING)
data ModelIterRowPropertyInfo
instance AttrInfo ModelIterRowPropertyInfo where
    type AttrAllowedOps ModelIterRowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ModelIterRowPropertyInfo = IsModelIter
    type AttrSetTypeConstraint ModelIterRowPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint ModelIterRowPropertyInfo = (~) Word32
    type AttrTransferType ModelIterRowPropertyInfo = Word32
    type AttrGetType ModelIterRowPropertyInfo = Word32
    type AttrLabel ModelIterRowPropertyInfo = "row"
    type AttrOrigin ModelIterRowPropertyInfo = ModelIter
    attrGet = getModelIterRow
    attrSet = setModelIterRow
    attrTransfer _ v = do
        return v
    attrConstruct = constructModelIterRow
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.ModelIter.row"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-ModelIter.html#g:attr:row"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ModelIter
type instance O.AttributeList ModelIter = ModelIterAttributeList
type ModelIterAttributeList = ('[ '("model", ModelIterModelPropertyInfo), '("row", ModelIterRowPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
modelIterModel :: AttrLabelProxy "model"
modelIterModel = AttrLabelProxy

modelIterRow :: AttrLabelProxy "row"
modelIterRow = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ModelIter = ModelIterSignalList
type ModelIterSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

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

{-# DEPRECATED modelIterCopy ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Copies the passed iterator.
-- 
-- /Since: 0.8/
modelIterCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m ModelIter
    -- ^ __Returns:__ a copy of the iterator, or 'P.Nothing'
modelIterCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m ModelIter
modelIterCopy a
iter = IO ModelIter -> m ModelIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModelIter -> m ModelIter) -> IO ModelIter -> m ModelIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Ptr ModelIter
result <- Ptr ModelIter -> IO (Ptr ModelIter)
clutter_model_iter_copy Ptr ModelIter
iter'
    Text -> Ptr ModelIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelIterCopy" Ptr ModelIter
result
    ModelIter
result' <- ((ManagedPtr ModelIter -> ModelIter)
-> Ptr ModelIter -> IO ModelIter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ModelIter -> ModelIter
ModelIter) Ptr ModelIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    ModelIter -> IO ModelIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModelIter
result'

#if defined(ENABLE_OVERLOADING)
data ModelIterCopyMethodInfo
instance (signature ~ (m ModelIter), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterCopyMethodInfo a signature where
    overloadedMethod = modelIterCopy

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


#endif

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

foreign import ccall "clutter_model_iter_get_model" clutter_model_iter_get_model :: 
    Ptr ModelIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ModelIter"})
    IO (Ptr Clutter.Model.Model)

{-# DEPRECATED modelIterGetModel ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves a pointer to the t'GI.Clutter.Objects.Model.Model' that this iter is part of.
-- 
-- /Since: 0.6/
modelIterGetModel ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m Clutter.Model.Model
    -- ^ __Returns:__ a pointer to a t'GI.Clutter.Objects.Model.Model'.
modelIterGetModel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m Model
modelIterGetModel a
iter = IO Model -> m Model
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Model -> m Model) -> IO Model -> m Model
forall a b. (a -> b) -> a -> b
$ do
    Ptr ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Ptr Model
result <- Ptr ModelIter -> IO (Ptr Model)
clutter_model_iter_get_model Ptr ModelIter
iter'
    Text -> Ptr Model -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelIterGetModel" Ptr Model
result
    Model
result' <- ((ManagedPtr Model -> Model) -> Ptr Model -> IO Model
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Model -> Model
Clutter.Model.Model) Ptr Model
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    Model -> IO Model
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Model
result'

#if defined(ENABLE_OVERLOADING)
data ModelIterGetModelMethodInfo
instance (signature ~ (m Clutter.Model.Model), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterGetModelMethodInfo a signature where
    overloadedMethod = modelIterGetModel

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


#endif

-- method ModelIter::get_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModelIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModelIter"
--                 , 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 "clutter_model_iter_get_row" clutter_model_iter_get_row :: 
    Ptr ModelIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ModelIter"})
    IO Word32

{-# DEPRECATED modelIterGetRow ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves the position of the row that the /@iter@/ points to.
-- 
-- /Since: 0.6/
modelIterGetRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m Word32
    -- ^ __Returns:__ the position of the /@iter@/ in the model
modelIterGetRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m Word32
modelIterGetRow a
iter = IO Word32 -> m Word32
forall a. IO a -> m a
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 ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Word32
result <- Ptr ModelIter -> IO Word32
clutter_model_iter_get_row Ptr ModelIter
iter'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ModelIterGetRowMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterGetRowMethodInfo a signature where
    overloadedMethod = modelIterGetRow

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


#endif

-- method ModelIter::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModelIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModelIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "column number to retrieve the value from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an empty #GValue to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_iter_get_value" clutter_model_iter_get_value :: 
    Ptr ModelIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ModelIter"})
    Word32 ->                               -- column : TBasicType TUInt
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED modelIterGetValue ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Sets an initializes /@value@/ to that at /@column@/. When done with /@value@/,
-- 'GI.GObject.Structs.Value.valueUnset' needs to be called to free any allocated memory.
-- 
-- /Since: 0.6/
modelIterGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> Word32
    -- ^ /@column@/: column number to retrieve the value from
    -> m (GValue)
modelIterGetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> Word32 -> m GValue
modelIterGetValue a
iter Word32
column = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr ModelIter -> Word32 -> Ptr GValue -> IO ()
clutter_model_iter_get_value Ptr ModelIter
iter' Word32
column Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data ModelIterGetValueMethodInfo
instance (signature ~ (Word32 -> m (GValue)), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterGetValueMethodInfo a signature where
    overloadedMethod = modelIterGetValue

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


#endif

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

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

{-# DEPRECATED modelIterIsFirst ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Gets whether the current iterator is at the beginning of the model
-- to which it belongs.
-- 
-- /Since: 0.6/
modelIterIsFirst ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m Bool
    -- ^ __Returns:__ @/TRUE/@ if /@iter@/ is the first iter in the filtered model
modelIterIsFirst :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m Bool
modelIterIsFirst a
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 ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    CInt
result <- Ptr ModelIter -> IO CInt
clutter_model_iter_is_first Ptr ModelIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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 ModelIterIsFirstMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterIsFirstMethodInfo a signature where
    overloadedMethod = modelIterIsFirst

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


#endif

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

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

{-# DEPRECATED modelIterIsLast ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Gets whether the iterator is at the end of the model to which it
-- belongs.
-- 
-- /Since: 0.6/
modelIterIsLast ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m Bool
    -- ^ __Returns:__ @/TRUE/@ if /@iter@/ is the last iter in the filtered model.
modelIterIsLast :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m Bool
modelIterIsLast a
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 ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    CInt
result <- Ptr ModelIter -> IO CInt
clutter_model_iter_is_last Ptr ModelIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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 ModelIterIsLastMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterIsLastMethodInfo a signature where
    overloadedMethod = modelIterIsLast

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


#endif

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

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

{-# DEPRECATED modelIterNext ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Updates the /@iter@/ to point at the next position in the model.
-- The model implementation should take into account the presence of
-- a filter function.
-- 
-- /Since: 0.6/
modelIterNext ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m ModelIter
    -- ^ __Returns:__ The passed iterator, updated to point at the next
    --   row in the model.
modelIterNext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m ModelIter
modelIterNext a
iter = IO ModelIter -> m ModelIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModelIter -> m ModelIter) -> IO ModelIter -> m ModelIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Ptr ModelIter
result <- Ptr ModelIter -> IO (Ptr ModelIter)
clutter_model_iter_next Ptr ModelIter
iter'
    Text -> Ptr ModelIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelIterNext" Ptr ModelIter
result
    ModelIter
result' <- ((ManagedPtr ModelIter -> ModelIter)
-> Ptr ModelIter -> IO ModelIter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ModelIter -> ModelIter
ModelIter) Ptr ModelIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    ModelIter -> IO ModelIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModelIter
result'

#if defined(ENABLE_OVERLOADING)
data ModelIterNextMethodInfo
instance (signature ~ (m ModelIter), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterNextMethodInfo a signature where
    overloadedMethod = modelIterNext

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


#endif

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

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

{-# DEPRECATED modelIterPrev ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Sets the /@iter@/ to point at the previous position in the model.
-- The model implementation should take into account the presence of
-- a filter function.
-- 
-- /Since: 0.6/
modelIterPrev ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> m ModelIter
    -- ^ __Returns:__ The passed iterator, updated to point at the previous
    --   row in the model.
modelIterPrev :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> m ModelIter
modelIterPrev a
iter = IO ModelIter -> m ModelIter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModelIter -> m ModelIter) -> IO ModelIter -> m ModelIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Ptr ModelIter
result <- Ptr ModelIter -> IO (Ptr ModelIter)
clutter_model_iter_prev Ptr ModelIter
iter'
    Text -> Ptr ModelIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelIterPrev" Ptr ModelIter
result
    ModelIter
result' <- ((ManagedPtr ModelIter -> ModelIter)
-> Ptr ModelIter -> IO ModelIter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ModelIter -> ModelIter
ModelIter) Ptr ModelIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    ModelIter -> IO ModelIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModelIter
result'

#if defined(ENABLE_OVERLOADING)
data ModelIterPrevMethodInfo
instance (signature ~ (m ModelIter), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterPrevMethodInfo a signature where
    overloadedMethod = modelIterPrev

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


#endif

-- method ModelIter::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModelIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModelIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "column number to retrieve the value from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new value for the cell"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_iter_set_value" clutter_model_iter_set_value :: 
    Ptr ModelIter ->                        -- iter : TInterface (Name {namespace = "Clutter", name = "ModelIter"})
    Word32 ->                               -- column : TBasicType TUInt
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED modelIterSetValue ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Sets the data in the cell specified by /@iter@/ and /@column@/. The type of
-- /@value@/ must be convertable to the type of the column.
-- 
-- /Since: 0.6/
modelIterSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsModelIter a) =>
    a
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter'
    -> Word32
    -- ^ /@column@/: column number to retrieve the value from
    -> GValue
    -- ^ /@value@/: new value for the cell
    -> m ()
modelIterSetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModelIter a) =>
a -> Word32 -> GValue -> m ()
modelIterSetValue a
iter Word32
column GValue
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ModelIter
iter' <- a -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
iter
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr ModelIter -> Word32 -> Ptr GValue -> IO ()
clutter_model_iter_set_value Ptr ModelIter
iter' Word32
column Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
iter
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelIterSetValueMethodInfo
instance (signature ~ (Word32 -> GValue -> m ()), MonadIO m, IsModelIter a) => O.OverloadedMethod ModelIterSetValueMethodInfo a signature where
    overloadedMethod = modelIterSetValue

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


#endif