-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.Clutter.Callbacks
    ( 

 -- * Signals


-- ** ActorCreateChildFunc #signal:ActorCreateChildFunc#

    ActorCreateChildFunc                    ,
    ActorCreateChildFunc_WithClosures       ,
    C_ActorCreateChildFunc                  ,
    drop_closures_ActorCreateChildFunc      ,
    dynamic_ActorCreateChildFunc            ,
    genClosure_ActorCreateChildFunc         ,
    mk_ActorCreateChildFunc                 ,
    noActorCreateChildFunc                  ,
    noActorCreateChildFunc_WithClosures     ,
    wrap_ActorCreateChildFunc               ,


-- ** AlphaFunc #signal:AlphaFunc#

    AlphaFunc                               ,
    AlphaFunc_WithClosures                  ,
    C_AlphaFunc                             ,
    drop_closures_AlphaFunc                 ,
    dynamic_AlphaFunc                       ,
    genClosure_AlphaFunc                    ,
    mk_AlphaFunc                            ,
    noAlphaFunc                             ,
    noAlphaFunc_WithClosures                ,
    wrap_AlphaFunc                          ,


-- ** BehaviourForeachFunc #signal:BehaviourForeachFunc#

    BehaviourForeachFunc                    ,
    BehaviourForeachFunc_WithClosures       ,
    C_BehaviourForeachFunc                  ,
    drop_closures_BehaviourForeachFunc      ,
    dynamic_BehaviourForeachFunc            ,
    genClosure_BehaviourForeachFunc         ,
    mk_BehaviourForeachFunc                 ,
    noBehaviourForeachFunc                  ,
    noBehaviourForeachFunc_WithClosures     ,
    wrap_BehaviourForeachFunc               ,


-- ** BindingActionFunc #signal:BindingActionFunc#

    BindingActionFunc                       ,
    BindingActionFunc_WithClosures          ,
    C_BindingActionFunc                     ,
    drop_closures_BindingActionFunc         ,
    dynamic_BindingActionFunc               ,
    genClosure_BindingActionFunc            ,
    mk_BindingActionFunc                    ,
    noBindingActionFunc                     ,
    noBindingActionFunc_WithClosures        ,
    wrap_BindingActionFunc                  ,


-- ** Callback #signal:Callback#

    C_Callback                              ,
    Callback                                ,
    Callback_WithClosures                   ,
    drop_closures_Callback                  ,
    dynamic_Callback                        ,
    genClosure_Callback                     ,
    mk_Callback                             ,
    noCallback                              ,
    noCallback_WithClosures                 ,
    wrap_Callback                           ,


-- ** EventFilterFunc #signal:EventFilterFunc#

    C_EventFilterFunc                       ,
    EventFilterFunc                         ,
    EventFilterFunc_WithClosures            ,
    drop_closures_EventFilterFunc           ,
    dynamic_EventFilterFunc                 ,
    genClosure_EventFilterFunc              ,
    mk_EventFilterFunc                      ,
    noEventFilterFunc                       ,
    noEventFilterFunc_WithClosures          ,
    wrap_EventFilterFunc                    ,


-- ** ModelFilterFunc #signal:ModelFilterFunc#

    C_ModelFilterFunc                       ,
    ModelFilterFunc                         ,
    ModelFilterFunc_WithClosures            ,
    drop_closures_ModelFilterFunc           ,
    dynamic_ModelFilterFunc                 ,
    genClosure_ModelFilterFunc              ,
    mk_ModelFilterFunc                      ,
    noModelFilterFunc                       ,
    noModelFilterFunc_WithClosures          ,
    wrap_ModelFilterFunc                    ,


-- ** ModelForeachFunc #signal:ModelForeachFunc#

    C_ModelForeachFunc                      ,
    ModelForeachFunc                        ,
    ModelForeachFunc_WithClosures           ,
    drop_closures_ModelForeachFunc          ,
    dynamic_ModelForeachFunc                ,
    genClosure_ModelForeachFunc             ,
    mk_ModelForeachFunc                     ,
    noModelForeachFunc                      ,
    noModelForeachFunc_WithClosures         ,
    wrap_ModelForeachFunc                   ,


-- ** ModelSortFunc #signal:ModelSortFunc#

    C_ModelSortFunc                         ,
    ModelSortFunc                           ,
    ModelSortFunc_WithClosures              ,
    drop_closures_ModelSortFunc             ,
    dynamic_ModelSortFunc                   ,
    genClosure_ModelSortFunc                ,
    mk_ModelSortFunc                        ,
    noModelSortFunc                         ,
    noModelSortFunc_WithClosures            ,
    wrap_ModelSortFunc                      ,


-- ** PathCallback #signal:PathCallback#

    C_PathCallback                          ,
    PathCallback                            ,
    PathCallback_WithClosures               ,
    drop_closures_PathCallback              ,
    dynamic_PathCallback                    ,
    genClosure_PathCallback                 ,
    mk_PathCallback                         ,
    noPathCallback                          ,
    noPathCallback_WithClosures             ,
    wrap_PathCallback                       ,


-- ** ProgressFunc #signal:ProgressFunc#

    C_ProgressFunc                          ,
    ProgressFunc                            ,
    dynamic_ProgressFunc                    ,
    genClosure_ProgressFunc                 ,
    mk_ProgressFunc                         ,
    noProgressFunc                          ,
    wrap_ProgressFunc                       ,


-- ** ScriptConnectFunc #signal:ScriptConnectFunc#

    C_ScriptConnectFunc                     ,
    ScriptConnectFunc                       ,
    ScriptConnectFunc_WithClosures          ,
    drop_closures_ScriptConnectFunc         ,
    dynamic_ScriptConnectFunc               ,
    genClosure_ScriptConnectFunc            ,
    mk_ScriptConnectFunc                    ,
    noScriptConnectFunc                     ,
    noScriptConnectFunc_WithClosures        ,
    wrap_ScriptConnectFunc                  ,


-- ** TimelineProgressFunc #signal:TimelineProgressFunc#

    C_TimelineProgressFunc                  ,
    TimelineProgressFunc                    ,
    TimelineProgressFunc_WithClosures       ,
    drop_closures_TimelineProgressFunc      ,
    dynamic_TimelineProgressFunc            ,
    genClosure_TimelineProgressFunc         ,
    mk_TimelineProgressFunc                 ,
    noTimelineProgressFunc                  ,
    noTimelineProgressFunc_WithClosures     ,
    wrap_TimelineProgressFunc               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.Alpha as Clutter.Alpha
import {-# SOURCE #-} qualified GI.Clutter.Objects.Behaviour as Clutter.Behaviour
import {-# SOURCE #-} qualified GI.Clutter.Objects.Model as Clutter.Model
import {-# SOURCE #-} qualified GI.Clutter.Objects.ModelIter as Clutter.ModelIter
import {-# SOURCE #-} qualified GI.Clutter.Objects.Script as Clutter.Script
import {-# SOURCE #-} qualified GI.Clutter.Objects.Timeline as Clutter.Timeline
import {-# SOURCE #-} qualified GI.Clutter.Structs.PathNode as Clutter.PathNode
import {-# SOURCE #-} qualified GI.Clutter.Unions.Event as Clutter.Event
import qualified GI.GObject.Flags as GObject.Flags
import qualified GI.GObject.Objects.Object as GObject.Object

-- callback TimelineProgressFunc
{- Callable
  { returnType = Just (TBasicType TDouble)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "the progress, as a floating point value between -1.0 and 2.0."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "timeline"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Timeline" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #ClutterTimeline" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "elapsed"
          , argType = TBasicType TDouble
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the elapsed time, in milliseconds"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "total"
          , argType = TBasicType TDouble
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the total duration of the timeline, in milliseconds,"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText = Just "A function for defining a custom progress."
        , sinceVersion = Just "1.10"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_TimelineProgressFunc =
    Ptr Clutter.Timeline.Timeline ->
    CDouble ->
    CDouble ->
    Ptr () ->
    IO CDouble

-- Args: [ Arg
--           { argCName = "timeline"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Timeline" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterTimeline" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "elapsed"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the elapsed time, in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "total"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the total duration of the timeline, in milliseconds,"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_TimelineProgressFunc :: FunPtr C_TimelineProgressFunc -> C_TimelineProgressFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_TimelineProgressFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Timeline.IsTimeline a) =>
    FunPtr C_TimelineProgressFunc
    -> a
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Double
    -- ^ /@elapsed@/: the elapsed time, in milliseconds
    -> Double
    -- ^ /@total@/: the total duration of the timeline, in milliseconds,
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> m Double
    -- ^ __Returns:__ the progress, as a floating point value between -1.0 and 2.0.
dynamic_TimelineProgressFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimeline a) =>
FunPtr C_TimelineProgressFunc
-> a -> Double -> Double -> Ptr () -> m Double
dynamic_TimelineProgressFunc FunPtr C_TimelineProgressFunc
__funPtr a
timeline Double
elapsed Double
total Ptr ()
userData = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Timeline
timeline' <- a -> IO (Ptr Timeline)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
timeline
    let elapsed' :: CDouble
elapsed' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
elapsed
    let total' :: CDouble
total' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
total
    CDouble
result <- (FunPtr C_TimelineProgressFunc -> C_TimelineProgressFunc
__dynamic_C_TimelineProgressFunc FunPtr C_TimelineProgressFunc
__funPtr) Ptr Timeline
timeline' CDouble
elapsed' CDouble
total' Ptr ()
userData
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
timeline
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

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

-- | A function for defining a custom progress.
-- 
-- /Since: 1.10/
type TimelineProgressFunc =
    Clutter.Timeline.Timeline
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Double
    -- ^ /@elapsed@/: the elapsed time, in milliseconds
    -> Double
    -- ^ /@total@/: the total duration of the timeline, in milliseconds,
    -> IO Double
    -- ^ __Returns:__ the progress, as a floating point value between -1.0 and 2.0.

-- | A convenience synonym for @`Nothing` :: `Maybe` `TimelineProgressFunc`@.
noTimelineProgressFunc :: Maybe TimelineProgressFunc
noTimelineProgressFunc :: Maybe TimelineProgressFunc
noTimelineProgressFunc = Maybe TimelineProgressFunc
forall a. Maybe a
Nothing

-- | A function for defining a custom progress.
-- 
-- /Since: 1.10/
type TimelineProgressFunc_WithClosures =
    Clutter.Timeline.Timeline
    -- ^ /@timeline@/: a t'GI.Clutter.Objects.Timeline.Timeline'
    -> Double
    -- ^ /@elapsed@/: the elapsed time, in milliseconds
    -> Double
    -- ^ /@total@/: the total duration of the timeline, in milliseconds,
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> IO Double
    -- ^ __Returns:__ the progress, as a floating point value between -1.0 and 2.0.

-- | A convenience synonym for @`Nothing` :: `Maybe` `TimelineProgressFunc_WithClosures`@.
noTimelineProgressFunc_WithClosures :: Maybe TimelineProgressFunc_WithClosures
noTimelineProgressFunc_WithClosures :: Maybe TimelineProgressFunc_WithClosures
noTimelineProgressFunc_WithClosures = Maybe TimelineProgressFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_TimelineProgressFunc :: TimelineProgressFunc -> TimelineProgressFunc_WithClosures
drop_closures_TimelineProgressFunc :: TimelineProgressFunc -> TimelineProgressFunc_WithClosures
drop_closures_TimelineProgressFunc TimelineProgressFunc
_f Timeline
timeline Double
elapsed Double
total Ptr ()
_ = TimelineProgressFunc
_f Timeline
timeline Double
elapsed Double
total

-- | Wrap the callback into a `GClosure`.
genClosure_TimelineProgressFunc :: MonadIO m => TimelineProgressFunc -> m (GClosure C_TimelineProgressFunc)
genClosure_TimelineProgressFunc :: forall (m :: * -> *).
MonadIO m =>
TimelineProgressFunc -> m (GClosure C_TimelineProgressFunc)
genClosure_TimelineProgressFunc TimelineProgressFunc
cb = IO (GClosure C_TimelineProgressFunc)
-> m (GClosure C_TimelineProgressFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_TimelineProgressFunc)
 -> m (GClosure C_TimelineProgressFunc))
-> IO (GClosure C_TimelineProgressFunc)
-> m (GClosure C_TimelineProgressFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: TimelineProgressFunc_WithClosures
cb' = TimelineProgressFunc -> TimelineProgressFunc_WithClosures
drop_closures_TimelineProgressFunc TimelineProgressFunc
cb
    let cb'' :: C_TimelineProgressFunc
cb'' = Maybe (Ptr (FunPtr C_TimelineProgressFunc))
-> TimelineProgressFunc_WithClosures -> C_TimelineProgressFunc
wrap_TimelineProgressFunc Maybe (Ptr (FunPtr C_TimelineProgressFunc))
forall a. Maybe a
Nothing TimelineProgressFunc_WithClosures
cb'
    C_TimelineProgressFunc -> IO (FunPtr C_TimelineProgressFunc)
mk_TimelineProgressFunc C_TimelineProgressFunc
cb'' IO (FunPtr C_TimelineProgressFunc)
-> (FunPtr C_TimelineProgressFunc
    -> IO (GClosure C_TimelineProgressFunc))
-> IO (GClosure C_TimelineProgressFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_TimelineProgressFunc
-> IO (GClosure C_TimelineProgressFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `TimelineProgressFunc` into a `C_TimelineProgressFunc`.
wrap_TimelineProgressFunc :: 
    Maybe (Ptr (FunPtr C_TimelineProgressFunc)) ->
    TimelineProgressFunc_WithClosures ->
    C_TimelineProgressFunc
wrap_TimelineProgressFunc :: Maybe (Ptr (FunPtr C_TimelineProgressFunc))
-> TimelineProgressFunc_WithClosures -> C_TimelineProgressFunc
wrap_TimelineProgressFunc Maybe (Ptr (FunPtr C_TimelineProgressFunc))
gi'funptrptr TimelineProgressFunc_WithClosures
gi'cb Ptr Timeline
timeline CDouble
elapsed CDouble
total Ptr ()
userData = do
    Timeline
timeline' <- ((ManagedPtr Timeline -> Timeline) -> Ptr Timeline -> IO Timeline
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Timeline -> Timeline
Clutter.Timeline.Timeline) Ptr Timeline
timeline
    let elapsed' :: Double
elapsed' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
elapsed
    let total' :: Double
total' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
total
    Double
result <- TimelineProgressFunc_WithClosures
gi'cb  Timeline
timeline' Double
elapsed' Double
total' Ptr ()
userData
    Maybe (Ptr (FunPtr C_TimelineProgressFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_TimelineProgressFunc))
gi'funptrptr
    let result' :: CDouble
result' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
result
    CDouble -> IO CDouble
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CDouble
result'


-- callback ScriptConnectFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "script"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Script" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "object"
          , argType =
              TInterface Name { namespace = "GObject" , name = "Object" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the object to connect"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "signal_name"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the name of the signal"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "handler_name"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the name of the signal handler"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "connect_object"
          , argType =
              TInterface Name { namespace = "GObject" , name = "Object" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the object to connect the signal to, or %NULL"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "flags"
          , argType =
              TInterface Name { namespace = "GObject" , name = "ConnectFlags" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "signal connection flags"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , 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 the signal handler"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 6
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "This is the signature of a function used to connect signals.  It is used\nby the clutter_script_connect_signals_full() function.  It is mainly\nintended for interpreted language bindings, but could be useful where the\nprogrammer wants more control over the signal connection process."
        , sinceVersion = Just "0.6"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ScriptConnectFunc =
    Ptr Clutter.Script.Script ->
    Ptr GObject.Object.Object ->
    CString ->
    CString ->
    Ptr GObject.Object.Object ->
    CUInt ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object to connect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signal_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the signal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handler_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the signal handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connect_object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object to connect the signal to, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "ConnectFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "signal connection flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , 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 the signal handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ScriptConnectFunc :: FunPtr C_ScriptConnectFunc -> C_ScriptConnectFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ScriptConnectFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Script.IsScript a, GObject.Object.IsObject b, GObject.Object.IsObject c) =>
    FunPtr C_ScriptConnectFunc
    -> a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> b
    -- ^ /@object@/: the object to connect
    -> T.Text
    -- ^ /@signalName@/: the name of the signal
    -> T.Text
    -- ^ /@handlerName@/: the name of the signal handler
    -> c
    -- ^ /@connectObject@/: the object to connect the signal to, or 'P.Nothing'
    -> [GObject.Flags.ConnectFlags]
    -- ^ /@flags@/: signal connection flags
    -> Ptr ()
    -- ^ /@userData@/: user data to pass to the signal handler
    -> m ()
dynamic_ScriptConnectFunc :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsScript a, IsObject b, IsObject c) =>
FunPtr C_ScriptConnectFunc
-> a -> b -> Text -> Text -> c -> [ConnectFlags] -> Ptr () -> m ()
dynamic_ScriptConnectFunc FunPtr C_ScriptConnectFunc
__funPtr a
script b
object Text
signalName Text
handlerName c
connectObject [ConnectFlags]
flags Ptr ()
userData = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr Object
object' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    CString
signalName' <- Text -> IO CString
textToCString Text
signalName
    CString
handlerName' <- Text -> IO CString
textToCString Text
handlerName
    Ptr Object
connectObject' <- c -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
connectObject
    let flags' :: CUInt
flags' = [ConnectFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ConnectFlags]
flags
    (FunPtr C_ScriptConnectFunc -> C_ScriptConnectFunc
__dynamic_C_ScriptConnectFunc FunPtr C_ScriptConnectFunc
__funPtr) Ptr Script
script' Ptr Object
object' CString
signalName' CString
handlerName' Ptr Object
connectObject' CUInt
flags' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
connectObject
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
signalName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
handlerName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | This is the signature of a function used to connect signals.  It is used
-- by the 'GI.Clutter.Objects.Script.scriptConnectSignalsFull' function.  It is mainly
-- intended for interpreted language bindings, but could be useful where the
-- programmer wants more control over the signal connection process.
-- 
-- /Since: 0.6/
type ScriptConnectFunc =
    Clutter.Script.Script
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> GObject.Object.Object
    -- ^ /@object@/: the object to connect
    -> T.Text
    -- ^ /@signalName@/: the name of the signal
    -> T.Text
    -- ^ /@handlerName@/: the name of the signal handler
    -> GObject.Object.Object
    -- ^ /@connectObject@/: the object to connect the signal to, or 'P.Nothing'
    -> [GObject.Flags.ConnectFlags]
    -- ^ /@flags@/: signal connection flags
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ScriptConnectFunc`@.
noScriptConnectFunc :: Maybe ScriptConnectFunc
noScriptConnectFunc :: Maybe ScriptConnectFunc
noScriptConnectFunc = Maybe ScriptConnectFunc
forall a. Maybe a
Nothing

-- | This is the signature of a function used to connect signals.  It is used
-- by the 'GI.Clutter.Objects.Script.scriptConnectSignalsFull' function.  It is mainly
-- intended for interpreted language bindings, but could be useful where the
-- programmer wants more control over the signal connection process.
-- 
-- /Since: 0.6/
type ScriptConnectFunc_WithClosures =
    Clutter.Script.Script
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> GObject.Object.Object
    -- ^ /@object@/: the object to connect
    -> T.Text
    -- ^ /@signalName@/: the name of the signal
    -> T.Text
    -- ^ /@handlerName@/: the name of the signal handler
    -> GObject.Object.Object
    -- ^ /@connectObject@/: the object to connect the signal to, or 'P.Nothing'
    -> [GObject.Flags.ConnectFlags]
    -- ^ /@flags@/: signal connection flags
    -> Ptr ()
    -- ^ /@userData@/: user data to pass to the signal handler
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ScriptConnectFunc_WithClosures`@.
noScriptConnectFunc_WithClosures :: Maybe ScriptConnectFunc_WithClosures
noScriptConnectFunc_WithClosures :: Maybe ScriptConnectFunc_WithClosures
noScriptConnectFunc_WithClosures = Maybe ScriptConnectFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ScriptConnectFunc :: ScriptConnectFunc -> ScriptConnectFunc_WithClosures
drop_closures_ScriptConnectFunc :: ScriptConnectFunc -> ScriptConnectFunc_WithClosures
drop_closures_ScriptConnectFunc ScriptConnectFunc
_f Script
script Object
object Text
signalName Text
handlerName Object
connectObject [ConnectFlags]
flags Ptr ()
_ = ScriptConnectFunc
_f Script
script Object
object Text
signalName Text
handlerName Object
connectObject [ConnectFlags]
flags

-- | Wrap the callback into a `GClosure`.
genClosure_ScriptConnectFunc :: MonadIO m => ScriptConnectFunc -> m (GClosure C_ScriptConnectFunc)
genClosure_ScriptConnectFunc :: forall (m :: * -> *).
MonadIO m =>
ScriptConnectFunc -> m (GClosure C_ScriptConnectFunc)
genClosure_ScriptConnectFunc ScriptConnectFunc
cb = IO (GClosure C_ScriptConnectFunc)
-> m (GClosure C_ScriptConnectFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ScriptConnectFunc)
 -> m (GClosure C_ScriptConnectFunc))
-> IO (GClosure C_ScriptConnectFunc)
-> m (GClosure C_ScriptConnectFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ScriptConnectFunc_WithClosures
cb' = ScriptConnectFunc -> ScriptConnectFunc_WithClosures
drop_closures_ScriptConnectFunc ScriptConnectFunc
cb
    let cb'' :: C_ScriptConnectFunc
cb'' = Maybe (Ptr (FunPtr C_ScriptConnectFunc))
-> ScriptConnectFunc_WithClosures -> C_ScriptConnectFunc
wrap_ScriptConnectFunc Maybe (Ptr (FunPtr C_ScriptConnectFunc))
forall a. Maybe a
Nothing ScriptConnectFunc_WithClosures
cb'
    C_ScriptConnectFunc -> IO (FunPtr C_ScriptConnectFunc)
mk_ScriptConnectFunc C_ScriptConnectFunc
cb'' IO (FunPtr C_ScriptConnectFunc)
-> (FunPtr C_ScriptConnectFunc
    -> IO (GClosure C_ScriptConnectFunc))
-> IO (GClosure C_ScriptConnectFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ScriptConnectFunc -> IO (GClosure C_ScriptConnectFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ScriptConnectFunc` into a `C_ScriptConnectFunc`.
wrap_ScriptConnectFunc :: 
    Maybe (Ptr (FunPtr C_ScriptConnectFunc)) ->
    ScriptConnectFunc_WithClosures ->
    C_ScriptConnectFunc
wrap_ScriptConnectFunc :: Maybe (Ptr (FunPtr C_ScriptConnectFunc))
-> ScriptConnectFunc_WithClosures -> C_ScriptConnectFunc
wrap_ScriptConnectFunc Maybe (Ptr (FunPtr C_ScriptConnectFunc))
gi'funptrptr ScriptConnectFunc_WithClosures
gi'cb Ptr Script
script Ptr Object
object CString
signalName CString
handlerName Ptr Object
connectObject CUInt
flags Ptr ()
userData = do
    Script
script' <- ((ManagedPtr Script -> Script) -> Ptr Script -> IO Script
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Script -> Script
Clutter.Script.Script) Ptr Script
script
    Object
object' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
object
    Text
signalName' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
signalName
    Text
handlerName' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
handlerName
    Object
connectObject' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
connectObject
    let flags' :: [ConnectFlags]
flags' = CUInt -> [ConnectFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
flags
    ScriptConnectFunc_WithClosures
gi'cb  Script
script' Object
object' Text
signalName' Text
handlerName' Object
connectObject' [ConnectFlags]
flags' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ScriptConnectFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ScriptConnectFunc))
gi'funptrptr


-- callback ProgressFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "%TRUE if the function successfully computed\n  the value and stored it inside @retval"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "a"
          , argType = TGValue
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the initial value of an interval"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "b"
          , argType = TGValue
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the final value of an interval"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "progress"
          , argType = TBasicType TDouble
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the progress factor, between 0 and 1"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "retval"
          , argType = TGValue
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the value used to store the progress"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Prototype of the progress function used to compute the value\nbetween the two ends @a and @b of an interval depending on\nthe value of @progress.\n\nThe #GValue in @retval is already initialized with the same\ntype as @a and @b.\n\nThis function will be called by #ClutterInterval if the\ntype of the values of the interval was registered using\nclutter_interval_register_progress_func()."
        , sinceVersion = Just "1.0"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ProgressFunc =
    Ptr GValue ->
    Ptr GValue ->
    CDouble ->
    Ptr GValue ->
    IO CInt

-- Args: [ Arg
--           { argCName = "a"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial value of an interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the final value of an interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the progress factor, between 0 and 1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "retval"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value used to store the progress"
--                 , 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 "dynamic" __dynamic_C_ProgressFunc :: FunPtr C_ProgressFunc -> C_ProgressFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ProgressFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_ProgressFunc
    -> GValue
    -- ^ /@a@/: the initial value of an interval
    -> GValue
    -- ^ /@b@/: the final value of an interval
    -> Double
    -- ^ /@progress@/: the progress factor, between 0 and 1
    -> GValue
    -- ^ /@retval@/: the value used to store the progress
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the function successfully computed
    --   the value and stored it inside /@retval@/
dynamic_ProgressFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_ProgressFunc
-> GValue -> GValue -> Double -> GValue -> m Bool
dynamic_ProgressFunc FunPtr C_ProgressFunc
__funPtr GValue
a GValue
b Double
progress GValue
retval = 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 GValue
a' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
a
    Ptr GValue
b' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
b
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr GValue
retval' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
retval
    CInt
result <- (FunPtr C_ProgressFunc -> C_ProgressFunc
__dynamic_C_ProgressFunc FunPtr C_ProgressFunc
__funPtr) Ptr GValue
a' Ptr GValue
b' CDouble
progress' Ptr GValue
retval'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
a
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
b
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
retval
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

-- | Prototype of the progress function used to compute the value
-- between the two ends /@a@/ and /@b@/ of an interval depending on
-- the value of /@progress@/.
-- 
-- The t'GI.GObject.Structs.Value.Value' in /@retval@/ is already initialized with the same
-- type as /@a@/ and /@b@/.
-- 
-- This function will be called by t'GI.Clutter.Objects.Interval.Interval' if the
-- type of the values of the interval was registered using
-- @/clutter_interval_register_progress_func()/@.
-- 
-- /Since: 1.0/
type ProgressFunc =
    GValue
    -- ^ /@a@/: the initial value of an interval
    -> GValue
    -- ^ /@b@/: the final value of an interval
    -> Double
    -- ^ /@progress@/: the progress factor, between 0 and 1
    -> GValue
    -- ^ /@retval@/: the value used to store the progress
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the function successfully computed
    --   the value and stored it inside /@retval@/

-- | A convenience synonym for @`Nothing` :: `Maybe` `ProgressFunc`@.
noProgressFunc :: Maybe ProgressFunc
noProgressFunc :: Maybe ProgressFunc
noProgressFunc = Maybe ProgressFunc
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ProgressFunc :: MonadIO m => ProgressFunc -> m (GClosure C_ProgressFunc)
genClosure_ProgressFunc :: forall (m :: * -> *).
MonadIO m =>
ProgressFunc -> m (GClosure C_ProgressFunc)
genClosure_ProgressFunc ProgressFunc
cb = IO (GClosure C_ProgressFunc) -> m (GClosure C_ProgressFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ProgressFunc) -> m (GClosure C_ProgressFunc))
-> IO (GClosure C_ProgressFunc) -> m (GClosure C_ProgressFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ProgressFunc
cb' = Maybe (Ptr (FunPtr C_ProgressFunc))
-> ProgressFunc -> C_ProgressFunc
wrap_ProgressFunc Maybe (Ptr (FunPtr C_ProgressFunc))
forall a. Maybe a
Nothing ProgressFunc
cb
    C_ProgressFunc -> IO (FunPtr C_ProgressFunc)
mk_ProgressFunc C_ProgressFunc
cb' IO (FunPtr C_ProgressFunc)
-> (FunPtr C_ProgressFunc -> IO (GClosure C_ProgressFunc))
-> IO (GClosure C_ProgressFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ProgressFunc -> IO (GClosure C_ProgressFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ProgressFunc` into a `C_ProgressFunc`.
wrap_ProgressFunc :: 
    Maybe (Ptr (FunPtr C_ProgressFunc)) ->
    ProgressFunc ->
    C_ProgressFunc
wrap_ProgressFunc :: Maybe (Ptr (FunPtr C_ProgressFunc))
-> ProgressFunc -> C_ProgressFunc
wrap_ProgressFunc Maybe (Ptr (FunPtr C_ProgressFunc))
gi'funptrptr ProgressFunc
gi'cb Ptr GValue
a Ptr GValue
b CDouble
progress Ptr GValue
retval = do
    GValue
a' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
a
    GValue
b' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
b
    let progress' :: Double
progress' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
progress
    GValue
retval' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
retval
    Bool
result <- ProgressFunc
gi'cb  GValue
a' GValue
b' Double
progress' GValue
retval'
    Maybe (Ptr (FunPtr C_ProgressFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ProgressFunc))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback PathCallback
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "node"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "PathNode" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the node" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "optional data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "This function is passed to clutter_path_foreach() and will be\ncalled for each node contained in the path."
        , sinceVersion = Just "1.0"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_PathCallback =
    Ptr Clutter.PathNode.PathNode ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PathNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_PathCallback :: FunPtr C_PathCallback -> C_PathCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_PathCallback ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_PathCallback
    -> Clutter.PathNode.PathNode
    -- ^ /@node@/: the node
    -> Ptr ()
    -- ^ /@data@/: optional data passed to the function
    -> m ()
dynamic_PathCallback :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_PathCallback -> PathNode -> Ptr () -> m ()
dynamic_PathCallback FunPtr C_PathCallback
__funPtr PathNode
node Ptr ()
data_ = 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 PathNode
node' <- PathNode -> IO (Ptr PathNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathNode
node
    (FunPtr C_PathCallback -> C_PathCallback
__dynamic_C_PathCallback FunPtr C_PathCallback
__funPtr) Ptr PathNode
node' Ptr ()
data_
    PathNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathNode
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | This function is passed to 'GI.Clutter.Objects.Path.pathForeach' and will be
-- called for each node contained in the path.
-- 
-- /Since: 1.0/
type PathCallback =
    Clutter.PathNode.PathNode
    -- ^ /@node@/: the node
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PathCallback`@.
noPathCallback :: Maybe PathCallback
noPathCallback :: Maybe (PathNode -> IO ())
noPathCallback = Maybe (PathNode -> IO ())
forall a. Maybe a
Nothing

-- | This function is passed to 'GI.Clutter.Objects.Path.pathForeach' and will be
-- called for each node contained in the path.
-- 
-- /Since: 1.0/
type PathCallback_WithClosures =
    Clutter.PathNode.PathNode
    -- ^ /@node@/: the node
    -> Ptr ()
    -- ^ /@data@/: optional data passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `PathCallback_WithClosures`@.
noPathCallback_WithClosures :: Maybe PathCallback_WithClosures
noPathCallback_WithClosures :: Maybe PathCallback_WithClosures
noPathCallback_WithClosures = Maybe PathCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_PathCallback :: PathCallback -> PathCallback_WithClosures
drop_closures_PathCallback :: (PathNode -> IO ()) -> PathCallback_WithClosures
drop_closures_PathCallback PathNode -> IO ()
_f PathNode
node Ptr ()
_ = PathNode -> IO ()
_f PathNode
node

-- | Wrap the callback into a `GClosure`.
genClosure_PathCallback :: MonadIO m => PathCallback -> m (GClosure C_PathCallback)
genClosure_PathCallback :: forall (m :: * -> *).
MonadIO m =>
(PathNode -> IO ()) -> m (GClosure C_PathCallback)
genClosure_PathCallback PathNode -> IO ()
cb = IO (GClosure C_PathCallback) -> m (GClosure C_PathCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PathCallback) -> m (GClosure C_PathCallback))
-> IO (GClosure C_PathCallback) -> m (GClosure C_PathCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: PathCallback_WithClosures
cb' = (PathNode -> IO ()) -> PathCallback_WithClosures
drop_closures_PathCallback PathNode -> IO ()
cb
    let cb'' :: C_PathCallback
cb'' = Maybe (Ptr (FunPtr C_PathCallback))
-> PathCallback_WithClosures -> C_PathCallback
wrap_PathCallback Maybe (Ptr (FunPtr C_PathCallback))
forall a. Maybe a
Nothing PathCallback_WithClosures
cb'
    C_PathCallback -> IO (FunPtr C_PathCallback)
mk_PathCallback C_PathCallback
cb'' IO (FunPtr C_PathCallback)
-> (FunPtr C_PathCallback -> IO (GClosure C_PathCallback))
-> IO (GClosure C_PathCallback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PathCallback -> IO (GClosure C_PathCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PathCallback` into a `C_PathCallback`.
wrap_PathCallback :: 
    Maybe (Ptr (FunPtr C_PathCallback)) ->
    PathCallback_WithClosures ->
    C_PathCallback
wrap_PathCallback :: Maybe (Ptr (FunPtr C_PathCallback))
-> PathCallback_WithClosures -> C_PathCallback
wrap_PathCallback Maybe (Ptr (FunPtr C_PathCallback))
gi'funptrptr PathCallback_WithClosures
gi'cb Ptr PathNode
node Ptr ()
data_ = do
    Ptr PathNode -> (PathNode -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr PathNode
node ((PathNode -> IO ()) -> IO ()) -> (PathNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PathNode
node' -> do
        PathCallback_WithClosures
gi'cb  PathNode
node' Ptr ()
data_
        Maybe (Ptr (FunPtr C_PathCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_PathCallback))
gi'funptrptr


-- callback ModelSortFunc
{- Callable
  { returnType = Just (TBasicType TInt)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "a positive integer if @a is after @b, a negative integer if\n  @a is before @b, or 0 if the rows are the same"
        , sinceVersion = Nothing
        }
  , 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 = "a"
          , argType = TGValue
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "a #GValue representing the contents of the row"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "b"
          , argType = TGValue
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "a #GValue representing the contents of the second row"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to clutter_model_set_sort()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "1.24"
          , deprecationMessage =
              Just "Implement sorting using a custom #GListModel instead"
          }
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just "Compares the content of two rows in the model."
        , sinceVersion = Just "0.6"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ModelSortFunc =
    Ptr Clutter.Model.Model ->
    Ptr GValue ->
    Ptr GValue ->
    Ptr () ->
    IO Int32

-- 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 = "a"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue representing the contents of the row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue representing the contents of the second row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to clutter_model_set_sort()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ModelSortFunc :: FunPtr C_ModelSortFunc -> C_ModelSortFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ModelSortFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Model.IsModel a) =>
    FunPtr C_ModelSortFunc
    -> a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> GValue
    -- ^ /@a@/: a t'GI.GObject.Structs.Value.Value' representing the contents of the row
    -> GValue
    -- ^ /@b@/: a t'GI.GObject.Structs.Value.Value' representing the contents of the second row
    -> Ptr ()
    -- ^ /@userData@/: data passed to 'GI.Clutter.Objects.Model.modelSetSort'
    -> m Int32
    -- ^ __Returns:__ a positive integer if /@a@/ is after /@b@/, a negative integer if
    --   /@a@/ is before /@b@/, or 0 if the rows are the same
dynamic_ModelSortFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsModel a) =>
FunPtr C_ModelSortFunc
-> a -> GValue -> GValue -> Ptr () -> m Int32
dynamic_ModelSortFunc FunPtr C_ModelSortFunc
__funPtr a
model GValue
a GValue
b Ptr ()
userData = 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
    Ptr GValue
a' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
a
    Ptr GValue
b' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
b
    Int32
result <- (FunPtr C_ModelSortFunc -> C_ModelSortFunc
__dynamic_C_ModelSortFunc FunPtr C_ModelSortFunc
__funPtr) Ptr Model
model' Ptr GValue
a' Ptr GValue
b' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
model
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
a
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
b
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

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

{-# DEPRECATED ModelSortFunc ["(Since version 1.24)","Implement sorting using a custom t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Compares the content of two rows in the model.
-- 
-- /Since: 0.6/
type ModelSortFunc =
    Clutter.Model.Model
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> GValue
    -- ^ /@a@/: a t'GI.GObject.Structs.Value.Value' representing the contents of the row
    -> GValue
    -- ^ /@b@/: a t'GI.GObject.Structs.Value.Value' representing the contents of the second row
    -> IO Int32
    -- ^ __Returns:__ a positive integer if /@a@/ is after /@b@/, a negative integer if
    --   /@a@/ is before /@b@/, or 0 if the rows are the same

-- | A convenience synonym for @`Nothing` :: `Maybe` `ModelSortFunc`@.
noModelSortFunc :: Maybe ModelSortFunc
noModelSortFunc :: Maybe ModelSortFunc
noModelSortFunc = Maybe ModelSortFunc
forall a. Maybe a
Nothing

-- | Compares the content of two rows in the model.
-- 
-- /Since: 0.6/
type ModelSortFunc_WithClosures =
    Clutter.Model.Model
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> GValue
    -- ^ /@a@/: a t'GI.GObject.Structs.Value.Value' representing the contents of the row
    -> GValue
    -- ^ /@b@/: a t'GI.GObject.Structs.Value.Value' representing the contents of the second row
    -> Ptr ()
    -- ^ /@userData@/: data passed to 'GI.Clutter.Objects.Model.modelSetSort'
    -> IO Int32
    -- ^ __Returns:__ a positive integer if /@a@/ is after /@b@/, a negative integer if
    --   /@a@/ is before /@b@/, or 0 if the rows are the same

-- | A convenience synonym for @`Nothing` :: `Maybe` `ModelSortFunc_WithClosures`@.
noModelSortFunc_WithClosures :: Maybe ModelSortFunc_WithClosures
noModelSortFunc_WithClosures :: Maybe ModelSortFunc_WithClosures
noModelSortFunc_WithClosures = Maybe ModelSortFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ModelSortFunc :: ModelSortFunc -> ModelSortFunc_WithClosures
drop_closures_ModelSortFunc :: ModelSortFunc -> ModelSortFunc_WithClosures
drop_closures_ModelSortFunc ModelSortFunc
_f Model
model GValue
a GValue
b Ptr ()
_ = ModelSortFunc
_f Model
model GValue
a GValue
b

-- | Wrap the callback into a `GClosure`.
genClosure_ModelSortFunc :: MonadIO m => ModelSortFunc -> m (GClosure C_ModelSortFunc)
genClosure_ModelSortFunc :: forall (m :: * -> *).
MonadIO m =>
ModelSortFunc -> m (GClosure C_ModelSortFunc)
genClosure_ModelSortFunc ModelSortFunc
cb = IO (GClosure C_ModelSortFunc) -> m (GClosure C_ModelSortFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ModelSortFunc) -> m (GClosure C_ModelSortFunc))
-> IO (GClosure C_ModelSortFunc) -> m (GClosure C_ModelSortFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ModelSortFunc_WithClosures
cb' = ModelSortFunc -> ModelSortFunc_WithClosures
drop_closures_ModelSortFunc ModelSortFunc
cb
    let cb'' :: C_ModelSortFunc
cb'' = Maybe (Ptr (FunPtr C_ModelSortFunc))
-> ModelSortFunc_WithClosures -> C_ModelSortFunc
wrap_ModelSortFunc Maybe (Ptr (FunPtr C_ModelSortFunc))
forall a. Maybe a
Nothing ModelSortFunc_WithClosures
cb'
    C_ModelSortFunc -> IO (FunPtr C_ModelSortFunc)
mk_ModelSortFunc C_ModelSortFunc
cb'' IO (FunPtr C_ModelSortFunc)
-> (FunPtr C_ModelSortFunc -> IO (GClosure C_ModelSortFunc))
-> IO (GClosure C_ModelSortFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ModelSortFunc -> IO (GClosure C_ModelSortFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ModelSortFunc` into a `C_ModelSortFunc`.
wrap_ModelSortFunc :: 
    Maybe (Ptr (FunPtr C_ModelSortFunc)) ->
    ModelSortFunc_WithClosures ->
    C_ModelSortFunc
wrap_ModelSortFunc :: Maybe (Ptr (FunPtr C_ModelSortFunc))
-> ModelSortFunc_WithClosures -> C_ModelSortFunc
wrap_ModelSortFunc Maybe (Ptr (FunPtr C_ModelSortFunc))
gi'funptrptr ModelSortFunc_WithClosures
gi'cb Ptr Model
model Ptr GValue
a Ptr GValue
b Ptr ()
userData = do
    Model
model' <- ((ManagedPtr Model -> Model) -> Ptr Model -> IO Model
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Model -> Model
Clutter.Model.Model) Ptr Model
model
    GValue
a' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
a
    GValue
b' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
b
    Int32
result <- ModelSortFunc_WithClosures
gi'cb  Model
model' GValue
a' GValue
b' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ModelSortFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ModelSortFunc))
gi'funptrptr
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result


-- callback ModelForeachFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE if the iteration should continue, %FALSE otherwise"
        , sinceVersion = Nothing
        }
  , 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 iterator for the row"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to clutter_model_foreach()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "1.24"
          , deprecationMessage = Just "Use #GListModel"
          }
  , callableDocumentation =
      Documentation
        { rawDocText = Just "Iterates on the content of a row in the model"
        , sinceVersion = Just "0.6"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ModelForeachFunc =
    Ptr Clutter.Model.Model ->
    Ptr Clutter.ModelIter.ModelIter ->
    Ptr () ->
    IO CInt

-- 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 iterator for the row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to clutter_model_foreach()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ModelForeachFunc :: FunPtr C_ModelForeachFunc -> C_ModelForeachFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ModelForeachFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Model.IsModel a, Clutter.ModelIter.IsModelIter b) =>
    FunPtr C_ModelForeachFunc
    -> a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> b
    -- ^ /@iter@/: the iterator for the row
    -> Ptr ()
    -- ^ /@userData@/: data passed to 'GI.Clutter.Objects.Model.modelForeach'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the iteration should continue, 'P.False' otherwise
dynamic_ModelForeachFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsModel a, IsModelIter b) =>
FunPtr C_ModelForeachFunc -> a -> b -> Ptr () -> m Bool
dynamic_ModelForeachFunc FunPtr C_ModelForeachFunc
__funPtr a
model b
iter Ptr ()
userData = 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 <- (FunPtr C_ModelForeachFunc -> C_ModelForeachFunc
__dynamic_C_ModelForeachFunc FunPtr C_ModelForeachFunc
__funPtr) Ptr Model
model' Ptr ModelIter
iter' Ptr ()
userData
    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'

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

{-# DEPRECATED ModelForeachFunc ["(Since version 1.24)","Use t'GI.Gio.Interfaces.ListModel.ListModel'"] #-}
-- | Iterates on the content of a row in the model
-- 
-- /Since: 0.6/
type ModelForeachFunc =
    Clutter.Model.Model
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: the iterator for the row
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the iteration should continue, 'P.False' otherwise

-- | A convenience synonym for @`Nothing` :: `Maybe` `ModelForeachFunc`@.
noModelForeachFunc :: Maybe ModelForeachFunc
noModelForeachFunc :: Maybe ModelForeachFunc
noModelForeachFunc = Maybe ModelForeachFunc
forall a. Maybe a
Nothing

-- | Iterates on the content of a row in the model
-- 
-- /Since: 0.6/
type ModelForeachFunc_WithClosures =
    Clutter.Model.Model
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: the iterator for the row
    -> Ptr ()
    -- ^ /@userData@/: data passed to 'GI.Clutter.Objects.Model.modelForeach'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the iteration should continue, 'P.False' otherwise

-- | A convenience synonym for @`Nothing` :: `Maybe` `ModelForeachFunc_WithClosures`@.
noModelForeachFunc_WithClosures :: Maybe ModelForeachFunc_WithClosures
noModelForeachFunc_WithClosures :: Maybe ModelForeachFunc_WithClosures
noModelForeachFunc_WithClosures = Maybe ModelForeachFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ModelForeachFunc :: ModelForeachFunc -> ModelForeachFunc_WithClosures
drop_closures_ModelForeachFunc :: ModelForeachFunc -> ModelForeachFunc_WithClosures
drop_closures_ModelForeachFunc ModelForeachFunc
_f Model
model ModelIter
iter Ptr ()
_ = ModelForeachFunc
_f Model
model ModelIter
iter

-- | Wrap the callback into a `GClosure`.
genClosure_ModelForeachFunc :: MonadIO m => ModelForeachFunc -> m (GClosure C_ModelForeachFunc)
genClosure_ModelForeachFunc :: forall (m :: * -> *).
MonadIO m =>
ModelForeachFunc -> m (GClosure C_ModelForeachFunc)
genClosure_ModelForeachFunc ModelForeachFunc
cb = IO (GClosure C_ModelForeachFunc) -> m (GClosure C_ModelForeachFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ModelForeachFunc)
 -> m (GClosure C_ModelForeachFunc))
-> IO (GClosure C_ModelForeachFunc)
-> m (GClosure C_ModelForeachFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ModelForeachFunc_WithClosures
cb' = ModelForeachFunc -> ModelForeachFunc_WithClosures
drop_closures_ModelForeachFunc ModelForeachFunc
cb
    let cb'' :: C_ModelForeachFunc
cb'' = Maybe (Ptr (FunPtr C_ModelForeachFunc))
-> ModelForeachFunc_WithClosures -> C_ModelForeachFunc
wrap_ModelForeachFunc Maybe (Ptr (FunPtr C_ModelForeachFunc))
forall a. Maybe a
Nothing ModelForeachFunc_WithClosures
cb'
    C_ModelForeachFunc -> IO (FunPtr C_ModelForeachFunc)
mk_ModelForeachFunc C_ModelForeachFunc
cb'' IO (FunPtr C_ModelForeachFunc)
-> (FunPtr C_ModelForeachFunc -> IO (GClosure C_ModelForeachFunc))
-> IO (GClosure C_ModelForeachFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ModelForeachFunc -> IO (GClosure C_ModelForeachFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ModelForeachFunc` into a `C_ModelForeachFunc`.
wrap_ModelForeachFunc :: 
    Maybe (Ptr (FunPtr C_ModelForeachFunc)) ->
    ModelForeachFunc_WithClosures ->
    C_ModelForeachFunc
wrap_ModelForeachFunc :: Maybe (Ptr (FunPtr C_ModelForeachFunc))
-> ModelForeachFunc_WithClosures -> C_ModelForeachFunc
wrap_ModelForeachFunc Maybe (Ptr (FunPtr C_ModelForeachFunc))
gi'funptrptr ModelForeachFunc_WithClosures
gi'cb Ptr Model
model Ptr ModelIter
iter Ptr ()
userData = do
    Model
model' <- ((ManagedPtr Model -> Model) -> Ptr Model -> IO Model
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Model -> Model
Clutter.Model.Model) Ptr Model
model
    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
    Bool
result <- ModelForeachFunc_WithClosures
gi'cb  Model
model' ModelIter
iter' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ModelForeachFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ModelForeachFunc))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback ModelFilterFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText = Just "If the row should be displayed, return %TRUE"
        , sinceVersion = Nothing
        }
  , 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 iterator for the row"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to clutter_model_set_filter()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "1.24"
          , deprecationMessage =
              Just "Implement filters using a custom #GListModel instead"
          }
  , callableDocumentation =
      Documentation
        { rawDocText = Just "Filters the content of a row in the model."
        , sinceVersion = Just "0.6"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ModelFilterFunc =
    Ptr Clutter.Model.Model ->
    Ptr Clutter.ModelIter.ModelIter ->
    Ptr () ->
    IO CInt

-- 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 iterator for the row"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to clutter_model_set_filter()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ModelFilterFunc :: FunPtr C_ModelFilterFunc -> C_ModelFilterFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ModelFilterFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Model.IsModel a, Clutter.ModelIter.IsModelIter b) =>
    FunPtr C_ModelFilterFunc
    -> a
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> b
    -- ^ /@iter@/: the iterator for the row
    -> Ptr ()
    -- ^ /@userData@/: data passed to 'GI.Clutter.Objects.Model.modelSetFilter'
    -> m Bool
    -- ^ __Returns:__ If the row should be displayed, return 'P.True'
dynamic_ModelFilterFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsModel a, IsModelIter b) =>
FunPtr C_ModelForeachFunc -> a -> b -> Ptr () -> m Bool
dynamic_ModelFilterFunc FunPtr C_ModelForeachFunc
__funPtr a
model b
iter Ptr ()
userData = 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 <- (FunPtr C_ModelForeachFunc -> C_ModelForeachFunc
__dynamic_C_ModelFilterFunc FunPtr C_ModelForeachFunc
__funPtr) Ptr Model
model' Ptr ModelIter
iter' Ptr ()
userData
    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'

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

{-# DEPRECATED ModelFilterFunc ["(Since version 1.24)","Implement filters using a custom t'GI.Gio.Interfaces.ListModel.ListModel' instead"] #-}
-- | Filters the content of a row in the model.
-- 
-- /Since: 0.6/
type ModelFilterFunc =
    Clutter.Model.Model
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: the iterator for the row
    -> IO Bool
    -- ^ __Returns:__ If the row should be displayed, return 'P.True'

-- | A convenience synonym for @`Nothing` :: `Maybe` `ModelFilterFunc`@.
noModelFilterFunc :: Maybe ModelFilterFunc
noModelFilterFunc :: Maybe ModelForeachFunc
noModelFilterFunc = Maybe ModelForeachFunc
forall a. Maybe a
Nothing

-- | Filters the content of a row in the model.
-- 
-- /Since: 0.6/
type ModelFilterFunc_WithClosures =
    Clutter.Model.Model
    -- ^ /@model@/: a t'GI.Clutter.Objects.Model.Model'
    -> Clutter.ModelIter.ModelIter
    -- ^ /@iter@/: the iterator for the row
    -> Ptr ()
    -- ^ /@userData@/: data passed to 'GI.Clutter.Objects.Model.modelSetFilter'
    -> IO Bool
    -- ^ __Returns:__ If the row should be displayed, return 'P.True'

-- | A convenience synonym for @`Nothing` :: `Maybe` `ModelFilterFunc_WithClosures`@.
noModelFilterFunc_WithClosures :: Maybe ModelFilterFunc_WithClosures
noModelFilterFunc_WithClosures :: Maybe ModelForeachFunc_WithClosures
noModelFilterFunc_WithClosures = Maybe ModelForeachFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ModelFilterFunc :: ModelFilterFunc -> ModelFilterFunc_WithClosures
drop_closures_ModelFilterFunc :: ModelForeachFunc -> ModelForeachFunc_WithClosures
drop_closures_ModelFilterFunc ModelForeachFunc
_f Model
model ModelIter
iter Ptr ()
_ = ModelForeachFunc
_f Model
model ModelIter
iter

-- | Wrap the callback into a `GClosure`.
genClosure_ModelFilterFunc :: MonadIO m => ModelFilterFunc -> m (GClosure C_ModelFilterFunc)
genClosure_ModelFilterFunc :: forall (m :: * -> *).
MonadIO m =>
ModelForeachFunc -> m (GClosure C_ModelForeachFunc)
genClosure_ModelFilterFunc ModelForeachFunc
cb = IO (GClosure C_ModelForeachFunc) -> m (GClosure C_ModelForeachFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ModelForeachFunc)
 -> m (GClosure C_ModelForeachFunc))
-> IO (GClosure C_ModelForeachFunc)
-> m (GClosure C_ModelForeachFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ModelForeachFunc_WithClosures
cb' = ModelForeachFunc -> ModelForeachFunc_WithClosures
drop_closures_ModelFilterFunc ModelForeachFunc
cb
    let cb'' :: C_ModelForeachFunc
cb'' = Maybe (Ptr (FunPtr C_ModelForeachFunc))
-> ModelForeachFunc_WithClosures -> C_ModelForeachFunc
wrap_ModelFilterFunc Maybe (Ptr (FunPtr C_ModelForeachFunc))
forall a. Maybe a
Nothing ModelForeachFunc_WithClosures
cb'
    C_ModelForeachFunc -> IO (FunPtr C_ModelForeachFunc)
mk_ModelFilterFunc C_ModelForeachFunc
cb'' IO (FunPtr C_ModelForeachFunc)
-> (FunPtr C_ModelForeachFunc -> IO (GClosure C_ModelForeachFunc))
-> IO (GClosure C_ModelForeachFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ModelForeachFunc -> IO (GClosure C_ModelForeachFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ModelFilterFunc` into a `C_ModelFilterFunc`.
wrap_ModelFilterFunc :: 
    Maybe (Ptr (FunPtr C_ModelFilterFunc)) ->
    ModelFilterFunc_WithClosures ->
    C_ModelFilterFunc
wrap_ModelFilterFunc :: Maybe (Ptr (FunPtr C_ModelForeachFunc))
-> ModelForeachFunc_WithClosures -> C_ModelForeachFunc
wrap_ModelFilterFunc Maybe (Ptr (FunPtr C_ModelForeachFunc))
gi'funptrptr ModelForeachFunc_WithClosures
gi'cb Ptr Model
model Ptr ModelIter
iter Ptr ()
userData = do
    Model
model' <- ((ManagedPtr Model -> Model) -> Ptr Model -> IO Model
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Model -> Model
Clutter.Model.Model) Ptr Model
model
    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
    Bool
result <- ModelForeachFunc_WithClosures
gi'cb  Model
model' ModelIter
iter' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ModelForeachFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ModelForeachFunc))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback EventFilterFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "%CLUTTER_EVENT_STOP to indicate that the event\n  has been handled or %CLUTTER_EVENT_PROPAGATE otherwise.\n  Returning %CLUTTER_EVENT_STOP skips any further filter\n  functions and prevents the signal emission for the event."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "event"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Event" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the event that is going to be emitted"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the data pointer passed to clutter_event_add_filter()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "A function pointer type used by event filters that are added with\nclutter_event_add_filter()."
        , sinceVersion = Just "1.18"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_EventFilterFunc =
    Ptr Clutter.Event.Event ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Event" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the event that is going to be emitted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the data pointer passed to clutter_event_add_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 "dynamic" __dynamic_C_EventFilterFunc :: FunPtr C_EventFilterFunc -> C_EventFilterFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_EventFilterFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_EventFilterFunc
    -> Clutter.Event.Event
    -- ^ /@event@/: the event that is going to be emitted
    -> Ptr ()
    -- ^ /@userData@/: the data pointer passed to 'GI.Clutter.Functions.eventAddFilter'
    -> m Bool
    -- ^ __Returns:__ 'GI.Clutter.Constants.EVENT_STOP' to indicate that the event
    --   has been handled or 'GI.Clutter.Constants.EVENT_PROPAGATE' otherwise.
    --   Returning 'GI.Clutter.Constants.EVENT_STOP' skips any further filter
    --   functions and prevents the signal emission for the event.
dynamic_EventFilterFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_EventFilterFunc -> Event -> Ptr () -> m Bool
dynamic_EventFilterFunc FunPtr C_EventFilterFunc
__funPtr Event
event Ptr ()
userData = 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 Event
event' <- Event -> IO (Ptr Event)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Event
event
    CInt
result <- (FunPtr C_EventFilterFunc -> C_EventFilterFunc
__dynamic_C_EventFilterFunc FunPtr C_EventFilterFunc
__funPtr) Ptr Event
event' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Event -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Event
event
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

-- | A function pointer type used by event filters that are added with
-- 'GI.Clutter.Functions.eventAddFilter'.
-- 
-- /Since: 1.18/
type EventFilterFunc =
    Clutter.Event.Event
    -- ^ /@event@/: the event that is going to be emitted
    -> IO Bool
    -- ^ __Returns:__ 'GI.Clutter.Constants.EVENT_STOP' to indicate that the event
    --   has been handled or 'GI.Clutter.Constants.EVENT_PROPAGATE' otherwise.
    --   Returning 'GI.Clutter.Constants.EVENT_STOP' skips any further filter
    --   functions and prevents the signal emission for the event.

-- | A convenience synonym for @`Nothing` :: `Maybe` `EventFilterFunc`@.
noEventFilterFunc :: Maybe EventFilterFunc
noEventFilterFunc :: Maybe EventFilterFunc
noEventFilterFunc = Maybe EventFilterFunc
forall a. Maybe a
Nothing

-- | A function pointer type used by event filters that are added with
-- 'GI.Clutter.Functions.eventAddFilter'.
-- 
-- /Since: 1.18/
type EventFilterFunc_WithClosures =
    Clutter.Event.Event
    -- ^ /@event@/: the event that is going to be emitted
    -> Ptr ()
    -- ^ /@userData@/: the data pointer passed to 'GI.Clutter.Functions.eventAddFilter'
    -> IO Bool
    -- ^ __Returns:__ 'GI.Clutter.Constants.EVENT_STOP' to indicate that the event
    --   has been handled or 'GI.Clutter.Constants.EVENT_PROPAGATE' otherwise.
    --   Returning 'GI.Clutter.Constants.EVENT_STOP' skips any further filter
    --   functions and prevents the signal emission for the event.

-- | A convenience synonym for @`Nothing` :: `Maybe` `EventFilterFunc_WithClosures`@.
noEventFilterFunc_WithClosures :: Maybe EventFilterFunc_WithClosures
noEventFilterFunc_WithClosures :: Maybe EventFilterFunc_WithClosures
noEventFilterFunc_WithClosures = Maybe EventFilterFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_EventFilterFunc :: EventFilterFunc -> EventFilterFunc_WithClosures
drop_closures_EventFilterFunc :: EventFilterFunc -> EventFilterFunc_WithClosures
drop_closures_EventFilterFunc EventFilterFunc
_f Event
event Ptr ()
_ = EventFilterFunc
_f Event
event

-- | Wrap the callback into a `GClosure`.
genClosure_EventFilterFunc :: MonadIO m => EventFilterFunc -> m (GClosure C_EventFilterFunc)
genClosure_EventFilterFunc :: forall (m :: * -> *).
MonadIO m =>
EventFilterFunc -> m (GClosure C_EventFilterFunc)
genClosure_EventFilterFunc EventFilterFunc
cb = IO (GClosure C_EventFilterFunc) -> m (GClosure C_EventFilterFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_EventFilterFunc) -> m (GClosure C_EventFilterFunc))
-> IO (GClosure C_EventFilterFunc)
-> m (GClosure C_EventFilterFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: EventFilterFunc_WithClosures
cb' = EventFilterFunc -> EventFilterFunc_WithClosures
drop_closures_EventFilterFunc EventFilterFunc
cb
    let cb'' :: C_EventFilterFunc
cb'' = Maybe (Ptr (FunPtr C_EventFilterFunc))
-> EventFilterFunc_WithClosures -> C_EventFilterFunc
wrap_EventFilterFunc Maybe (Ptr (FunPtr C_EventFilterFunc))
forall a. Maybe a
Nothing EventFilterFunc_WithClosures
cb'
    C_EventFilterFunc -> IO (FunPtr C_EventFilterFunc)
mk_EventFilterFunc C_EventFilterFunc
cb'' IO (FunPtr C_EventFilterFunc)
-> (FunPtr C_EventFilterFunc -> IO (GClosure C_EventFilterFunc))
-> IO (GClosure C_EventFilterFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_EventFilterFunc -> IO (GClosure C_EventFilterFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `EventFilterFunc` into a `C_EventFilterFunc`.
wrap_EventFilterFunc :: 
    Maybe (Ptr (FunPtr C_EventFilterFunc)) ->
    EventFilterFunc_WithClosures ->
    C_EventFilterFunc
wrap_EventFilterFunc :: Maybe (Ptr (FunPtr C_EventFilterFunc))
-> EventFilterFunc_WithClosures -> C_EventFilterFunc
wrap_EventFilterFunc Maybe (Ptr (FunPtr C_EventFilterFunc))
gi'funptrptr EventFilterFunc_WithClosures
gi'cb Ptr Event
event Ptr ()
userData = do
    Ptr Event -> (Event -> IO CInt) -> IO CInt
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr Event
event ((Event -> IO CInt) -> IO CInt) -> (Event -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Event
event' -> do
        Bool
result <- EventFilterFunc_WithClosures
gi'cb  Event
event' Ptr ()
userData
        Maybe (Ptr (FunPtr C_EventFilterFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_EventFilterFunc))
gi'funptrptr
        let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
        CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback Callback
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "actor"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Actor" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "user data" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText = Just "Generic callback" , sinceVersion = Nothing }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_Callback =
    Ptr Clutter.Actor.Actor ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_Callback :: FunPtr C_Callback -> C_Callback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_Callback ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    FunPtr C_Callback
    -> a
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> Ptr ()
    -- ^ /@data@/: user data
    -> m ()
dynamic_Callback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
FunPtr C_Callback -> a -> Ptr () -> m ()
dynamic_Callback FunPtr C_Callback
__funPtr a
actor Ptr ()
data_ = 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 Actor
actor' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
actor
    (FunPtr C_Callback -> C_Callback
__dynamic_C_Callback FunPtr C_Callback
__funPtr) Ptr Actor
actor' Ptr ()
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | Generic callback
type Callback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `Callback`@.
noCallback :: Maybe Callback
noCallback :: Maybe Callback
noCallback = Maybe Callback
forall a. Maybe a
Nothing

-- | Generic callback
type Callback_WithClosures =
    Clutter.Actor.Actor
    -- ^ /@actor@/: a t'GI.Clutter.Objects.Actor.Actor'
    -> Ptr ()
    -- ^ /@data@/: user data
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `Callback_WithClosures`@.
noCallback_WithClosures :: Maybe Callback_WithClosures
noCallback_WithClosures :: Maybe Callback_WithClosures
noCallback_WithClosures = Maybe Callback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_Callback :: Callback -> Callback_WithClosures
drop_closures_Callback :: Callback -> Callback_WithClosures
drop_closures_Callback Callback
_f Actor
actor Ptr ()
_ = Callback
_f Actor
actor

-- | Wrap the callback into a `GClosure`.
genClosure_Callback :: MonadIO m => Callback -> m (GClosure C_Callback)
genClosure_Callback :: forall (m :: * -> *).
MonadIO m =>
Callback -> m (GClosure C_Callback)
genClosure_Callback Callback
cb = IO (GClosure C_Callback) -> m (GClosure C_Callback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_Callback) -> m (GClosure C_Callback))
-> IO (GClosure C_Callback) -> m (GClosure C_Callback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: Callback_WithClosures
cb' = Callback -> Callback_WithClosures
drop_closures_Callback Callback
cb
    let cb'' :: C_Callback
cb'' = Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
wrap_Callback Maybe (Ptr (FunPtr C_Callback))
forall a. Maybe a
Nothing Callback_WithClosures
cb'
    C_Callback -> IO (FunPtr C_Callback)
mk_Callback C_Callback
cb'' IO (FunPtr C_Callback)
-> (FunPtr C_Callback -> IO (GClosure C_Callback))
-> IO (GClosure C_Callback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_Callback -> IO (GClosure C_Callback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `Callback` into a `C_Callback`.
wrap_Callback :: 
    Maybe (Ptr (FunPtr C_Callback)) ->
    Callback_WithClosures ->
    C_Callback
wrap_Callback :: Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
wrap_Callback Maybe (Ptr (FunPtr C_Callback))
gi'funptrptr Callback_WithClosures
gi'cb Ptr Actor
actor Ptr ()
data_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    Callback_WithClosures
gi'cb  Actor
actor' Ptr ()
data_
    Maybe (Ptr (FunPtr C_Callback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_Callback))
gi'funptrptr


-- callback BindingActionFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "the function should return %TRUE if the key\n  binding has been handled, and return %FALSE otherwise"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "gobject"
          , argType =
              TInterface Name { namespace = "GObject" , name = "Object" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #GObject" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "action_name"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the name of the action"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "key_val"
          , argType = TBasicType TUInt
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the key symbol" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "modifiers"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "ModifierType" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "bitmask of the modifier flags"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 4
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The prototype for the callback function registered with\nclutter_binding_pool_install_action() and invoked by\nclutter_binding_pool_activate()."
        , sinceVersion = Just "1.0"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_BindingActionFunc =
    Ptr GObject.Object.Object ->
    CString ->
    Word32 ->
    CUInt ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "gobject"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_val"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the key symbol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "bitmask of the modifier flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_BindingActionFunc :: FunPtr C_BindingActionFunc -> C_BindingActionFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_BindingActionFunc ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    FunPtr C_BindingActionFunc
    -> a
    -- ^ /@gobject@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@actionName@/: the name of the action
    -> Word32
    -- ^ /@keyVal@/: the key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of the modifier flags
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> m Bool
    -- ^ __Returns:__ the function should return 'P.True' if the key
    --   binding has been handled, and return 'P.False' otherwise
dynamic_BindingActionFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
FunPtr C_BindingActionFunc
-> a -> Text -> Word32 -> [ModifierType] -> Ptr () -> m Bool
dynamic_BindingActionFunc FunPtr C_BindingActionFunc
__funPtr a
gobject Text
actionName Word32
keyVal [ModifierType]
modifiers Ptr ()
userData = 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 Object
gobject' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
gobject
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    let modifiers' :: CUInt
modifiers' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
modifiers
    CInt
result <- (FunPtr C_BindingActionFunc -> C_BindingActionFunc
__dynamic_C_BindingActionFunc FunPtr C_BindingActionFunc
__funPtr) Ptr Object
gobject' CString
actionName' Word32
keyVal CUInt
modifiers' Ptr ()
userData
    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
gobject
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

-- | The prototype for the callback function registered with
-- 'GI.Clutter.Objects.BindingPool.bindingPoolInstallAction' and invoked by
-- 'GI.Clutter.Objects.BindingPool.bindingPoolActivate'.
-- 
-- /Since: 1.0/
type BindingActionFunc =
    GObject.Object.Object
    -- ^ /@gobject@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@actionName@/: the name of the action
    -> Word32
    -- ^ /@keyVal@/: the key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of the modifier flags
    -> IO Bool
    -- ^ __Returns:__ the function should return 'P.True' if the key
    --   binding has been handled, and return 'P.False' otherwise

-- | A convenience synonym for @`Nothing` :: `Maybe` `BindingActionFunc`@.
noBindingActionFunc :: Maybe BindingActionFunc
noBindingActionFunc :: Maybe BindingActionFunc
noBindingActionFunc = Maybe BindingActionFunc
forall a. Maybe a
Nothing

-- | The prototype for the callback function registered with
-- 'GI.Clutter.Objects.BindingPool.bindingPoolInstallAction' and invoked by
-- 'GI.Clutter.Objects.BindingPool.bindingPoolActivate'.
-- 
-- /Since: 1.0/
type BindingActionFunc_WithClosures =
    GObject.Object.Object
    -- ^ /@gobject@/: a t'GI.GObject.Objects.Object.Object'
    -> T.Text
    -- ^ /@actionName@/: the name of the action
    -> Word32
    -- ^ /@keyVal@/: the key symbol
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: bitmask of the modifier flags
    -> Ptr ()
    -- ^ /@userData@/: data passed to the function
    -> IO Bool
    -- ^ __Returns:__ the function should return 'P.True' if the key
    --   binding has been handled, and return 'P.False' otherwise

-- | A convenience synonym for @`Nothing` :: `Maybe` `BindingActionFunc_WithClosures`@.
noBindingActionFunc_WithClosures :: Maybe BindingActionFunc_WithClosures
noBindingActionFunc_WithClosures :: Maybe BindingActionFunc_WithClosures
noBindingActionFunc_WithClosures = Maybe BindingActionFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_BindingActionFunc :: BindingActionFunc -> BindingActionFunc_WithClosures
drop_closures_BindingActionFunc :: BindingActionFunc -> BindingActionFunc_WithClosures
drop_closures_BindingActionFunc BindingActionFunc
_f Object
gobject Text
actionName Word32
keyVal [ModifierType]
modifiers Ptr ()
_ = BindingActionFunc
_f Object
gobject Text
actionName Word32
keyVal [ModifierType]
modifiers

-- | Wrap the callback into a `GClosure`.
genClosure_BindingActionFunc :: MonadIO m => BindingActionFunc -> m (GClosure C_BindingActionFunc)
genClosure_BindingActionFunc :: forall (m :: * -> *).
MonadIO m =>
BindingActionFunc -> m (GClosure C_BindingActionFunc)
genClosure_BindingActionFunc BindingActionFunc
cb = IO (GClosure C_BindingActionFunc)
-> m (GClosure C_BindingActionFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BindingActionFunc)
 -> m (GClosure C_BindingActionFunc))
-> IO (GClosure C_BindingActionFunc)
-> m (GClosure C_BindingActionFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: BindingActionFunc_WithClosures
cb' = BindingActionFunc -> BindingActionFunc_WithClosures
drop_closures_BindingActionFunc BindingActionFunc
cb
    let cb'' :: C_BindingActionFunc
cb'' = Maybe (Ptr (FunPtr C_BindingActionFunc))
-> BindingActionFunc_WithClosures -> C_BindingActionFunc
wrap_BindingActionFunc Maybe (Ptr (FunPtr C_BindingActionFunc))
forall a. Maybe a
Nothing BindingActionFunc_WithClosures
cb'
    C_BindingActionFunc -> IO (FunPtr C_BindingActionFunc)
mk_BindingActionFunc C_BindingActionFunc
cb'' IO (FunPtr C_BindingActionFunc)
-> (FunPtr C_BindingActionFunc
    -> IO (GClosure C_BindingActionFunc))
-> IO (GClosure C_BindingActionFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BindingActionFunc -> IO (GClosure C_BindingActionFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BindingActionFunc` into a `C_BindingActionFunc`.
wrap_BindingActionFunc :: 
    Maybe (Ptr (FunPtr C_BindingActionFunc)) ->
    BindingActionFunc_WithClosures ->
    C_BindingActionFunc
wrap_BindingActionFunc :: Maybe (Ptr (FunPtr C_BindingActionFunc))
-> BindingActionFunc_WithClosures -> C_BindingActionFunc
wrap_BindingActionFunc Maybe (Ptr (FunPtr C_BindingActionFunc))
gi'funptrptr BindingActionFunc_WithClosures
gi'cb Ptr Object
gobject CString
actionName Word32
keyVal CUInt
modifiers Ptr ()
userData = do
    Object
gobject' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
gobject
    Text
actionName' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
actionName
    let modifiers' :: [ModifierType]
modifiers' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
modifiers
    Bool
result <- BindingActionFunc_WithClosures
gi'cb  Object
gobject' Text
actionName' Word32
keyVal [ModifierType]
modifiers' Ptr ()
userData
    Maybe (Ptr (FunPtr C_BindingActionFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_BindingActionFunc))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback BehaviourForeachFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "behaviour"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Behaviour" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #ClutterBehaviour"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "actor"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Actor" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "an actor driven by @behaviour"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "optional data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "1.6"
          , deprecationMessage = Nothing
          }
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "This function is passed to clutter_behaviour_actors_foreach() and\nwill be called for each actor driven by @behaviour."
        , sinceVersion = Just "0.2"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_BehaviourForeachFunc =
    Ptr Clutter.Behaviour.Behaviour ->
    Ptr Clutter.Actor.Actor ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "behaviour"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Behaviour" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterBehaviour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actor"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an actor driven by @behaviour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_BehaviourForeachFunc :: FunPtr C_BehaviourForeachFunc -> C_BehaviourForeachFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_BehaviourForeachFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Behaviour.IsBehaviour a, Clutter.Actor.IsActor b) =>
    FunPtr C_BehaviourForeachFunc
    -> a
    -- ^ /@behaviour@/: the t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> b
    -- ^ /@actor@/: an actor driven by /@behaviour@/
    -> Ptr ()
    -- ^ /@data@/: optional data passed to the function
    -> m ()
dynamic_BehaviourForeachFunc :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBehaviour a, IsActor b) =>
FunPtr C_BehaviourForeachFunc -> a -> b -> Ptr () -> m ()
dynamic_BehaviourForeachFunc FunPtr C_BehaviourForeachFunc
__funPtr a
behaviour b
actor Ptr ()
data_ = 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 Behaviour
behaviour' <- a -> IO (Ptr Behaviour)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
behaviour
    Ptr Actor
actor' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
actor
    (FunPtr C_BehaviourForeachFunc -> C_BehaviourForeachFunc
__dynamic_C_BehaviourForeachFunc FunPtr C_BehaviourForeachFunc
__funPtr) Ptr Behaviour
behaviour' Ptr Actor
actor' Ptr ()
data_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
behaviour
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
actor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

{-# DEPRECATED BehaviourForeachFunc ["(Since version 1.6)"] #-}
-- | This function is passed to 'GI.Clutter.Objects.Behaviour.behaviourActorsForeach' and
-- will be called for each actor driven by /@behaviour@/.
-- 
-- /Since: 0.2/
type BehaviourForeachFunc =
    Clutter.Behaviour.Behaviour
    -- ^ /@behaviour@/: the t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> Clutter.Actor.Actor
    -- ^ /@actor@/: an actor driven by /@behaviour@/
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BehaviourForeachFunc`@.
noBehaviourForeachFunc :: Maybe BehaviourForeachFunc
noBehaviourForeachFunc :: Maybe BehaviourForeachFunc
noBehaviourForeachFunc = Maybe BehaviourForeachFunc
forall a. Maybe a
Nothing

-- | This function is passed to 'GI.Clutter.Objects.Behaviour.behaviourActorsForeach' and
-- will be called for each actor driven by /@behaviour@/.
-- 
-- /Since: 0.2/
type BehaviourForeachFunc_WithClosures =
    Clutter.Behaviour.Behaviour
    -- ^ /@behaviour@/: the t'GI.Clutter.Objects.Behaviour.Behaviour'
    -> Clutter.Actor.Actor
    -- ^ /@actor@/: an actor driven by /@behaviour@/
    -> Ptr ()
    -- ^ /@data@/: optional data passed to the function
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `BehaviourForeachFunc_WithClosures`@.
noBehaviourForeachFunc_WithClosures :: Maybe BehaviourForeachFunc_WithClosures
noBehaviourForeachFunc_WithClosures :: Maybe BehaviourForeachFunc_WithClosures
noBehaviourForeachFunc_WithClosures = Maybe BehaviourForeachFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_BehaviourForeachFunc :: BehaviourForeachFunc -> BehaviourForeachFunc_WithClosures
drop_closures_BehaviourForeachFunc :: BehaviourForeachFunc -> BehaviourForeachFunc_WithClosures
drop_closures_BehaviourForeachFunc BehaviourForeachFunc
_f Behaviour
behaviour Actor
actor Ptr ()
_ = BehaviourForeachFunc
_f Behaviour
behaviour Actor
actor

-- | Wrap the callback into a `GClosure`.
genClosure_BehaviourForeachFunc :: MonadIO m => BehaviourForeachFunc -> m (GClosure C_BehaviourForeachFunc)
genClosure_BehaviourForeachFunc :: forall (m :: * -> *).
MonadIO m =>
BehaviourForeachFunc -> m (GClosure C_BehaviourForeachFunc)
genClosure_BehaviourForeachFunc BehaviourForeachFunc
cb = IO (GClosure C_BehaviourForeachFunc)
-> m (GClosure C_BehaviourForeachFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_BehaviourForeachFunc)
 -> m (GClosure C_BehaviourForeachFunc))
-> IO (GClosure C_BehaviourForeachFunc)
-> m (GClosure C_BehaviourForeachFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: BehaviourForeachFunc_WithClosures
cb' = BehaviourForeachFunc -> BehaviourForeachFunc_WithClosures
drop_closures_BehaviourForeachFunc BehaviourForeachFunc
cb
    let cb'' :: C_BehaviourForeachFunc
cb'' = Maybe (Ptr (FunPtr C_BehaviourForeachFunc))
-> BehaviourForeachFunc_WithClosures -> C_BehaviourForeachFunc
wrap_BehaviourForeachFunc Maybe (Ptr (FunPtr C_BehaviourForeachFunc))
forall a. Maybe a
Nothing BehaviourForeachFunc_WithClosures
cb'
    C_BehaviourForeachFunc -> IO (FunPtr C_BehaviourForeachFunc)
mk_BehaviourForeachFunc C_BehaviourForeachFunc
cb'' IO (FunPtr C_BehaviourForeachFunc)
-> (FunPtr C_BehaviourForeachFunc
    -> IO (GClosure C_BehaviourForeachFunc))
-> IO (GClosure C_BehaviourForeachFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_BehaviourForeachFunc
-> IO (GClosure C_BehaviourForeachFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `BehaviourForeachFunc` into a `C_BehaviourForeachFunc`.
wrap_BehaviourForeachFunc :: 
    Maybe (Ptr (FunPtr C_BehaviourForeachFunc)) ->
    BehaviourForeachFunc_WithClosures ->
    C_BehaviourForeachFunc
wrap_BehaviourForeachFunc :: Maybe (Ptr (FunPtr C_BehaviourForeachFunc))
-> BehaviourForeachFunc_WithClosures -> C_BehaviourForeachFunc
wrap_BehaviourForeachFunc Maybe (Ptr (FunPtr C_BehaviourForeachFunc))
gi'funptrptr BehaviourForeachFunc_WithClosures
gi'cb Ptr Behaviour
behaviour Ptr Actor
actor Ptr ()
data_ = do
    Behaviour
behaviour' <- ((ManagedPtr Behaviour -> Behaviour)
-> Ptr Behaviour -> IO Behaviour
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Behaviour -> Behaviour
Clutter.Behaviour.Behaviour) Ptr Behaviour
behaviour
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    BehaviourForeachFunc_WithClosures
gi'cb  Behaviour
behaviour' Actor
actor' Ptr ()
data_
    Maybe (Ptr (FunPtr C_BehaviourForeachFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_BehaviourForeachFunc))
gi'funptrptr


-- callback AlphaFunc
{- Callable
  { returnType = Just (TBasicType TDouble)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText = Just "a floating point value"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "alpha"
          , argType =
              TInterface Name { namespace = "Clutter" , name = "Alpha" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #ClutterAlpha" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "user data passed to the function"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "1.12"
          , deprecationMessage =
              Just "Use #ClutterTimelineProgressFunc instead."
          }
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "A function returning a value depending on the position of\nthe #ClutterTimeline bound to @alpha."
        , sinceVersion = Just "0.2"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AlphaFunc =
    Ptr Clutter.Alpha.Alpha ->
    Ptr () ->
    IO CDouble

-- Args: [ Arg
--           { argCName = "alpha"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Alpha" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterAlpha" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AlphaFunc :: FunPtr C_AlphaFunc -> C_AlphaFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AlphaFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Alpha.IsAlpha a) =>
    FunPtr C_AlphaFunc
    -> a
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha'
    -> Ptr ()
    -- ^ /@userData@/: user data passed to the function
    -> m Double
    -- ^ __Returns:__ a floating point value
dynamic_AlphaFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlpha a) =>
FunPtr C_AlphaFunc -> a -> Ptr () -> m Double
dynamic_AlphaFunc FunPtr C_AlphaFunc
__funPtr a
alpha Ptr ()
userData = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Alpha
alpha' <- a -> IO (Ptr Alpha)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
alpha
    CDouble
result <- (FunPtr C_AlphaFunc -> C_AlphaFunc
__dynamic_C_AlphaFunc FunPtr C_AlphaFunc
__funPtr) Ptr Alpha
alpha' Ptr ()
userData
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
alpha
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

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

{-# DEPRECATED AlphaFunc ["(Since version 1.12)","Use t'GI.Clutter.Callbacks.TimelineProgressFunc' instead."] #-}
-- | A function returning a value depending on the position of
-- the t'GI.Clutter.Objects.Timeline.Timeline' bound to /@alpha@/.
-- 
-- /Since: 0.2/
type AlphaFunc =
    Clutter.Alpha.Alpha
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha'
    -> IO Double
    -- ^ __Returns:__ a floating point value

-- | A convenience synonym for @`Nothing` :: `Maybe` `AlphaFunc`@.
noAlphaFunc :: Maybe AlphaFunc
noAlphaFunc :: Maybe AlphaFunc
noAlphaFunc = Maybe AlphaFunc
forall a. Maybe a
Nothing

-- | A function returning a value depending on the position of
-- the t'GI.Clutter.Objects.Timeline.Timeline' bound to /@alpha@/.
-- 
-- /Since: 0.2/
type AlphaFunc_WithClosures =
    Clutter.Alpha.Alpha
    -- ^ /@alpha@/: a t'GI.Clutter.Objects.Alpha.Alpha'
    -> Ptr ()
    -- ^ /@userData@/: user data passed to the function
    -> IO Double
    -- ^ __Returns:__ a floating point value

-- | A convenience synonym for @`Nothing` :: `Maybe` `AlphaFunc_WithClosures`@.
noAlphaFunc_WithClosures :: Maybe AlphaFunc_WithClosures
noAlphaFunc_WithClosures :: Maybe AlphaFunc_WithClosures
noAlphaFunc_WithClosures = Maybe AlphaFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AlphaFunc :: AlphaFunc -> AlphaFunc_WithClosures
drop_closures_AlphaFunc :: AlphaFunc -> AlphaFunc_WithClosures
drop_closures_AlphaFunc AlphaFunc
_f Alpha
alpha Ptr ()
_ = AlphaFunc
_f Alpha
alpha

-- | Wrap the callback into a `GClosure`.
genClosure_AlphaFunc :: MonadIO m => AlphaFunc -> m (GClosure C_AlphaFunc)
genClosure_AlphaFunc :: forall (m :: * -> *).
MonadIO m =>
AlphaFunc -> m (GClosure C_AlphaFunc)
genClosure_AlphaFunc AlphaFunc
cb = IO (GClosure C_AlphaFunc) -> m (GClosure C_AlphaFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AlphaFunc) -> m (GClosure C_AlphaFunc))
-> IO (GClosure C_AlphaFunc) -> m (GClosure C_AlphaFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: AlphaFunc_WithClosures
cb' = AlphaFunc -> AlphaFunc_WithClosures
drop_closures_AlphaFunc AlphaFunc
cb
    let cb'' :: C_AlphaFunc
cb'' = Maybe (Ptr (FunPtr C_AlphaFunc))
-> AlphaFunc_WithClosures -> C_AlphaFunc
wrap_AlphaFunc Maybe (Ptr (FunPtr C_AlphaFunc))
forall a. Maybe a
Nothing AlphaFunc_WithClosures
cb'
    C_AlphaFunc -> IO (FunPtr C_AlphaFunc)
mk_AlphaFunc C_AlphaFunc
cb'' IO (FunPtr C_AlphaFunc)
-> (FunPtr C_AlphaFunc -> IO (GClosure C_AlphaFunc))
-> IO (GClosure C_AlphaFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AlphaFunc -> IO (GClosure C_AlphaFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AlphaFunc` into a `C_AlphaFunc`.
wrap_AlphaFunc :: 
    Maybe (Ptr (FunPtr C_AlphaFunc)) ->
    AlphaFunc_WithClosures ->
    C_AlphaFunc
wrap_AlphaFunc :: Maybe (Ptr (FunPtr C_AlphaFunc))
-> AlphaFunc_WithClosures -> C_AlphaFunc
wrap_AlphaFunc Maybe (Ptr (FunPtr C_AlphaFunc))
gi'funptrptr AlphaFunc_WithClosures
gi'cb Ptr Alpha
alpha Ptr ()
userData = do
    Alpha
alpha' <- ((ManagedPtr Alpha -> Alpha) -> Ptr Alpha -> IO Alpha
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Alpha -> Alpha
Clutter.Alpha.Alpha) Ptr Alpha
alpha
    Double
result <- AlphaFunc_WithClosures
gi'cb  Alpha
alpha' Ptr ()
userData
    Maybe (Ptr (FunPtr C_AlphaFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_AlphaFunc))
gi'funptrptr
    let result' :: CDouble
result' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
result
    CDouble -> IO CDouble
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CDouble
result'


-- callback ActorCreateChildFunc
{- Callable
  { returnType =
      Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
  , returnMayBeNull = False
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText = Just "The newly created child #ClutterActor"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "item"
          , argType =
              TInterface Name { namespace = "GObject" , name = "Object" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the item in the model"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "Data passed to clutter_actor_bind_model()"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Creates a #ClutterActor using the @item in the model.\n\nThe usual way to implement this function is to create a #ClutterActor\ninstance and then bind the #GObject properties to the actor properties\nof interest, using g_object_bind_property(). This way, when the @item\nin the #GListModel changes, the #ClutterActor changes as well."
        , sinceVersion = Just "1.24"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ActorCreateChildFunc =
    Ptr GObject.Object.Object ->
    Ptr () ->
    IO (Ptr Clutter.Actor.Actor)

-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the item in the model"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data passed to clutter_actor_bind_model()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ActorCreateChildFunc :: FunPtr C_ActorCreateChildFunc -> C_ActorCreateChildFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ActorCreateChildFunc ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    FunPtr C_ActorCreateChildFunc
    -> a
    -- ^ /@item@/: the item in the model
    -> Ptr ()
    -- ^ /@userData@/: Data passed to 'GI.Clutter.Objects.Actor.actorBindModel'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ The newly created child t'GI.Clutter.Objects.Actor.Actor'
dynamic_ActorCreateChildFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
FunPtr C_ActorCreateChildFunc -> a -> Ptr () -> m Actor
dynamic_ActorCreateChildFunc FunPtr C_ActorCreateChildFunc
__funPtr a
item Ptr ()
userData = IO Actor -> m Actor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
item' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
item
    Ptr Actor
result <- (FunPtr C_ActorCreateChildFunc -> C_ActorCreateChildFunc
__dynamic_C_ActorCreateChildFunc FunPtr C_ActorCreateChildFunc
__funPtr) Ptr Object
item' Ptr ()
userData
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"actorCreateChildFunc" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
item
    Actor -> IO Actor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

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

-- | Creates a t'GI.Clutter.Objects.Actor.Actor' using the /@item@/ in the model.
-- 
-- The usual way to implement this function is to create a t'GI.Clutter.Objects.Actor.Actor'
-- instance and then bind the t'GI.GObject.Objects.Object.Object' properties to the actor properties
-- of interest, using 'GI.GObject.Objects.Object.objectBindProperty'. This way, when the /@item@/
-- in the t'GI.Gio.Interfaces.ListModel.ListModel' changes, the t'GI.Clutter.Objects.Actor.Actor' changes as well.
-- 
-- /Since: 1.24/
type ActorCreateChildFunc =
    GObject.Object.Object
    -- ^ /@item@/: the item in the model
    -> IO Clutter.Actor.Actor
    -- ^ __Returns:__ The newly created child t'GI.Clutter.Objects.Actor.Actor'

-- | A convenience synonym for @`Nothing` :: `Maybe` `ActorCreateChildFunc`@.
noActorCreateChildFunc :: Maybe ActorCreateChildFunc
noActorCreateChildFunc :: Maybe ActorCreateChildFunc
noActorCreateChildFunc = Maybe ActorCreateChildFunc
forall a. Maybe a
Nothing

-- | Creates a t'GI.Clutter.Objects.Actor.Actor' using the /@item@/ in the model.
-- 
-- The usual way to implement this function is to create a t'GI.Clutter.Objects.Actor.Actor'
-- instance and then bind the t'GI.GObject.Objects.Object.Object' properties to the actor properties
-- of interest, using 'GI.GObject.Objects.Object.objectBindProperty'. This way, when the /@item@/
-- in the t'GI.Gio.Interfaces.ListModel.ListModel' changes, the t'GI.Clutter.Objects.Actor.Actor' changes as well.
-- 
-- /Since: 1.24/
type ActorCreateChildFunc_WithClosures =
    GObject.Object.Object
    -- ^ /@item@/: the item in the model
    -> Ptr ()
    -- ^ /@userData@/: Data passed to 'GI.Clutter.Objects.Actor.actorBindModel'
    -> IO Clutter.Actor.Actor
    -- ^ __Returns:__ The newly created child t'GI.Clutter.Objects.Actor.Actor'

-- | A convenience synonym for @`Nothing` :: `Maybe` `ActorCreateChildFunc_WithClosures`@.
noActorCreateChildFunc_WithClosures :: Maybe ActorCreateChildFunc_WithClosures
noActorCreateChildFunc_WithClosures :: Maybe ActorCreateChildFunc_WithClosures
noActorCreateChildFunc_WithClosures = Maybe ActorCreateChildFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ActorCreateChildFunc :: ActorCreateChildFunc -> ActorCreateChildFunc_WithClosures
drop_closures_ActorCreateChildFunc :: ActorCreateChildFunc -> ActorCreateChildFunc_WithClosures
drop_closures_ActorCreateChildFunc ActorCreateChildFunc
_f Object
item Ptr ()
_ = ActorCreateChildFunc
_f Object
item

-- | Wrap the callback into a `GClosure`.
genClosure_ActorCreateChildFunc :: MonadIO m => ActorCreateChildFunc -> m (GClosure C_ActorCreateChildFunc)
genClosure_ActorCreateChildFunc :: forall (m :: * -> *).
MonadIO m =>
ActorCreateChildFunc -> m (GClosure C_ActorCreateChildFunc)
genClosure_ActorCreateChildFunc ActorCreateChildFunc
cb = IO (GClosure C_ActorCreateChildFunc)
-> m (GClosure C_ActorCreateChildFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ActorCreateChildFunc)
 -> m (GClosure C_ActorCreateChildFunc))
-> IO (GClosure C_ActorCreateChildFunc)
-> m (GClosure C_ActorCreateChildFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ActorCreateChildFunc_WithClosures
cb' = ActorCreateChildFunc -> ActorCreateChildFunc_WithClosures
drop_closures_ActorCreateChildFunc ActorCreateChildFunc
cb
    let cb'' :: C_ActorCreateChildFunc
cb'' = Maybe (Ptr (FunPtr C_ActorCreateChildFunc))
-> ActorCreateChildFunc_WithClosures -> C_ActorCreateChildFunc
wrap_ActorCreateChildFunc Maybe (Ptr (FunPtr C_ActorCreateChildFunc))
forall a. Maybe a
Nothing ActorCreateChildFunc_WithClosures
cb'
    C_ActorCreateChildFunc -> IO (FunPtr C_ActorCreateChildFunc)
mk_ActorCreateChildFunc C_ActorCreateChildFunc
cb'' IO (FunPtr C_ActorCreateChildFunc)
-> (FunPtr C_ActorCreateChildFunc
    -> IO (GClosure C_ActorCreateChildFunc))
-> IO (GClosure C_ActorCreateChildFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ActorCreateChildFunc
-> IO (GClosure C_ActorCreateChildFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ActorCreateChildFunc` into a `C_ActorCreateChildFunc`.
wrap_ActorCreateChildFunc :: 
    Maybe (Ptr (FunPtr C_ActorCreateChildFunc)) ->
    ActorCreateChildFunc_WithClosures ->
    C_ActorCreateChildFunc
wrap_ActorCreateChildFunc :: Maybe (Ptr (FunPtr C_ActorCreateChildFunc))
-> ActorCreateChildFunc_WithClosures -> C_ActorCreateChildFunc
wrap_ActorCreateChildFunc Maybe (Ptr (FunPtr C_ActorCreateChildFunc))
gi'funptrptr ActorCreateChildFunc_WithClosures
gi'cb Ptr Object
item Ptr ()
userData = do
    Object
item' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
item
    Actor
result <- ActorCreateChildFunc_WithClosures
gi'cb  Object
item' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ActorCreateChildFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ActorCreateChildFunc))
gi'funptrptr
    Ptr Actor
result' <- Actor -> IO (Ptr Actor)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject Actor
result
    Ptr Actor -> IO (Ptr Actor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
result'