{-# LANGUAGE ImplicitParams, RankNTypes, 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. The t'GI.Clutter.Objects.Model.Model' 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.Model
    ( 

-- * Exported types
    Model(..)                               ,
    IsModel                                 ,
    toModel                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendv]("GI.Clutter.Objects.Model#g:method:appendv"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [filterIter]("GI.Clutter.Objects.Model#g:method:filterIter"), [filterRow]("GI.Clutter.Objects.Model#g:method:filterRow"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.Clutter.Objects.Model#g:method:foreach"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [insertValue]("GI.Clutter.Objects.Model#g:method:insertValue"), [insertv]("GI.Clutter.Objects.Model#g:method:insertv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [prependv]("GI.Clutter.Objects.Model#g:method:prependv"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Clutter.Objects.Model#g:method:remove"), [resort]("GI.Clutter.Objects.Model#g:method:resort"), [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
-- [getColumnName]("GI.Clutter.Objects.Model#g:method:getColumnName"), [getColumnType]("GI.Clutter.Objects.Model#g:method:getColumnType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFilterSet]("GI.Clutter.Objects.Model#g:method:getFilterSet"), [getFirstIter]("GI.Clutter.Objects.Model#g:method:getFirstIter"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getIterAtRow]("GI.Clutter.Objects.Model#g:method:getIterAtRow"), [getLastIter]("GI.Clutter.Objects.Model#g:method:getLastIter"), [getNColumns]("GI.Clutter.Objects.Model#g:method:getNColumns"), [getNRows]("GI.Clutter.Objects.Model#g:method:getNRows"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSortingColumn]("GI.Clutter.Objects.Model#g:method:getSortingColumn").
-- 
-- ==== Setters
-- [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFilter]("GI.Clutter.Objects.Model#g:method:setFilter"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setNames]("GI.Clutter.Objects.Model#g:method:setNames"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSort]("GI.Clutter.Objects.Model#g:method:setSort"), [setSortingColumn]("GI.Clutter.Objects.Model#g:method:setSortingColumn"), [setTypes]("GI.Clutter.Objects.Model#g:method:setTypes").

#if defined(ENABLE_OVERLOADING)
    ResolveModelMethod                      ,
#endif

-- ** appendv #method:appendv#

#if defined(ENABLE_OVERLOADING)
    ModelAppendvMethodInfo                  ,
#endif
    modelAppendv                            ,


-- ** filterIter #method:filterIter#

#if defined(ENABLE_OVERLOADING)
    ModelFilterIterMethodInfo               ,
#endif
    modelFilterIter                         ,


-- ** filterRow #method:filterRow#

#if defined(ENABLE_OVERLOADING)
    ModelFilterRowMethodInfo                ,
#endif
    modelFilterRow                          ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    ModelForeachMethodInfo                  ,
#endif
    modelForeach                            ,


-- ** getColumnName #method:getColumnName#

#if defined(ENABLE_OVERLOADING)
    ModelGetColumnNameMethodInfo            ,
#endif
    modelGetColumnName                      ,


-- ** getColumnType #method:getColumnType#

#if defined(ENABLE_OVERLOADING)
    ModelGetColumnTypeMethodInfo            ,
#endif
    modelGetColumnType                      ,


-- ** getFilterSet #method:getFilterSet#

#if defined(ENABLE_OVERLOADING)
    ModelGetFilterSetMethodInfo             ,
#endif
    modelGetFilterSet                       ,


-- ** getFirstIter #method:getFirstIter#

#if defined(ENABLE_OVERLOADING)
    ModelGetFirstIterMethodInfo             ,
#endif
    modelGetFirstIter                       ,


-- ** getIterAtRow #method:getIterAtRow#

#if defined(ENABLE_OVERLOADING)
    ModelGetIterAtRowMethodInfo             ,
#endif
    modelGetIterAtRow                       ,


-- ** getLastIter #method:getLastIter#

#if defined(ENABLE_OVERLOADING)
    ModelGetLastIterMethodInfo              ,
#endif
    modelGetLastIter                        ,


-- ** getNColumns #method:getNColumns#

#if defined(ENABLE_OVERLOADING)
    ModelGetNColumnsMethodInfo              ,
#endif
    modelGetNColumns                        ,


-- ** getNRows #method:getNRows#

#if defined(ENABLE_OVERLOADING)
    ModelGetNRowsMethodInfo                 ,
#endif
    modelGetNRows                           ,


-- ** getSortingColumn #method:getSortingColumn#

#if defined(ENABLE_OVERLOADING)
    ModelGetSortingColumnMethodInfo         ,
#endif
    modelGetSortingColumn                   ,


-- ** insertValue #method:insertValue#

#if defined(ENABLE_OVERLOADING)
    ModelInsertValueMethodInfo              ,
#endif
    modelInsertValue                        ,


-- ** insertv #method:insertv#

#if defined(ENABLE_OVERLOADING)
    ModelInsertvMethodInfo                  ,
#endif
    modelInsertv                            ,


-- ** prependv #method:prependv#

#if defined(ENABLE_OVERLOADING)
    ModelPrependvMethodInfo                 ,
#endif
    modelPrependv                           ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ModelRemoveMethodInfo                   ,
#endif
    modelRemove                             ,


-- ** resort #method:resort#

#if defined(ENABLE_OVERLOADING)
    ModelResortMethodInfo                   ,
#endif
    modelResort                             ,


-- ** setFilter #method:setFilter#

#if defined(ENABLE_OVERLOADING)
    ModelSetFilterMethodInfo                ,
#endif
    modelSetFilter                          ,


-- ** setNames #method:setNames#

#if defined(ENABLE_OVERLOADING)
    ModelSetNamesMethodInfo                 ,
#endif
    modelSetNames                           ,


-- ** setSort #method:setSort#

#if defined(ENABLE_OVERLOADING)
    ModelSetSortMethodInfo                  ,
#endif
    modelSetSort                            ,


-- ** setSortingColumn #method:setSortingColumn#

#if defined(ENABLE_OVERLOADING)
    ModelSetSortingColumnMethodInfo         ,
#endif
    modelSetSortingColumn                   ,


-- ** setTypes #method:setTypes#

#if defined(ENABLE_OVERLOADING)
    ModelSetTypesMethodInfo                 ,
#endif
    modelSetTypes                           ,




 -- * Properties


-- ** filterSet #attr:filterSet#
-- | Whether the t'GI.Clutter.Objects.Model.Model' has a filter set
-- 
-- This property is set to 'P.True' if a filter function has been
-- set using 'GI.Clutter.Objects.Model.modelSetFilter'
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    ModelFilterSetPropertyInfo              ,
#endif
    getModelFilterSet                       ,
#if defined(ENABLE_OVERLOADING)
    modelFilterSet                          ,
#endif




 -- * Signals


-- ** filterChanged #signal:filterChanged#

    ModelFilterChangedCallback              ,
#if defined(ENABLE_OVERLOADING)
    ModelFilterChangedSignalInfo            ,
#endif
    afterModelFilterChanged                 ,
    onModelFilterChanged                    ,


-- ** rowAdded #signal:rowAdded#

    ModelRowAddedCallback                   ,
#if defined(ENABLE_OVERLOADING)
    ModelRowAddedSignalInfo                 ,
#endif
    afterModelRowAdded                      ,
    onModelRowAdded                         ,


-- ** rowChanged #signal:rowChanged#

    ModelRowChangedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ModelRowChangedSignalInfo               ,
#endif
    afterModelRowChanged                    ,
    onModelRowChanged                       ,


-- ** rowRemoved #signal:rowRemoved#

    ModelRowRemovedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    ModelRowRemovedSignalInfo               ,
#endif
    afterModelRowRemoved                    ,
    onModelRowRemoved                       ,


-- ** sortChanged #signal:sortChanged#

    ModelSortChangedCallback                ,
#if defined(ENABLE_OVERLOADING)
    ModelSortChangedSignalInfo              ,
#endif
    afterModelSortChanged                   ,
    onModelSortChanged                      ,




    ) 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 qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import {-# SOURCE #-} qualified GI.Clutter.Objects.ModelIter as Clutter.ModelIter
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_model_get_type"
    c_clutter_model_get_type :: IO B.Types.GType

instance B.Types.TypedObject Model where
    glibType :: IO GType
glibType = IO GType
c_clutter_model_get_type

instance B.Types.GObject Model

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

instance O.HasParentTypes Model
type instance O.ParentTypes Model = '[GObject.Object.Object, Clutter.Scriptable.Scriptable]

-- | Cast to `Model`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toModel :: (MIO.MonadIO m, IsModel o) => o -> m Model
toModel :: forall (m :: * -> *) o. (MonadIO m, IsModel o) => o -> m Model
toModel = 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) -> (o -> IO Model) -> o -> m Model
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Model -> Model) -> o -> IO Model
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Model -> Model
Model

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

#if defined(ENABLE_OVERLOADING)
type family ResolveModelMethod (t :: Symbol) (o :: *) :: * where
    ResolveModelMethod "appendv" o = ModelAppendvMethodInfo
    ResolveModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveModelMethod "filterIter" o = ModelFilterIterMethodInfo
    ResolveModelMethod "filterRow" o = ModelFilterRowMethodInfo
    ResolveModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveModelMethod "foreach" o = ModelForeachMethodInfo
    ResolveModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveModelMethod "insertValue" o = ModelInsertValueMethodInfo
    ResolveModelMethod "insertv" o = ModelInsertvMethodInfo
    ResolveModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveModelMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveModelMethod "prependv" o = ModelPrependvMethodInfo
    ResolveModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveModelMethod "remove" o = ModelRemoveMethodInfo
    ResolveModelMethod "resort" o = ModelResortMethodInfo
    ResolveModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveModelMethod "getColumnName" o = ModelGetColumnNameMethodInfo
    ResolveModelMethod "getColumnType" o = ModelGetColumnTypeMethodInfo
    ResolveModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveModelMethod "getFilterSet" o = ModelGetFilterSetMethodInfo
    ResolveModelMethod "getFirstIter" o = ModelGetFirstIterMethodInfo
    ResolveModelMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveModelMethod "getIterAtRow" o = ModelGetIterAtRowMethodInfo
    ResolveModelMethod "getLastIter" o = ModelGetLastIterMethodInfo
    ResolveModelMethod "getNColumns" o = ModelGetNColumnsMethodInfo
    ResolveModelMethod "getNRows" o = ModelGetNRowsMethodInfo
    ResolveModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveModelMethod "getSortingColumn" o = ModelGetSortingColumnMethodInfo
    ResolveModelMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveModelMethod "setFilter" o = ModelSetFilterMethodInfo
    ResolveModelMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveModelMethod "setNames" o = ModelSetNamesMethodInfo
    ResolveModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveModelMethod "setSort" o = ModelSetSortMethodInfo
    ResolveModelMethod "setSortingColumn" o = ModelSetSortingColumnMethodInfo
    ResolveModelMethod "setTypes" o = ModelSetTypesMethodInfo
    ResolveModelMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Model::filter-changed
{-# DEPRECATED ModelFilterChangedCallback ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | The [filterChanged](#g:signal:filterChanged) signal is emitted when a new filter has been applied
-- 
-- /Since: 0.6/
type ModelFilterChangedCallback =
    IO ()

type C_ModelFilterChangedCallback =
    Ptr Model ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ModelFilterChangedCallback :: 
    GObject a => (a -> ModelFilterChangedCallback) ->
    C_ModelFilterChangedCallback
wrap_ModelFilterChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_ModelFilterChangedCallback
wrap_ModelFilterChangedCallback a -> IO ()
gi'cb Ptr Model
gi'selfPtr Ptr ()
_ = do
    Ptr Model -> (Model -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Model
gi'selfPtr ((Model -> IO ()) -> IO ()) -> (Model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Model
gi'self -> a -> IO ()
gi'cb (Model -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Model
gi'self) 


-- | Connect a signal handler for the [filterChanged](#signal:filterChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' model #filterChanged callback
-- @
-- 
-- 
onModelFilterChanged :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelFilterChangedCallback) -> m SignalHandlerId
onModelFilterChanged :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onModelFilterChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ModelFilterChangedCallback
wrapped' = (a -> IO ()) -> C_ModelFilterChangedCallback
forall a. GObject a => (a -> IO ()) -> C_ModelFilterChangedCallback
wrap_ModelFilterChangedCallback a -> IO ()
wrapped
    FunPtr C_ModelFilterChangedCallback
wrapped'' <- C_ModelFilterChangedCallback
-> IO (FunPtr C_ModelFilterChangedCallback)
mk_ModelFilterChangedCallback C_ModelFilterChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelFilterChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"filter-changed" FunPtr C_ModelFilterChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [filterChanged](#signal:filterChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' model #filterChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterModelFilterChanged :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelFilterChangedCallback) -> m SignalHandlerId
afterModelFilterChanged :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterModelFilterChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ModelFilterChangedCallback
wrapped' = (a -> IO ()) -> C_ModelFilterChangedCallback
forall a. GObject a => (a -> IO ()) -> C_ModelFilterChangedCallback
wrap_ModelFilterChangedCallback a -> IO ()
wrapped
    FunPtr C_ModelFilterChangedCallback
wrapped'' <- C_ModelFilterChangedCallback
-> IO (FunPtr C_ModelFilterChangedCallback)
mk_ModelFilterChangedCallback C_ModelFilterChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelFilterChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"filter-changed" FunPtr C_ModelFilterChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ModelFilterChangedSignalInfo
instance SignalInfo ModelFilterChangedSignalInfo where
    type HaskellCallbackType ModelFilterChangedSignalInfo = ModelFilterChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ModelFilterChangedCallback cb
        cb'' <- mk_ModelFilterChangedCallback cb'
        connectSignalFunPtr obj "filter-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Model::filter-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Model.html#g:signal:filterChanged"})

#endif

-- signal Model::row-added
{-# DEPRECATED ModelRowAddedCallback ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | The [rowAdded](#g:signal:rowAdded) signal is emitted when a new row has been added.
-- The data on the row has already been set when the [rowAdded](#g:signal:rowAdded) signal
-- has been emitted.
-- 
-- /Since: 0.6/
type ModelRowAddedCallback =
    Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter' pointing to the new row
    -> IO ()

type C_ModelRowAddedCallback =
    Ptr Model ->                            -- object
    Ptr Clutter.ModelIter.ModelIter ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ModelRowAddedCallback :: 
    GObject a => (a -> ModelRowAddedCallback) ->
    C_ModelRowAddedCallback
wrap_ModelRowAddedCallback :: forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowAddedCallback a -> ModelRowAddedCallback
gi'cb Ptr Model
gi'selfPtr Ptr ModelIter
iter Ptr ()
_ = do
    ModelIter
iter' <- ((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
Clutter.ModelIter.ModelIter) Ptr ModelIter
iter
    Ptr Model -> (Model -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Model
gi'selfPtr ((Model -> IO ()) -> IO ()) -> (Model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Model
gi'self -> a -> ModelRowAddedCallback
gi'cb (Model -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Model
gi'self)  ModelIter
iter'


-- | Connect a signal handler for the [rowAdded](#signal:rowAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' model #rowAdded callback
-- @
-- 
-- 
onModelRowAdded :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelRowAddedCallback) -> m SignalHandlerId
onModelRowAdded :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => ModelRowAddedCallback) -> m SignalHandlerId
onModelRowAdded a
obj (?self::a) => ModelRowAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ModelRowAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ModelRowAddedCallback
ModelRowAddedCallback
cb
    let wrapped' :: C_ModelRowAddedCallback
wrapped' = (a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowAddedCallback a -> ModelRowAddedCallback
wrapped
    FunPtr C_ModelRowAddedCallback
wrapped'' <- C_ModelRowAddedCallback -> IO (FunPtr C_ModelRowAddedCallback)
mk_ModelRowAddedCallback C_ModelRowAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelRowAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-added" FunPtr C_ModelRowAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [rowAdded](#signal:rowAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' model #rowAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterModelRowAdded :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelRowAddedCallback) -> m SignalHandlerId
afterModelRowAdded :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => ModelRowAddedCallback) -> m SignalHandlerId
afterModelRowAdded a
obj (?self::a) => ModelRowAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ModelRowAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ModelRowAddedCallback
ModelRowAddedCallback
cb
    let wrapped' :: C_ModelRowAddedCallback
wrapped' = (a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowAddedCallback a -> ModelRowAddedCallback
wrapped
    FunPtr C_ModelRowAddedCallback
wrapped'' <- C_ModelRowAddedCallback -> IO (FunPtr C_ModelRowAddedCallback)
mk_ModelRowAddedCallback C_ModelRowAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelRowAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-added" FunPtr C_ModelRowAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ModelRowAddedSignalInfo
instance SignalInfo ModelRowAddedSignalInfo where
    type HaskellCallbackType ModelRowAddedSignalInfo = ModelRowAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ModelRowAddedCallback cb
        cb'' <- mk_ModelRowAddedCallback cb'
        connectSignalFunPtr obj "row-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Model::row-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Model.html#g:signal:rowAdded"})

#endif

-- signal Model::row-changed
{-# DEPRECATED ModelRowChangedCallback ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | The [rowRemoved](#g:signal:rowRemoved) signal is emitted when a row has been changed.
-- The data on the row has already been updated when the [rowChanged](#g:signal:rowChanged)
-- signal has been emitted.
-- 
-- /Since: 0.6/
type ModelRowChangedCallback =
    Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter' pointing to the changed row
    -> IO ()

type C_ModelRowChangedCallback =
    Ptr Model ->                            -- object
    Ptr Clutter.ModelIter.ModelIter ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ModelRowChangedCallback :: 
    GObject a => (a -> ModelRowChangedCallback) ->
    C_ModelRowChangedCallback
wrap_ModelRowChangedCallback :: forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowChangedCallback a -> ModelRowAddedCallback
gi'cb Ptr Model
gi'selfPtr Ptr ModelIter
iter Ptr ()
_ = do
    ModelIter
iter' <- ((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
Clutter.ModelIter.ModelIter) Ptr ModelIter
iter
    Ptr Model -> (Model -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Model
gi'selfPtr ((Model -> IO ()) -> IO ()) -> (Model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Model
gi'self -> a -> ModelRowAddedCallback
gi'cb (Model -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Model
gi'self)  ModelIter
iter'


-- | Connect a signal handler for the [rowChanged](#signal:rowChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' model #rowChanged callback
-- @
-- 
-- 
onModelRowChanged :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelRowChangedCallback) -> m SignalHandlerId
onModelRowChanged :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => ModelRowAddedCallback) -> m SignalHandlerId
onModelRowChanged a
obj (?self::a) => ModelRowAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ModelRowAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ModelRowAddedCallback
ModelRowAddedCallback
cb
    let wrapped' :: C_ModelRowAddedCallback
wrapped' = (a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowChangedCallback a -> ModelRowAddedCallback
wrapped
    FunPtr C_ModelRowAddedCallback
wrapped'' <- C_ModelRowAddedCallback -> IO (FunPtr C_ModelRowAddedCallback)
mk_ModelRowChangedCallback C_ModelRowAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelRowAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-changed" FunPtr C_ModelRowAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [rowChanged](#signal:rowChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' model #rowChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterModelRowChanged :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelRowChangedCallback) -> m SignalHandlerId
afterModelRowChanged :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => ModelRowAddedCallback) -> m SignalHandlerId
afterModelRowChanged a
obj (?self::a) => ModelRowAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ModelRowAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ModelRowAddedCallback
ModelRowAddedCallback
cb
    let wrapped' :: C_ModelRowAddedCallback
wrapped' = (a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowChangedCallback a -> ModelRowAddedCallback
wrapped
    FunPtr C_ModelRowAddedCallback
wrapped'' <- C_ModelRowAddedCallback -> IO (FunPtr C_ModelRowAddedCallback)
mk_ModelRowChangedCallback C_ModelRowAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelRowAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-changed" FunPtr C_ModelRowAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ModelRowChangedSignalInfo
instance SignalInfo ModelRowChangedSignalInfo where
    type HaskellCallbackType ModelRowChangedSignalInfo = ModelRowChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ModelRowChangedCallback cb
        cb'' <- mk_ModelRowChangedCallback cb'
        connectSignalFunPtr obj "row-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Model::row-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Model.html#g:signal:rowChanged"})

