-- | 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.Handy.Callbacks
    ( 

 -- * Signals


-- ** AvatarImageLoadFunc #signal:AvatarImageLoadFunc#

    AvatarImageLoadFunc                     ,
    AvatarImageLoadFunc_WithClosures        ,
    C_AvatarImageLoadFunc                   ,
    drop_closures_AvatarImageLoadFunc       ,
    dynamic_AvatarImageLoadFunc             ,
    genClosure_AvatarImageLoadFunc          ,
    mk_AvatarImageLoadFunc                  ,
    noAvatarImageLoadFunc                   ,
    noAvatarImageLoadFunc_WithClosures      ,
    wrap_AvatarImageLoadFunc                ,


-- ** ComboRowGetEnumValueNameFunc #signal:ComboRowGetEnumValueNameFunc#

    C_ComboRowGetEnumValueNameFunc          ,
    ComboRowGetEnumValueNameFunc            ,
    ComboRowGetEnumValueNameFunc_WithClosures,
    drop_closures_ComboRowGetEnumValueNameFunc,
    dynamic_ComboRowGetEnumValueNameFunc    ,
    genClosure_ComboRowGetEnumValueNameFunc ,
    mk_ComboRowGetEnumValueNameFunc         ,
    noComboRowGetEnumValueNameFunc          ,
    noComboRowGetEnumValueNameFunc_WithClosures,
    wrap_ComboRowGetEnumValueNameFunc       ,


-- ** ComboRowGetNameFunc #signal:ComboRowGetNameFunc#

    C_ComboRowGetNameFunc                   ,
    ComboRowGetNameFunc                     ,
    ComboRowGetNameFunc_WithClosures        ,
    drop_closures_ComboRowGetNameFunc       ,
    dynamic_ComboRowGetNameFunc             ,
    genClosure_ComboRowGetNameFunc          ,
    mk_ComboRowGetNameFunc                  ,
    noComboRowGetNameFunc                   ,
    noComboRowGetNameFunc_WithClosures      ,
    wrap_ComboRowGetNameFunc                ,




    ) 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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import {-# SOURCE #-} qualified GI.Handy.Objects.EnumValueObject as Handy.EnumValueObject

-- callback ComboRowGetNameFunc
{- Callable
  { returnType = Just (TBasicType TUTF8)
  , returnMayBeNull = False
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "a newly allocated displayable name that represents @item"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "item"
          , argType =
              TInterface Name { namespace = "GObject" , name = "Object" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the item from the model from which to get a name"
                , 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" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Called for combo rows that are bound to a #GListModel with\nhdy_combo_row_bind_name_model() for each item that gets added to the model."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ComboRowGetNameFunc =
    Ptr GObject.Object.Object ->
    Ptr () ->
    IO CString

-- Args: [ Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the item from the model from which to get a name"
--                 , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ComboRowGetNameFunc :: FunPtr C_ComboRowGetNameFunc -> C_ComboRowGetNameFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ComboRowGetNameFunc ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    FunPtr C_ComboRowGetNameFunc
    -> a
    -- ^ /@item@/: the item from the model from which to get a name
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> m T.Text
    -- ^ __Returns:__ a newly allocated displayable name that represents /@item@/
dynamic_ComboRowGetNameFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
FunPtr C_ComboRowGetNameFunc -> a -> Ptr () -> m Text
dynamic_ComboRowGetNameFunc FunPtr C_ComboRowGetNameFunc
__funPtr a
item Ptr ()
userData = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
item' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
item
    CString
result <- (FunPtr C_ComboRowGetNameFunc -> C_ComboRowGetNameFunc
__dynamic_C_ComboRowGetNameFunc FunPtr C_ComboRowGetNameFunc
__funPtr) Ptr Object
item' Ptr ()
userData
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"comboRowGetNameFunc" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
item
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

-- | Called for combo rows that are bound to a t'GI.Gio.Interfaces.ListModel.ListModel' with
-- 'GI.Handy.Objects.ComboRow.comboRowBindNameModel' for each item that gets added to the model.
type ComboRowGetNameFunc =
    GObject.Object.Object
    -- ^ /@item@/: the item from the model from which to get a name
    -> IO T.Text
    -- ^ __Returns:__ a newly allocated displayable name that represents /@item@/

-- | A convenience synonym for @`Nothing` :: `Maybe` `ComboRowGetNameFunc`@.
noComboRowGetNameFunc :: Maybe ComboRowGetNameFunc
noComboRowGetNameFunc :: Maybe ComboRowGetNameFunc
noComboRowGetNameFunc = Maybe ComboRowGetNameFunc
forall a. Maybe a
Nothing

-- | Called for combo rows that are bound to a t'GI.Gio.Interfaces.ListModel.ListModel' with
-- 'GI.Handy.Objects.ComboRow.comboRowBindNameModel' for each item that gets added to the model.
type ComboRowGetNameFunc_WithClosures =
    GObject.Object.Object
    -- ^ /@item@/: the item from the model from which to get a name
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> IO T.Text
    -- ^ __Returns:__ a newly allocated displayable name that represents /@item@/

-- | A convenience synonym for @`Nothing` :: `Maybe` `ComboRowGetNameFunc_WithClosures`@.
noComboRowGetNameFunc_WithClosures :: Maybe ComboRowGetNameFunc_WithClosures
noComboRowGetNameFunc_WithClosures :: Maybe ComboRowGetNameFunc_WithClosures
noComboRowGetNameFunc_WithClosures = Maybe ComboRowGetNameFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ComboRowGetNameFunc :: ComboRowGetNameFunc -> ComboRowGetNameFunc_WithClosures
drop_closures_ComboRowGetNameFunc :: ComboRowGetNameFunc -> ComboRowGetNameFunc_WithClosures
drop_closures_ComboRowGetNameFunc ComboRowGetNameFunc
_f Object
item Ptr ()
_ = ComboRowGetNameFunc
_f Object
item

-- | Wrap the callback into a `GClosure`.
genClosure_ComboRowGetNameFunc :: MonadIO m => ComboRowGetNameFunc -> m (GClosure C_ComboRowGetNameFunc)
genClosure_ComboRowGetNameFunc :: forall (m :: * -> *).
MonadIO m =>
ComboRowGetNameFunc -> m (GClosure C_ComboRowGetNameFunc)
genClosure_ComboRowGetNameFunc ComboRowGetNameFunc
cb = IO (GClosure C_ComboRowGetNameFunc)
-> m (GClosure C_ComboRowGetNameFunc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ComboRowGetNameFunc)
 -> m (GClosure C_ComboRowGetNameFunc))
-> IO (GClosure C_ComboRowGetNameFunc)
-> m (GClosure C_ComboRowGetNameFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ComboRowGetNameFunc_WithClosures
cb' = ComboRowGetNameFunc -> ComboRowGetNameFunc_WithClosures
drop_closures_ComboRowGetNameFunc ComboRowGetNameFunc
cb
    let cb'' :: C_ComboRowGetNameFunc
cb'' = Maybe (Ptr (FunPtr C_ComboRowGetNameFunc))
-> ComboRowGetNameFunc_WithClosures -> C_ComboRowGetNameFunc
wrap_ComboRowGetNameFunc Maybe (Ptr (FunPtr C_ComboRowGetNameFunc))
forall a. Maybe a
Nothing ComboRowGetNameFunc_WithClosures
cb'
    C_ComboRowGetNameFunc -> IO (FunPtr C_ComboRowGetNameFunc)
mk_ComboRowGetNameFunc C_ComboRowGetNameFunc
cb'' IO (FunPtr C_ComboRowGetNameFunc)
-> (FunPtr C_ComboRowGetNameFunc
    -> IO (GClosure C_ComboRowGetNameFunc))
-> IO (GClosure C_ComboRowGetNameFunc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ComboRowGetNameFunc -> IO (GClosure C_ComboRowGetNameFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ComboRowGetNameFunc` into a `C_ComboRowGetNameFunc`.
wrap_ComboRowGetNameFunc :: 
    Maybe (Ptr (FunPtr C_ComboRowGetNameFunc)) ->
    ComboRowGetNameFunc_WithClosures ->
    C_ComboRowGetNameFunc
wrap_ComboRowGetNameFunc :: Maybe (Ptr (FunPtr C_ComboRowGetNameFunc))
-> ComboRowGetNameFunc_WithClosures -> C_ComboRowGetNameFunc
wrap_ComboRowGetNameFunc Maybe (Ptr (FunPtr C_ComboRowGetNameFunc))
gi'funptrptr ComboRowGetNameFunc_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
    Text
result <- ComboRowGetNameFunc_WithClosures
gi'cb  Object
item' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ComboRowGetNameFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ComboRowGetNameFunc))
gi'funptrptr
    CString
result' <- Text -> IO CString
textToCString Text
result
    CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result'


-- callback ComboRowGetEnumValueNameFunc
{- Callable
  { returnType = Just (TBasicType TUTF8)
  , returnMayBeNull = False
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "a newly allocated displayable name that represents @value"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "value"
          , argType =
              TInterface Name { namespace = "Handy" , name = "EnumValueObject" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the value from the enum from which to get a name"
                , 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" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Called for combo rows that are bound to an enumeration with\nhdy_combo_row_set_for_enum() for each value from that enumeration."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ComboRowGetEnumValueNameFunc =
    Ptr Handy.EnumValueObject.EnumValueObject ->
    Ptr () ->
    IO CString

-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "EnumValueObject" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the value from the enum from which to get a name"
--                 , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ComboRowGetEnumValueNameFunc :: FunPtr C_ComboRowGetEnumValueNameFunc -> C_ComboRowGetEnumValueNameFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ComboRowGetEnumValueNameFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Handy.EnumValueObject.IsEnumValueObject a) =>
    FunPtr C_ComboRowGetEnumValueNameFunc
    -> a
    -- ^ /@value@/: the value from the enum from which to get a name
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> m T.Text
    -- ^ __Returns:__ a newly allocated displayable name that represents /@value@/
dynamic_ComboRowGetEnumValueNameFunc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEnumValueObject a) =>
FunPtr C_ComboRowGetEnumValueNameFunc -> a -> Ptr () -> m Text
dynamic_ComboRowGetEnumValueNameFunc FunPtr C_ComboRowGetEnumValueNameFunc
__funPtr a
value Ptr ()
userData = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr EnumValueObject
value' <- a -> IO (Ptr EnumValueObject)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
result <- (FunPtr C_ComboRowGetEnumValueNameFunc
-> C_ComboRowGetEnumValueNameFunc
__dynamic_C_ComboRowGetEnumValueNameFunc FunPtr C_ComboRowGetEnumValueNameFunc
__funPtr) Ptr EnumValueObject
value' Ptr ()
userData
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"comboRowGetEnumValueNameFunc" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

-- | Called for combo rows that are bound to an enumeration with
-- 'GI.Handy.Objects.ComboRow.comboRowSetForEnum' for each value from that enumeration.
type ComboRowGetEnumValueNameFunc =
    Handy.EnumValueObject.EnumValueObject
    -- ^ /@value@/: the value from the enum from which to get a name
    -> IO T.Text
    -- ^ __Returns:__ a newly allocated displayable name that represents /@value@/

-- | A convenience synonym for @`Nothing` :: `Maybe` `ComboRowGetEnumValueNameFunc`@.
noComboRowGetEnumValueNameFunc :: Maybe ComboRowGetEnumValueNameFunc
noComboRowGetEnumValueNameFunc :: Maybe ComboRowGetEnumValueNameFunc
noComboRowGetEnumValueNameFunc = Maybe ComboRowGetEnumValueNameFunc
forall a. Maybe a
Nothing

-- | Called for combo rows that are bound to an enumeration with
-- 'GI.Handy.Objects.ComboRow.comboRowSetForEnum' for each value from that enumeration.
type ComboRowGetEnumValueNameFunc_WithClosures =
    Handy.EnumValueObject.EnumValueObject
    -- ^ /@value@/: the value from the enum from which to get a name
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> IO T.Text
    -- ^ __Returns:__ a newly allocated displayable name that represents /@value@/

-- | A convenience synonym for @`Nothing` :: `Maybe` `ComboRowGetEnumValueNameFunc_WithClosures`@.
noComboRowGetEnumValueNameFunc_WithClosures :: Maybe ComboRowGetEnumValueNameFunc_WithClosures
noComboRowGetEnumValueNameFunc_WithClosures :: Maybe ComboRowGetEnumValueNameFunc_WithClosures
noComboRowGetEnumValueNameFunc_WithClosures = Maybe ComboRowGetEnumValueNameFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ComboRowGetEnumValueNameFunc :: ComboRowGetEnumValueNameFunc -> ComboRowGetEnumValueNameFunc_WithClosures
drop_closures_ComboRowGetEnumValueNameFunc :: ComboRowGetEnumValueNameFunc
-> ComboRowGetEnumValueNameFunc_WithClosures
drop_closures_ComboRowGetEnumValueNameFunc ComboRowGetEnumValueNameFunc
_f EnumValueObject
value Ptr ()
_ = ComboRowGetEnumValueNameFunc
_f EnumValueObject
value

-- | Wrap the callback into a `GClosure`.
genClosure_ComboRowGetEnumValueNameFunc :: MonadIO m => ComboRowGetEnumValueNameFunc -> m (GClosure C_ComboRowGetEnumValueNameFunc)
genClosure_ComboRowGetEnumValueNameFunc :: forall (m :: * -> *).
MonadIO m =>
ComboRowGetEnumValueNameFunc
-> m (GClosure C_ComboRowGetEnumValueNameFunc)
genClosure_ComboRowGetEnumValueNameFunc ComboRowGetEnumValueNameFunc
cb = IO (GClosure C_ComboRowGetEnumValueNameFunc)
-> m (GClosure C_ComboRowGetEnumValueNameFunc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ComboRowGetEnumValueNameFunc)
 -> m (GClosure C_ComboRowGetEnumValueNameFunc))
-> IO (GClosure C_ComboRowGetEnumValueNameFunc)
-> m (GClosure C_ComboRowGetEnumValueNameFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ComboRowGetEnumValueNameFunc_WithClosures
cb' = ComboRowGetEnumValueNameFunc
-> ComboRowGetEnumValueNameFunc_WithClosures
drop_closures_ComboRowGetEnumValueNameFunc ComboRowGetEnumValueNameFunc
cb
    let cb'' :: C_ComboRowGetEnumValueNameFunc
cb'' = Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc))
-> ComboRowGetEnumValueNameFunc_WithClosures
-> C_ComboRowGetEnumValueNameFunc
wrap_ComboRowGetEnumValueNameFunc Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc))
forall a. Maybe a
Nothing ComboRowGetEnumValueNameFunc_WithClosures
cb'
    C_ComboRowGetEnumValueNameFunc
-> IO (FunPtr C_ComboRowGetEnumValueNameFunc)
mk_ComboRowGetEnumValueNameFunc C_ComboRowGetEnumValueNameFunc
cb'' IO (FunPtr C_ComboRowGetEnumValueNameFunc)
-> (FunPtr C_ComboRowGetEnumValueNameFunc
    -> IO (GClosure C_ComboRowGetEnumValueNameFunc))
-> IO (GClosure C_ComboRowGetEnumValueNameFunc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ComboRowGetEnumValueNameFunc
-> IO (GClosure C_ComboRowGetEnumValueNameFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ComboRowGetEnumValueNameFunc` into a `C_ComboRowGetEnumValueNameFunc`.
wrap_ComboRowGetEnumValueNameFunc :: 
    Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc)) ->
    ComboRowGetEnumValueNameFunc_WithClosures ->
    C_ComboRowGetEnumValueNameFunc
wrap_ComboRowGetEnumValueNameFunc :: Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc))
-> ComboRowGetEnumValueNameFunc_WithClosures
-> C_ComboRowGetEnumValueNameFunc
wrap_ComboRowGetEnumValueNameFunc Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc))
gi'funptrptr ComboRowGetEnumValueNameFunc_WithClosures
gi'cb Ptr EnumValueObject
value Ptr ()
userData = do
    EnumValueObject
value' <- ((ManagedPtr EnumValueObject -> EnumValueObject)
-> Ptr EnumValueObject -> IO EnumValueObject
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr EnumValueObject -> EnumValueObject
Handy.EnumValueObject.EnumValueObject) Ptr EnumValueObject
value
    Text
result <- ComboRowGetEnumValueNameFunc_WithClosures
gi'cb  EnumValueObject
value' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ComboRowGetEnumValueNameFunc))
gi'funptrptr
    CString
result' <- Text -> IO CString
textToCString Text
result
    CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result'


-- callback AvatarImageLoadFunc
{- Callable
  { returnType =
      Just
        (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
  , returnMayBeNull = True
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "the #GdkPixbuf to use as a custom avatar\nor %NULL to fallback to the generated avatar."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "size"
          , argType = TBasicType TInt
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the required size of the avatar"
                , 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" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated =
      Just
        DeprecationInfo
          { deprecatedSinceVersion = Just "1.2"
          , deprecationMessage =
              Just "use hdy_avatar_set_loadable_icon() instead."
          }
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The returned #GdkPixbuf is expected to be square with width and height set\nto @size. The image is cropped to a circle without any scaling or transformation."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AvatarImageLoadFunc =
    Int32 ->
    Ptr () ->
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- Args: [ Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the required size of the avatar"
--                 , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AvatarImageLoadFunc :: FunPtr C_AvatarImageLoadFunc -> C_AvatarImageLoadFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AvatarImageLoadFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_AvatarImageLoadFunc
    -> Int32
    -- ^ /@size@/: the required size of the avatar
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ the t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' to use as a custom avatar
    -- or 'P.Nothing' to fallback to the generated avatar.
dynamic_AvatarImageLoadFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_AvatarImageLoadFunc -> Int32 -> Ptr () -> m (Maybe Pixbuf)
dynamic_AvatarImageLoadFunc FunPtr C_AvatarImageLoadFunc
__funPtr Int32
size Ptr ()
userData = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Pixbuf
result <- (FunPtr C_AvatarImageLoadFunc -> C_AvatarImageLoadFunc
__dynamic_C_AvatarImageLoadFunc FunPtr C_AvatarImageLoadFunc
__funPtr) Int32
size Ptr ()
userData
    Maybe Pixbuf
maybeResult <- Ptr Pixbuf -> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Pixbuf
result ((Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf))
-> (Ptr Pixbuf -> IO Pixbuf) -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Ptr Pixbuf
result' -> do
        Pixbuf
result'' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result'
        Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result''
    Maybe Pixbuf -> IO (Maybe Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pixbuf
maybeResult

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

{-# DEPRECATED AvatarImageLoadFunc ["(Since version 1.2)","use 'GI.Handy.Objects.Avatar.avatarSetLoadableIcon' instead."] #-}
-- | The returned t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' is expected to be square with width and height set
-- to /@size@/. The image is cropped to a circle without any scaling or transformation.
type AvatarImageLoadFunc =
    Int32
    -- ^ /@size@/: the required size of the avatar
    -> IO (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ the t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' to use as a custom avatar
    -- or 'P.Nothing' to fallback to the generated avatar.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AvatarImageLoadFunc`@.
noAvatarImageLoadFunc :: Maybe AvatarImageLoadFunc
noAvatarImageLoadFunc :: Maybe AvatarImageLoadFunc
noAvatarImageLoadFunc = Maybe AvatarImageLoadFunc
forall a. Maybe a
Nothing

-- | The returned t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' is expected to be square with width and height set
-- to /@size@/. The image is cropped to a circle without any scaling or transformation.
type AvatarImageLoadFunc_WithClosures =
    Int32
    -- ^ /@size@/: the required size of the avatar
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> IO (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    -- ^ __Returns:__ the t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf' to use as a custom avatar
    -- or 'P.Nothing' to fallback to the generated avatar.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AvatarImageLoadFunc_WithClosures`@.
noAvatarImageLoadFunc_WithClosures :: Maybe AvatarImageLoadFunc_WithClosures
noAvatarImageLoadFunc_WithClosures :: Maybe AvatarImageLoadFunc_WithClosures
noAvatarImageLoadFunc_WithClosures = Maybe AvatarImageLoadFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AvatarImageLoadFunc :: AvatarImageLoadFunc -> AvatarImageLoadFunc_WithClosures
drop_closures_AvatarImageLoadFunc :: AvatarImageLoadFunc -> AvatarImageLoadFunc_WithClosures
drop_closures_AvatarImageLoadFunc AvatarImageLoadFunc
_f Int32
size Ptr ()
_ = AvatarImageLoadFunc
_f Int32
size

-- | Wrap the callback into a `GClosure`.
genClosure_AvatarImageLoadFunc :: MonadIO m => AvatarImageLoadFunc -> m (GClosure C_AvatarImageLoadFunc)
genClosure_AvatarImageLoadFunc :: forall (m :: * -> *).
MonadIO m =>
AvatarImageLoadFunc -> m (GClosure C_AvatarImageLoadFunc)
genClosure_AvatarImageLoadFunc AvatarImageLoadFunc
cb = IO (GClosure C_AvatarImageLoadFunc)
-> m (GClosure C_AvatarImageLoadFunc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AvatarImageLoadFunc)
 -> m (GClosure C_AvatarImageLoadFunc))
-> IO (GClosure C_AvatarImageLoadFunc)
-> m (GClosure C_AvatarImageLoadFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: AvatarImageLoadFunc_WithClosures
cb' = AvatarImageLoadFunc -> AvatarImageLoadFunc_WithClosures
drop_closures_AvatarImageLoadFunc AvatarImageLoadFunc
cb
    let cb'' :: C_AvatarImageLoadFunc
cb'' = Maybe (Ptr (FunPtr C_AvatarImageLoadFunc))
-> AvatarImageLoadFunc_WithClosures -> C_AvatarImageLoadFunc
wrap_AvatarImageLoadFunc Maybe (Ptr (FunPtr C_AvatarImageLoadFunc))
forall a. Maybe a
Nothing AvatarImageLoadFunc_WithClosures
cb'
    C_AvatarImageLoadFunc -> IO (FunPtr C_AvatarImageLoadFunc)
mk_AvatarImageLoadFunc C_AvatarImageLoadFunc
cb'' IO (FunPtr C_AvatarImageLoadFunc)
-> (FunPtr C_AvatarImageLoadFunc
    -> IO (GClosure C_AvatarImageLoadFunc))
-> IO (GClosure C_AvatarImageLoadFunc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AvatarImageLoadFunc -> IO (GClosure C_AvatarImageLoadFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AvatarImageLoadFunc` into a `C_AvatarImageLoadFunc`.
wrap_AvatarImageLoadFunc :: 
    Maybe (Ptr (FunPtr C_AvatarImageLoadFunc)) ->
    AvatarImageLoadFunc_WithClosures ->
    C_AvatarImageLoadFunc
wrap_AvatarImageLoadFunc :: Maybe (Ptr (FunPtr C_AvatarImageLoadFunc))
-> AvatarImageLoadFunc_WithClosures -> C_AvatarImageLoadFunc
wrap_AvatarImageLoadFunc Maybe (Ptr (FunPtr C_AvatarImageLoadFunc))
gi'funptrptr AvatarImageLoadFunc_WithClosures
gi'cb Int32
size Ptr ()
userData = do
    Maybe Pixbuf
result <- AvatarImageLoadFunc_WithClosures
gi'cb  Int32
size Ptr ()
userData
    Maybe (Ptr (FunPtr C_AvatarImageLoadFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_AvatarImageLoadFunc))
gi'funptrptr
    Ptr Pixbuf
-> Maybe Pixbuf -> (Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM Ptr Pixbuf
forall a. Ptr a
FP.nullPtr Maybe Pixbuf
result ((Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf))
-> (Pixbuf -> IO (Ptr Pixbuf)) -> IO (Ptr Pixbuf)
forall a b. (a -> b) -> a -> b
$ \Pixbuf
result' -> do
        Ptr Pixbuf
result'' <- Pixbuf -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject Pixbuf
result'
        Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
result''