#endif

-- signal Model::row-removed
{-# DEPRECATED ModelRowRemovedCallback ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | The [rowRemoved](#g:signal:rowRemoved) signal is emitted when a row has been removed.
-- The data on the row pointed by the passed iterator is still valid
-- when the [rowRemoved](#g:signal:rowRemoved) signal has been emitted.
-- 
-- /Since: 0.6/
type ModelRowRemovedCallback =
    Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: a t'GI.Clutter.Objects.ModelIter.ModelIter' pointing to the removed row
    -> IO ()

type C_ModelRowRemovedCallback =
    Ptr Model ->                            -- object
    Ptr Clutter.ModelIter.ModelIter ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ModelRowRemovedCallback :: 
    GObject a => (a -> ModelRowRemovedCallback) ->
    C_ModelRowRemovedCallback
wrap_ModelRowRemovedCallback :: forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowRemovedCallback a -> ModelRowAddedCallback
gi'cb Ptr Model
gi'selfPtr Ptr ModelIter
iter Ptr ()
_ = do
    ModelIter
iter' <- ((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
Clutter.ModelIter.ModelIter) Ptr ModelIter
iter
    Ptr Model -> (Model -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Model
gi'selfPtr ((Model -> IO ()) -> IO ()) -> (Model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Model
gi'self -> a -> ModelRowAddedCallback
gi'cb (Model -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Model
gi'self)  ModelIter
iter'


-- | Connect a signal handler for the [rowRemoved](#signal:rowRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' model #rowRemoved callback
-- @
-- 
-- 
onModelRowRemoved :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelRowRemovedCallback) -> m SignalHandlerId
onModelRowRemoved :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => ModelRowAddedCallback) -> m SignalHandlerId
onModelRowRemoved a
obj (?self::a) => ModelRowAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ModelRowAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ModelRowAddedCallback
ModelRowAddedCallback
cb
    let wrapped' :: C_ModelRowAddedCallback
wrapped' = (a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowRemovedCallback a -> ModelRowAddedCallback
wrapped
    FunPtr C_ModelRowAddedCallback
wrapped'' <- C_ModelRowAddedCallback -> IO (FunPtr C_ModelRowAddedCallback)
mk_ModelRowRemovedCallback C_ModelRowAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelRowAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-removed" FunPtr C_ModelRowAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [rowRemoved](#signal:rowRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' model #rowRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterModelRowRemoved :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelRowRemovedCallback) -> m SignalHandlerId
afterModelRowRemoved :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => ModelRowAddedCallback) -> m SignalHandlerId
afterModelRowRemoved a
obj (?self::a) => ModelRowAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ModelRowAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ModelRowAddedCallback
ModelRowAddedCallback
cb
    let wrapped' :: C_ModelRowAddedCallback
wrapped' = (a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
forall a.
GObject a =>
(a -> ModelRowAddedCallback) -> C_ModelRowAddedCallback
wrap_ModelRowRemovedCallback a -> ModelRowAddedCallback
wrapped
    FunPtr C_ModelRowAddedCallback
wrapped'' <- C_ModelRowAddedCallback -> IO (FunPtr C_ModelRowAddedCallback)
mk_ModelRowRemovedCallback C_ModelRowAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelRowAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-removed" FunPtr C_ModelRowAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ModelRowRemovedSignalInfo
instance SignalInfo ModelRowRemovedSignalInfo where
    type HaskellCallbackType ModelRowRemovedSignalInfo = ModelRowRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ModelRowRemovedCallback cb
        cb'' <- mk_ModelRowRemovedCallback cb'
        connectSignalFunPtr obj "row-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Model::row-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Model.html#g:signal:rowRemoved"})

#endif

-- signal Model::sort-changed
{-# DEPRECATED ModelSortChangedCallback ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | The [sortChanged](#g:signal:sortChanged) signal is emitted after the model has been sorted
-- 
-- /Since: 0.6/
type ModelSortChangedCallback =
    IO ()

type C_ModelSortChangedCallback =
    Ptr Model ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ModelSortChangedCallback :: 
    GObject a => (a -> ModelSortChangedCallback) ->
    C_ModelSortChangedCallback
wrap_ModelSortChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_ModelFilterChangedCallback
wrap_ModelSortChangedCallback a -> IO ()
gi'cb Ptr Model
gi'selfPtr Ptr ()
_ = do
    Ptr Model -> (Model -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Model
gi'selfPtr ((Model -> IO ()) -> IO ()) -> (Model -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Model
gi'self -> a -> IO ()
gi'cb (Model -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Model
gi'self) 


-- | Connect a signal handler for the [sortChanged](#signal:sortChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' model #sortChanged callback
-- @
-- 
-- 
onModelSortChanged :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelSortChangedCallback) -> m SignalHandlerId
onModelSortChanged :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onModelSortChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ModelFilterChangedCallback
wrapped' = (a -> IO ()) -> C_ModelFilterChangedCallback
forall a. GObject a => (a -> IO ()) -> C_ModelFilterChangedCallback
wrap_ModelSortChangedCallback a -> IO ()
wrapped
    FunPtr C_ModelFilterChangedCallback
wrapped'' <- C_ModelFilterChangedCallback
-> IO (FunPtr C_ModelFilterChangedCallback)
mk_ModelSortChangedCallback C_ModelFilterChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelFilterChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"sort-changed" FunPtr C_ModelFilterChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [sortChanged](#signal:sortChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' model #sortChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterModelSortChanged :: (IsModel a, MonadIO m) => a -> ((?self :: a) => ModelSortChangedCallback) -> m SignalHandlerId
afterModelSortChanged :: forall a (m :: * -> *).
(IsModel a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterModelSortChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ModelFilterChangedCallback
wrapped' = (a -> IO ()) -> C_ModelFilterChangedCallback
forall a. GObject a => (a -> IO ()) -> C_ModelFilterChangedCallback
wrap_ModelSortChangedCallback a -> IO ()
wrapped
    FunPtr C_ModelFilterChangedCallback
wrapped'' <- C_ModelFilterChangedCallback
-> IO (FunPtr C_ModelFilterChangedCallback)
mk_ModelSortChangedCallback C_ModelFilterChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ModelFilterChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"sort-changed" FunPtr C_ModelFilterChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ModelSortChangedSignalInfo
instance SignalInfo ModelSortChangedSignalInfo where
    type HaskellCallbackType ModelSortChangedSignalInfo = ModelSortChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ModelSortChangedCallback cb
        cb'' <- mk_ModelSortChangedCallback cb'
        connectSignalFunPtr obj "sort-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Model::sort-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Model.html#g:signal:sortChanged"})

#endif

-- VVV Prop "filter-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ModelFilterSetPropertyInfo
instance AttrInfo ModelFilterSetPropertyInfo where
    type AttrAllowedOps ModelFilterSetPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ModelFilterSetPropertyInfo = IsModel
    type AttrSetTypeConstraint ModelFilterSetPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ModelFilterSetPropertyInfo = (~) ()
    type AttrTransferType ModelFilterSetPropertyInfo = ()
    type AttrGetType ModelFilterSetPropertyInfo = Bool
    type AttrLabel ModelFilterSetPropertyInfo = "filter-set"
    type AttrOrigin ModelFilterSetPropertyInfo = Model
    attrGet = getModelFilterSet
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Model.filterSet"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Model.html#g:attr:filterSet"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Model
type instance O.AttributeList Model = ModelAttributeList
type ModelAttributeList = ('[ '("filterSet", ModelFilterSetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
modelFilterSet :: AttrLabelProxy "filterSet"
modelFilterSet = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Model = ModelSignalList
type ModelSignalList = ('[ '("filterChanged", ModelFilterChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("rowAdded", ModelRowAddedSignalInfo), '("rowChanged", ModelRowChangedSignalInfo), '("rowRemoved", ModelRowRemovedSignalInfo), '("sortChanged", ModelSortChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Model::appendv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of columns and values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vector with the columns to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 1 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vector with the values"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of columns and values"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of columns and values"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_appendv" clutter_model_appendv :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- n_columns : TBasicType TUInt
    Ptr Word32 ->                           -- columns : TCArray False (-1) 1 (TBasicType TUInt)
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 1 TGValue
    IO ()

{-# DEPRECATED modelAppendv ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Creates and appends a new row to the t'GI.Clutter.Objects.Model.Model', setting the row
-- values for the given /@columns@/ upon creation.
-- 
-- /Since: 0.6/
modelAppendv ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> [Word32]
    -- ^ /@columns@/: a vector with the columns to set
    -> [GValue]
    -- ^ /@values@/: a vector with the values
    -> m ()
modelAppendv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> [Word32] -> [GValue] -> m ()
modelAppendv a
model [Word32]
columns [GValue]
values = 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
    let nColumns :: Word32
nColumns = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let columns_expected_length_ :: Word32
columns_expected_length_ = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Word32]
columns
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
columns_expected_length_ Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
nColumns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Clutter.modelAppendv : length of 'columns' does not agree with that of 'values'."
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Word32
columns' <- [Word32] -> IO (Ptr Word32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Word32]
columns
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    Ptr Model -> Word32 -> Ptr Word32 -> Ptr GValue -> IO ()
clutter_model_appendv Ptr Model
model' Word32
nColumns Ptr Word32
columns' Ptr GValue
values'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
columns'
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelAppendvMethodInfo
instance (signature ~ ([Word32] -> [GValue] -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelAppendvMethodInfo a signature where
    overloadedMethod = modelAppendv

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


#endif

-- method Model::filter_iter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModelIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the row to filter" , 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_filter_iter" clutter_model_filter_iter :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Ptr Clutter.ModelIter.ModelIter ->      -- iter : TInterface (Name {namespace = "Clutter", name = "ModelIter"})
    IO CInt

{-# DEPRECATED modelFilterIter ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Checks whether the row pointer by /@iter@/ should be filtered or not using
-- the filtering function set on /@model@/.
-- 
-- This function should be used only by subclasses of t'GI.Clutter.Objects.Model.Model'.
-- 
-- /Since: 0.6/
modelFilterIter ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a, Clutter.ModelIter.IsModelIter b) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> b
    -- ^ /@iter@/: the row to filter
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the row should be displayed,
    --   'P.False' otherwise
modelFilterIter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsModel a, IsModelIter b) =>
a -> b -> m Bool
modelFilterIter a
model b
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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr ModelIter
iter' <- b -> IO (Ptr ModelIter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
iter
    CInt
result <- Ptr Model -> Ptr ModelIter -> IO CInt
clutter_model_filter_iter Ptr Model
model' 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
model
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
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 ModelFilterIterMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsModel a, Clutter.ModelIter.IsModelIter b) => O.OverloadedMethod ModelFilterIterMethodInfo a signature where
    overloadedMethod = modelFilterIter

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


#endif

-- method Model::filter_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the row to filter" , 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_filter_row" clutter_model_filter_row :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- row : TBasicType TUInt
    IO CInt

{-# DEPRECATED modelFilterRow ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Checks whether /@row@/ should be filtered or not using the
-- filtering function set on /@model@/.
-- 
-- This function should be used only by subclasses of t'GI.Clutter.Objects.Model.Model'.
-- 
-- /Since: 0.6/
modelFilterRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@row@/: the row to filter
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the row should be displayed,
    --   'P.False' otherwise
modelFilterRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> m Bool
modelFilterRow a
model Word32
row = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr Model -> Word32 -> IO CInt
clutter_model_filter_row Ptr Model
model' Word32
row
    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
model
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ModelFilterRowMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsModel a) => O.OverloadedMethod ModelFilterRowMethodInfo a signature where
    overloadedMethod = modelFilterRow

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


#endif

-- method Model::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "ModelForeachFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModelForeachFunc"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @func"
--                 , 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_foreach" clutter_model_foreach :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    FunPtr Clutter.Callbacks.C_ModelForeachFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "ModelForeachFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED modelForeach ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Calls /@func@/ for each row in the model.
-- 
-- /Since: 0.6/
modelForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Clutter.Callbacks.ModelForeachFunc
    -- ^ /@func@/: a t'GI.Clutter.Callbacks.ModelForeachFunc'
    -> m ()
modelForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> ModelForeachFunc -> m ()
modelForeach a
model ModelForeachFunc
func = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    FunPtr C_ModelForeachFunc
func' <- C_ModelForeachFunc -> IO (FunPtr C_ModelForeachFunc)
Clutter.Callbacks.mk_ModelForeachFunc (Maybe (Ptr (FunPtr C_ModelForeachFunc))
-> ModelForeachFunc_WithClosures -> C_ModelForeachFunc
Clutter.Callbacks.wrap_ModelForeachFunc Maybe (Ptr (FunPtr C_ModelForeachFunc))
forall a. Maybe a
Nothing (ModelForeachFunc -> ModelForeachFunc_WithClosures
Clutter.Callbacks.drop_closures_ModelForeachFunc ModelForeachFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Model -> FunPtr C_ModelForeachFunc -> Ptr () -> IO ()
clutter_model_foreach Ptr Model
model' FunPtr C_ModelForeachFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ModelForeachFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ModelForeachFunc
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelForeachMethodInfo
instance (signature ~ (Clutter.Callbacks.ModelForeachFunc -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelForeachMethodInfo a signature where
    overloadedMethod = modelForeach

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


#endif

-- method Model::get_column_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#ClutterModel" , 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 "the column number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_get_column_name" clutter_model_get_column_name :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- column : TBasicType TUInt
    IO CString

{-# DEPRECATED modelGetColumnName ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves the name of the /@column@/
-- 
-- /Since: 0.6/
modelGetColumnName ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@column@/: the column number
    -> m T.Text
    -- ^ __Returns:__ the name of the column. The model holds the returned
    --   string, and it should not be modified or freed
modelGetColumnName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> m Text
modelGetColumnName a
model Word32
column = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CString
result <- Ptr Model -> Word32 -> IO CString
clutter_model_get_column_name Ptr Model
model' Word32
column
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelGetColumnName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ModelGetColumnNameMethodInfo
instance (signature ~ (Word32 -> m T.Text), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetColumnNameMethodInfo a signature where
    overloadedMethod = modelGetColumnName

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


#endif

-- method Model::get_column_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#ClutterModel" , 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 "the column number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_get_column_type" clutter_model_get_column_type :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- column : TBasicType TUInt
    IO CGType

{-# DEPRECATED modelGetColumnType ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves the type of the /@column@/.
-- 
-- /Since: 0.6/
modelGetColumnType ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@column@/: the column number
    -> m GType
    -- ^ __Returns:__ the type of the column.
modelGetColumnType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> m GType
modelGetColumnType a
model Word32
column = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CGType
result <- Ptr Model -> Word32 -> IO CGType
clutter_model_get_column_type Ptr Model
model' Word32
column
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ModelGetColumnTypeMethodInfo
instance (signature ~ (Word32 -> m GType), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetColumnTypeMethodInfo a signature where
    overloadedMethod = modelGetColumnType

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


#endif

-- method Model::get_filter_set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , 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_get_filter_set" clutter_model_get_filter_set :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO CInt

{-# DEPRECATED modelGetFilterSet ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Returns whether the /@model@/ has a filter in place, set
-- using 'GI.Clutter.Objects.Model.modelSetFilter'
-- 
-- /Since: 1.0/
modelGetFilterSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a filter is set
modelGetFilterSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m Bool
modelGetFilterSet a
model = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    CInt
result <- Ptr Model -> IO CInt
clutter_model_get_filter_set Ptr Model
model'
    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
model
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ModelGetFilterSetMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetFilterSetMethodInfo a signature where
    overloadedMethod = modelGetFilterSet

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


#endif

-- method Model::get_first_iter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , 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_get_first_iter" clutter_model_get_first_iter :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO (Ptr Clutter.ModelIter.ModelIter)

{-# DEPRECATED modelGetFirstIter ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves a t'GI.Clutter.Objects.ModelIter.ModelIter' representing the first non-filtered
-- row in /@model@/.
-- 
-- /Since: 0.6/
modelGetFirstIter ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m Clutter.ModelIter.ModelIter
    -- ^ __Returns:__ A new t'GI.Clutter.Objects.ModelIter.ModelIter'.
    --   Call 'GI.GObject.Objects.Object.objectUnref' when done using it
modelGetFirstIter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m ModelIter
modelGetFirstIter a
model = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr ModelIter
result <- Ptr Model -> IO (Ptr ModelIter)
clutter_model_get_first_iter Ptr Model
model'
    Text -> Ptr ModelIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelGetFirstIter" 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
Clutter.ModelIter.ModelIter) Ptr ModelIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    ModelIter -> IO ModelIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModelIter
result'

#if defined(ENABLE_OVERLOADING)
data ModelGetFirstIterMethodInfo
instance (signature ~ (m Clutter.ModelIter.ModelIter), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetFirstIterMethodInfo a signature where
    overloadedMethod = modelGetFirstIter

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


#endif

-- method Model::get_iter_at_row
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position of the row to retrieve"
--                 , 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_get_iter_at_row" clutter_model_get_iter_at_row :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- row : TBasicType TUInt
    IO (Ptr Clutter.ModelIter.ModelIter)

{-# DEPRECATED modelGetIterAtRow ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves a t'GI.Clutter.Objects.ModelIter.ModelIter' representing the row at the given index.
-- 
-- If a filter function has been set using 'GI.Clutter.Objects.Model.modelSetFilter'
-- then the /@model@/ implementation will return the first non filtered
-- row.
-- 
-- /Since: 0.6/
modelGetIterAtRow ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@row@/: position of the row to retrieve
    -> m Clutter.ModelIter.ModelIter
    -- ^ __Returns:__ A new t'GI.Clutter.Objects.ModelIter.ModelIter', or 'P.Nothing' if /@row@/ was
    --   out of bounds. When done using the iterator object, call 'GI.GObject.Objects.Object.objectUnref'
    --   to deallocate its resources
modelGetIterAtRow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> m ModelIter
modelGetIterAtRow a
model Word32
row = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr ModelIter
result <- Ptr Model -> Word32 -> IO (Ptr ModelIter)
clutter_model_get_iter_at_row Ptr Model
model' Word32
row
    Text -> Ptr ModelIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelGetIterAtRow" 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
Clutter.ModelIter.ModelIter) Ptr ModelIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    ModelIter -> IO ModelIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModelIter
result'

#if defined(ENABLE_OVERLOADING)
data ModelGetIterAtRowMethodInfo
instance (signature ~ (Word32 -> m Clutter.ModelIter.ModelIter), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetIterAtRowMethodInfo a signature where
    overloadedMethod = modelGetIterAtRow

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


#endif

-- method Model::get_last_iter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , 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_get_last_iter" clutter_model_get_last_iter :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO (Ptr Clutter.ModelIter.ModelIter)

{-# DEPRECATED modelGetLastIter ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves a t'GI.Clutter.Objects.ModelIter.ModelIter' representing the last non-filtered
-- row in /@model@/.
-- 
-- /Since: 0.6/
modelGetLastIter ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m Clutter.ModelIter.ModelIter
    -- ^ __Returns:__ A new t'GI.Clutter.Objects.ModelIter.ModelIter'.
    --   Call 'GI.GObject.Objects.Object.objectUnref' when done using it
modelGetLastIter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m ModelIter
modelGetLastIter a
model = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr ModelIter
result <- Ptr Model -> IO (Ptr ModelIter)
clutter_model_get_last_iter Ptr Model
model'
    Text -> Ptr ModelIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"modelGetLastIter" 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
Clutter.ModelIter.ModelIter) Ptr ModelIter
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    ModelIter -> IO ModelIter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModelIter
result'

#if defined(ENABLE_OVERLOADING)
data ModelGetLastIterMethodInfo
instance (signature ~ (m Clutter.ModelIter.ModelIter), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetLastIterMethodInfo a signature where
    overloadedMethod = modelGetLastIter

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


#endif

-- method Model::get_n_columns
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , 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_get_n_columns" clutter_model_get_n_columns :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO Word32

{-# DEPRECATED modelGetNColumns ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves the number of columns inside /@model@/.
-- 
-- /Since: 0.6/
modelGetNColumns ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m Word32
    -- ^ __Returns:__ the number of columns
modelGetNColumns :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m Word32
modelGetNColumns a
model = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Word32
result <- Ptr Model -> IO Word32
clutter_model_get_n_columns Ptr Model
model'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ModelGetNColumnsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetNColumnsMethodInfo a signature where
    overloadedMethod = modelGetNColumns

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


#endif

-- method Model::get_n_rows
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , 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_get_n_rows" clutter_model_get_n_rows :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO Word32

{-# DEPRECATED modelGetNRows ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves the number of rows inside /@model@/, eventually taking
-- into account any filtering function set using 'GI.Clutter.Objects.Model.modelSetFilter'.
-- 
-- /Since: 0.6/
modelGetNRows ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m Word32
    -- ^ __Returns:__ The length of the /@model@/. If there is a filter set, then
    --   the length of the filtered /@model@/ is returned.
modelGetNRows :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m Word32
modelGetNRows a
model = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Word32
result <- Ptr Model -> IO Word32
clutter_model_get_n_rows Ptr Model
model'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ModelGetNRowsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetNRowsMethodInfo a signature where
    overloadedMethod = modelGetNRows

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


#endif

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

foreign import ccall "clutter_model_get_sorting_column" clutter_model_get_sorting_column :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO Int32

{-# DEPRECATED modelGetSortingColumn ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Retrieves the number of column used for sorting the /@model@/.
-- 
-- /Since: 0.6/
modelGetSortingColumn ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m Int32
    -- ^ __Returns:__ a column number, or -1 if the model is not sorted
modelGetSortingColumn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m Int32
modelGetSortingColumn a
model = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Int32
result <- Ptr Model -> IO Int32
clutter_model_get_sorting_column Ptr Model
model'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ModelGetSortingColumnMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsModel a) => O.OverloadedMethod ModelGetSortingColumnMethodInfo a signature where
    overloadedMethod = modelGetSortingColumn

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


#endif

-- method Model::insert_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position of the row to modify"
--                 , 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 to modify" , 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_insert_value" clutter_model_insert_value :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- row : TBasicType TUInt
    Word32 ->                               -- column : TBasicType TUInt
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED modelInsertValue ["(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. If the row does
-- not exist then it is created.
-- 
-- /Since: 0.6/
modelInsertValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@row@/: position of the row to modify
    -> Word32
    -- ^ /@column@/: column to modify
    -> GValue
    -- ^ /@value@/: new value for the cell
    -> m ()
modelInsertValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> Word32 -> GValue -> m ()
modelInsertValue a
model Word32
row 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Model -> Word32 -> Word32 -> Ptr GValue -> IO ()
clutter_model_insert_value Ptr Model
model' Word32
row Word32
column Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    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 ModelInsertValueMethodInfo
instance (signature ~ (Word32 -> Word32 -> GValue -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelInsertValueMethodInfo a signature where
    overloadedMethod = modelInsertValue

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


#endif

-- method Model::insertv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "row index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of columns and values to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vector containing the columns to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 2 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vector containing the values for the cells"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of columns and values to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of columns and values to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_insertv" clutter_model_insertv :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- row : TBasicType TUInt
    Word32 ->                               -- n_columns : TBasicType TUInt
    Ptr Word32 ->                           -- columns : TCArray False (-1) 2 (TBasicType TUInt)
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 2 TGValue
    IO ()

{-# DEPRECATED modelInsertv ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Inserts data at /@row@/ into the t'GI.Clutter.Objects.Model.Model', setting the row
-- values for the given /@columns@/ upon creation.
-- 
-- /Since: 0.6/
modelInsertv ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@row@/: row index
    -> [Word32]
    -- ^ /@columns@/: a vector containing the columns to set
    -> [GValue]
    -- ^ /@values@/: a vector containing the values for the cells
    -> m ()
modelInsertv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> [Word32] -> [GValue] -> m ()
modelInsertv a
model Word32
row [Word32]
columns [GValue]
values = 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
    let nColumns :: Word32
nColumns = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let columns_expected_length_ :: Word32
columns_expected_length_ = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Word32]
columns
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
columns_expected_length_ Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
nColumns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Clutter.modelInsertv : length of 'columns' does not agree with that of 'values'."
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Word32
columns' <- [Word32] -> IO (Ptr Word32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Word32]
columns
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    Ptr Model -> Word32 -> Word32 -> Ptr Word32 -> Ptr GValue -> IO ()
clutter_model_insertv Ptr Model
model' Word32
row Word32
nColumns Ptr Word32
columns' Ptr GValue
values'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
columns'
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelInsertvMethodInfo
instance (signature ~ (Word32 -> [Word32] -> [GValue] -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelInsertvMethodInfo a signature where
    overloadedMethod = modelInsertv

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


#endif

-- method Model::prependv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of columns and values to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vector containing the columns to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TCArray False (-1) 1 TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a vector containing the values for the cells"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of columns and values to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of columns and values to set"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_prependv" clutter_model_prependv :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- n_columns : TBasicType TUInt
    Ptr Word32 ->                           -- columns : TCArray False (-1) 1 (TBasicType TUInt)
    Ptr B.GValue.GValue ->                  -- values : TCArray False (-1) 1 TGValue
    IO ()

{-# DEPRECATED modelPrependv ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Creates and prepends a new row to the t'GI.Clutter.Objects.Model.Model', setting the row
-- values for the given /@columns@/ upon creation.
-- 
-- /Since: 0.6/
modelPrependv ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> [Word32]
    -- ^ /@columns@/: a vector containing the columns to set
    -> [GValue]
    -- ^ /@values@/: a vector containing the values for the cells
    -> m ()
modelPrependv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> [Word32] -> [GValue] -> m ()
modelPrependv a
model [Word32]
columns [GValue]
values = 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
    let nColumns :: Word32
nColumns = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GValue]
values
    let columns_expected_length_ :: Word32
columns_expected_length_ = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Word32]
columns
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
columns_expected_length_ Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
nColumns) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error String
"Clutter.modelPrependv : length of 'columns' does not agree with that of 'values'."
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Word32
columns' <- [Word32] -> IO (Ptr Word32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Word32]
columns
    Ptr GValue
values' <- [GValue] -> IO (Ptr GValue)
B.GValue.packGValueArray [GValue]
values
    Ptr Model -> Word32 -> Ptr Word32 -> Ptr GValue -> IO ()
clutter_model_prependv Ptr Model
model' Word32
nColumns Ptr Word32
columns' Ptr GValue
values'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    (GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [GValue]
values
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
columns'
    Ptr GValue -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr GValue
values'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelPrependvMethodInfo
instance (signature ~ ([Word32] -> [GValue] -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelPrependvMethodInfo a signature where
    overloadedMethod = modelPrependv

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


#endif

-- method Model::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "position of row to remove"
--                 , 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_remove" clutter_model_remove :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- row : TBasicType TUInt
    IO ()

{-# DEPRECATED modelRemove ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Removes the row at the given position from the model.
-- 
-- /Since: 0.6/
modelRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Word32
    -- ^ /@row@/: position of row to remove
    -> m ()
modelRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Word32 -> m ()
modelRemove a
model Word32
row = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Model -> Word32 -> IO ()
clutter_model_remove Ptr Model
model' Word32
row
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelRemoveMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelRemoveMethodInfo a signature where
    overloadedMethod = modelRemove

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


#endif

-- method Model::resort
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , 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_resort" clutter_model_resort :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    IO ()

{-# DEPRECATED modelResort ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Force a resort on the /@model@/. This function should only be
-- used by subclasses of t'GI.Clutter.Objects.Model.Model'.
-- 
-- /Since: 0.6/
modelResort ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> m ()
modelResort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> m ()
modelResort a
model = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Model -> IO ()
clutter_model_resort Ptr Model
model'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelResortMethodInfo
instance (signature ~ (m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelResortMethodInfo a signature where
    overloadedMethod = modelResort

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


#endif

-- method Model::set_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "ModelFilterFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModelFilterFunc, or #NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @func, or #NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier of @user_data, or #NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_set_filter" clutter_model_set_filter :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    FunPtr Clutter.Callbacks.C_ModelFilterFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "ModelFilterFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

{-# DEPRECATED modelSetFilter ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Filters the /@model@/ using the given filtering function.
-- 
-- /Since: 0.6/
modelSetFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Maybe (Clutter.Callbacks.ModelFilterFunc)
    -- ^ /@func@/: a t'GI.Clutter.Callbacks.ModelFilterFunc', or @/NULL/@
    -> m ()
modelSetFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Maybe ModelForeachFunc -> m ()
modelSetFilter a
model Maybe ModelForeachFunc
func = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    FunPtr C_ModelForeachFunc
maybeFunc <- case Maybe ModelForeachFunc
func of
        Maybe ModelForeachFunc
Nothing -> FunPtr C_ModelForeachFunc -> IO (FunPtr C_ModelForeachFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_ModelForeachFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just ModelForeachFunc
jFunc -> do
            FunPtr C_ModelForeachFunc
jFunc' <- C_ModelForeachFunc -> IO (FunPtr C_ModelForeachFunc)
Clutter.Callbacks.mk_ModelFilterFunc (Maybe (Ptr (FunPtr C_ModelForeachFunc))
-> ModelForeachFunc_WithClosures -> C_ModelForeachFunc
Clutter.Callbacks.wrap_ModelFilterFunc Maybe (Ptr (FunPtr C_ModelForeachFunc))
forall a. Maybe a
Nothing (ModelForeachFunc -> ModelForeachFunc_WithClosures
Clutter.Callbacks.drop_closures_ModelFilterFunc ModelForeachFunc
jFunc))
            FunPtr C_ModelForeachFunc -> IO (FunPtr C_ModelForeachFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_ModelForeachFunc
jFunc'
    let userData :: Ptr ()
userData = FunPtr C_ModelForeachFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ModelForeachFunc
maybeFunc
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Model
-> FunPtr C_ModelForeachFunc
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
clutter_model_set_filter Ptr Model
model' FunPtr C_ModelForeachFunc
maybeFunc Ptr ()
userData FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelSetFilterMethodInfo
instance (signature ~ (Maybe (Clutter.Callbacks.ModelFilterFunc) -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelSetFilterMethodInfo a signature where
    overloadedMethod = modelSetFilter

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


#endif

-- method Model::set_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of column names"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "names"
--           , argType = TCArray False (-1) 1 (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of strings"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of column names"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_set_names" clutter_model_set_names :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- n_columns : TBasicType TUInt
    Ptr CString ->                          -- names : TCArray False (-1) 1 (TBasicType TUTF8)
    IO ()

{-# DEPRECATED modelSetNames ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Assigns a name to the columns of a t'GI.Clutter.Objects.Model.Model'.
-- 
-- This function is meant primarily for @/GObjects/@ that inherit from
-- t'GI.Clutter.Objects.Model.Model', and should only be used when contructing a t'GI.Clutter.Objects.Model.Model'.
-- It will not work after the initial creation of the t'GI.Clutter.Objects.Model.Model'.
-- 
-- /Since: 0.6/
modelSetNames ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> [T.Text]
    -- ^ /@names@/: an array of strings
    -> m ()
modelSetNames :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> [Text] -> m ()
modelSetNames a
model [Text]
names = 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
    let nColumns :: Word32
nColumns = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
names
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr CString
names' <- [Text] -> IO (Ptr CString)
packUTF8CArray [Text]
names
    Ptr Model -> Word32 -> Ptr CString -> IO ()
clutter_model_set_names Ptr Model
model' Word32
nColumns Ptr CString
names'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    (Word32 -> (CString -> IO ()) -> Ptr CString -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Word32
nColumns) CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
names'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelSetNamesMethodInfo
instance (signature ~ ([T.Text] -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelSetNamesMethodInfo a signature where
    overloadedMethod = modelSetNames

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


#endif

-- method Model::set_sort
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the column to sort on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModelSortFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModelSortFunc, or #NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @func, or #NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier of @user_data, or #NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_set_sort" clutter_model_set_sort :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Int32 ->                                -- column : TBasicType TInt
    FunPtr Clutter.Callbacks.C_ModelSortFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "ModelSortFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

{-# DEPRECATED modelSetSort ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Sorts /@model@/ using the given sorting function.
-- 
-- /Since: 0.6/
modelSetSort ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Int32
    -- ^ /@column@/: the column to sort on
    -> Maybe (Clutter.Callbacks.ModelSortFunc)
    -- ^ /@func@/: a t'GI.Clutter.Callbacks.ModelSortFunc', or @/NULL/@
    -> m ()
modelSetSort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Int32 -> Maybe ModelSortFunc -> m ()
modelSetSort a
model Int32
column Maybe ModelSortFunc
func = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    FunPtr C_ModelSortFunc
maybeFunc <- case Maybe ModelSortFunc
func of
        Maybe ModelSortFunc
Nothing -> FunPtr C_ModelSortFunc -> IO (FunPtr C_ModelSortFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_ModelSortFunc
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just ModelSortFunc
jFunc -> do
            FunPtr C_ModelSortFunc
jFunc' <- C_ModelSortFunc -> IO (FunPtr C_ModelSortFunc)
Clutter.Callbacks.mk_ModelSortFunc (Maybe (Ptr (FunPtr C_ModelSortFunc))
-> ModelSortFunc_WithClosures -> C_ModelSortFunc
Clutter.Callbacks.wrap_ModelSortFunc Maybe (Ptr (FunPtr C_ModelSortFunc))
forall a. Maybe a
Nothing (ModelSortFunc -> ModelSortFunc_WithClosures
Clutter.Callbacks.drop_closures_ModelSortFunc ModelSortFunc
jFunc))
            FunPtr C_ModelSortFunc -> IO (FunPtr C_ModelSortFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_ModelSortFunc
jFunc'
    let userData :: Ptr ()
userData = FunPtr C_ModelSortFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ModelSortFunc
maybeFunc
    let notify :: FunPtr (Ptr a -> IO ())
notify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Model
-> Int32
-> FunPtr C_ModelSortFunc
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
clutter_model_set_sort Ptr Model
model' Int32
column FunPtr C_ModelSortFunc
maybeFunc Ptr ()
userData FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
notify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelSetSortMethodInfo
instance (signature ~ (Int32 -> Maybe (Clutter.Callbacks.ModelSortFunc) -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelSetSortMethodInfo a signature where
    overloadedMethod = modelSetSort

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


#endif

-- method Model::set_sorting_column
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the column of the @model to sort, or -1"
--                 , 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_set_sorting_column" clutter_model_set_sorting_column :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Int32 ->                                -- column : TBasicType TInt
    IO ()

{-# DEPRECATED modelSetSortingColumn ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Sets the model to sort by /@column@/. If /@column@/ is a negative value
-- the sorting column will be unset.
-- 
-- /Since: 0.6/
modelSetSortingColumn ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Int32
    -- ^ /@column@/: the column of the /@model@/ to sort, or -1
    -> m ()
modelSetSortingColumn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> Int32 -> m ()
modelSetSortingColumn a
model Int32
column = 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 Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr Model -> Int32 -> IO ()
clutter_model_set_sorting_column Ptr Model
model' Int32
column
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelSetSortingColumnMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelSetSortingColumnMethodInfo a signature where
    overloadedMethod = modelSetSortingColumn

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


#endif

-- method Model::set_types
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Model" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterModel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_columns"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of columns for the model"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType = TCArray False (-1) 1 (TBasicType TGType)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of #GType types"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_columns"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of columns for the model"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_model_set_types" clutter_model_set_types :: 
    Ptr Model ->                            -- model : TInterface (Name {namespace = "Clutter", name = "Model"})
    Word32 ->                               -- n_columns : TBasicType TUInt
    Ptr CGType ->                           -- types : TCArray False (-1) 1 (TBasicType TGType)
    IO ()

{-# DEPRECATED modelSetTypes ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Sets the types of the columns inside a t'GI.Clutter.Objects.Model.Model'.
-- 
-- This function is meant primarily for @/GObjects/@ that inherit from
-- t'GI.Clutter.Objects.Model.Model', and should only be used when contructing a t'GI.Clutter.Objects.Model.Model'.
-- It will not work after the initial creation of the t'GI.Clutter.Objects.Model.Model'.
-- 
-- /Since: 0.6/
modelSetTypes ::
    (B.CallStack.HasCallStack, MonadIO m, IsModel a) =>
    a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> [GType]
    -- ^ /@types@/: an array of t'GType' types
    -> m ()
modelSetTypes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
a -> [GType] -> m ()
modelSetTypes a
model [GType]
types = 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
    let nColumns :: Word32
nColumns = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GType]
types
    Ptr Model
model' <- a -> IO (Ptr Model)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
model
    Ptr CGType
types' <- ((GType -> CGType) -> [GType] -> IO (Ptr CGType)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray GType -> CGType
gtypeToCGType) [GType]
types
    Ptr Model -> Word32 -> Ptr CGType -> IO ()
clutter_model_set_types Ptr Model
model' Word32
nColumns Ptr CGType
types'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
types'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ModelSetTypesMethodInfo
instance (signature ~ ([GType] -> m ()), MonadIO m, IsModel a) => O.OverloadedMethod ModelSetTypesMethodInfo a signature where
    overloadedMethod = modelSetTypes

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


#endif