{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)
-}

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

module GI.Vte.Callbacks
    (

 -- * Signals
-- ** SelectionFunc #signal:SelectionFunc#

    C_SelectionFunc                         ,
    SelectionFunc                           ,
    SelectionFunc_WithClosures              ,
    drop_closures_SelectionFunc             ,
    dynamic_SelectionFunc                   ,
    genClosure_SelectionFunc                ,
    mk_SelectionFunc                        ,
    noSelectionFunc                         ,
    noSelectionFunc_WithClosures            ,
    wrap_SelectionFunc                      ,


-- ** TerminalSpawnAsyncCallback #signal:TerminalSpawnAsyncCallback#

    C_TerminalSpawnAsyncCallback            ,
    TerminalSpawnAsyncCallback              ,
    TerminalSpawnAsyncCallback_WithClosures ,
    drop_closures_TerminalSpawnAsyncCallback,
    dynamic_TerminalSpawnAsyncCallback      ,
    genClosure_TerminalSpawnAsyncCallback   ,
    mk_TerminalSpawnAsyncCallback           ,
    noTerminalSpawnAsyncCallback            ,
    noTerminalSpawnAsyncCallback_WithClosures,
    wrap_TerminalSpawnAsyncCallback         ,




    ) 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.ManagedPtr as B.ManagedPtr
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.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 {-# SOURCE #-} qualified GI.Vte.Objects.Terminal as Vte.Terminal

-- callback TerminalSpawnAsyncCallback
--          -> Callable {returnType = Nothing, returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Nothing, sinceVersion = Nothing}, args = [Arg {argCName = "terminal", argType = TInterface (Name {namespace = "Vte", name = "Terminal"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #VteTerminal", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pid", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GPid", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GError, or %NULL", 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 that was passed to vte_terminal_spawn_async", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Callback for vte_terminal_spawn_async().\n\nOn success, @pid contains the PID of the spawned process, and @error\nis %NULL.\nOn failure, @pid is -1 and @error contains the error information.", sinceVersion = Just "0.48"}}
-- | Type for the callback on the (unwrapped) C side.
type C_TerminalSpawnAsyncCallback =
    Ptr Vte.Terminal.Terminal ->
    Int32 ->
    Ptr GError ->
    Ptr () ->
    IO ()

-- Args : [Arg {argCName = "terminal", argType = TInterface (Name {namespace = "Vte", name = "Terminal"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #VteTerminal", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "pid", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GPid", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "error", argType = TError, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GError, or %NULL", 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 that was passed to vte_terminal_spawn_async", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_TerminalSpawnAsyncCallback :: FunPtr C_TerminalSpawnAsyncCallback -> C_TerminalSpawnAsyncCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_TerminalSpawnAsyncCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Vte.Terminal.IsTerminal a) =>
    FunPtr C_TerminalSpawnAsyncCallback
    -> a
    {- ^ /@terminal@/: the 'GI.Vte.Objects.Terminal.Terminal' -}
    -> Int32
    {- ^ /@pid@/: a @/GPid/@ -}
    -> GError
    {- ^ /@error@/: a 'GError', or 'Nothing' -}
    -> Ptr ()
    {- ^ /@userData@/: user data that was passed to vte_terminal_spawn_async -}
    -> m ()
dynamic_TerminalSpawnAsyncCallback __funPtr terminal pid error_ userData = liftIO $ do
    terminal' <- unsafeManagedPtrCastPtr terminal
    error_' <- unsafeManagedPtrGetPtr error_
    (__dynamic_C_TerminalSpawnAsyncCallback __funPtr) terminal' pid error_' userData
    touchManagedPtr terminal
    touchManagedPtr error_
    return ()

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

{- |
Callback for @/vte_terminal_spawn_async()/@.

On success, /@pid@/ contains the PID of the spawned process, and /@error@/
is 'Nothing'.
On failure, /@pid@/ is -1 and /@error@/ contains the error information.

/Since: 0.48/
-}
type TerminalSpawnAsyncCallback =
    Vte.Terminal.Terminal
    {- ^ /@terminal@/: the 'GI.Vte.Objects.Terminal.Terminal' -}
    -> Int32
    {- ^ /@pid@/: a @/GPid/@ -}
    -> GError
    {- ^ /@error@/: a 'GError', or 'Nothing' -}
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TerminalSpawnAsyncCallback`@.
noTerminalSpawnAsyncCallback :: Maybe TerminalSpawnAsyncCallback
noTerminalSpawnAsyncCallback = Nothing

{- |
Callback for @/vte_terminal_spawn_async()/@.

On success, /@pid@/ contains the PID of the spawned process, and /@error@/
is 'Nothing'.
On failure, /@pid@/ is -1 and /@error@/ contains the error information.

/Since: 0.48/
-}
type TerminalSpawnAsyncCallback_WithClosures =
    Vte.Terminal.Terminal
    {- ^ /@terminal@/: the 'GI.Vte.Objects.Terminal.Terminal' -}
    -> Int32
    {- ^ /@pid@/: a @/GPid/@ -}
    -> GError
    {- ^ /@error@/: a 'GError', or 'Nothing' -}
    -> Ptr ()
    {- ^ /@userData@/: user data that was passed to vte_terminal_spawn_async -}
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `TerminalSpawnAsyncCallback_WithClosures`@.
noTerminalSpawnAsyncCallback_WithClosures :: Maybe TerminalSpawnAsyncCallback_WithClosures
noTerminalSpawnAsyncCallback_WithClosures = Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_TerminalSpawnAsyncCallback :: TerminalSpawnAsyncCallback -> TerminalSpawnAsyncCallback_WithClosures
drop_closures_TerminalSpawnAsyncCallback _f terminal pid error_ _ = _f terminal pid error_

-- | Wrap the callback into a `GClosure`.
genClosure_TerminalSpawnAsyncCallback :: MonadIO m => TerminalSpawnAsyncCallback -> m (GClosure C_TerminalSpawnAsyncCallback)
genClosure_TerminalSpawnAsyncCallback cb = liftIO $ do
    let cb' = drop_closures_TerminalSpawnAsyncCallback cb
    let cb'' = wrap_TerminalSpawnAsyncCallback Nothing cb'
    mk_TerminalSpawnAsyncCallback cb'' >>= B.GClosure.newGClosure


-- | Wrap a `TerminalSpawnAsyncCallback` into a `C_TerminalSpawnAsyncCallback`.
wrap_TerminalSpawnAsyncCallback ::
    Maybe (Ptr (FunPtr C_TerminalSpawnAsyncCallback)) ->
    TerminalSpawnAsyncCallback_WithClosures ->
    C_TerminalSpawnAsyncCallback
wrap_TerminalSpawnAsyncCallback funptrptr _cb terminal pid error_ userData = do
    terminal' <- (newObject Vte.Terminal.Terminal) terminal
    error_' <- (newBoxed GError) error_
    _cb  terminal' pid error_' userData
    maybeReleaseFunPtr funptrptr


-- callback SelectionFunc
--          -> Callable {returnType = Just (TBasicType TBoolean), returnMayBeNull = False, returnTransfer = TransferNothing, returnDocumentation = Documentation {rawDocText = Just "%TRUE if cell has to be selected; %FALSE if otherwise.", sinceVersion = Nothing}, args = [Arg {argCName = "terminal", argType = TInterface (Name {namespace = "Vte", name = "Terminal"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "terminal in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "column", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "column in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "row", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "row in which the cell is.", 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 = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}], skipReturn = False, callableThrows = False, callableDeprecated = Nothing, callableDocumentation = Documentation {rawDocText = Just "Specifies the type of a selection function used to check whether\na cell has to be selected or not.", sinceVersion = Nothing}}
-- | Type for the callback on the (unwrapped) C side.
type C_SelectionFunc =
    Ptr Vte.Terminal.Terminal ->
    CLong ->
    CLong ->
    Ptr () ->
    IO CInt

-- Args : [Arg {argCName = "terminal", argType = TInterface (Name {namespace = "Vte", name = "Terminal"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "terminal in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "column", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "column in which the cell is.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "row", argType = TBasicType TLong, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "row in which the cell is.", 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 = 3, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_SelectionFunc :: FunPtr C_SelectionFunc -> C_SelectionFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_SelectionFunc ::
    (B.CallStack.HasCallStack, MonadIO m, Vte.Terminal.IsTerminal a) =>
    FunPtr C_SelectionFunc
    -> a
    {- ^ /@terminal@/: terminal in which the cell is. -}
    -> CLong
    {- ^ /@column@/: column in which the cell is. -}
    -> CLong
    {- ^ /@row@/: row in which the cell is. -}
    -> Ptr ()
    {- ^ /@data@/: user data. -}
    -> m Bool
    {- ^ __Returns:__ 'True' if cell has to be selected; 'False' if otherwise. -}
dynamic_SelectionFunc __funPtr terminal column row data_ = liftIO $ do
    terminal' <- unsafeManagedPtrCastPtr terminal
    result <- (__dynamic_C_SelectionFunc __funPtr) terminal' column row data_
    let result' = (/= 0) result
    touchManagedPtr terminal
    return result'

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

{- |
Specifies the type of a selection function used to check whether
a cell has to be selected or not.
-}
type SelectionFunc =
    Vte.Terminal.Terminal
    {- ^ /@terminal@/: terminal in which the cell is. -}
    -> CLong
    {- ^ /@column@/: column in which the cell is. -}
    -> CLong
    {- ^ /@row@/: row in which the cell is. -}
    -> IO Bool
    {- ^ __Returns:__ 'True' if cell has to be selected; 'False' if otherwise. -}

-- | A convenience synonym for @`Nothing` :: `Maybe` `SelectionFunc`@.
noSelectionFunc :: Maybe SelectionFunc
noSelectionFunc = Nothing

{- |
Specifies the type of a selection function used to check whether
a cell has to be selected or not.
-}
type SelectionFunc_WithClosures =
    Vte.Terminal.Terminal
    {- ^ /@terminal@/: terminal in which the cell is. -}
    -> CLong
    {- ^ /@column@/: column in which the cell is. -}
    -> CLong
    {- ^ /@row@/: row in which the cell is. -}
    -> Ptr ()
    {- ^ /@data@/: user data. -}
    -> IO Bool
    {- ^ __Returns:__ 'True' if cell has to be selected; 'False' if otherwise. -}

-- | A convenience synonym for @`Nothing` :: `Maybe` `SelectionFunc_WithClosures`@.
noSelectionFunc_WithClosures :: Maybe SelectionFunc_WithClosures
noSelectionFunc_WithClosures = Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_SelectionFunc :: SelectionFunc -> SelectionFunc_WithClosures
drop_closures_SelectionFunc _f terminal column row _ = _f terminal column row

-- | Wrap the callback into a `GClosure`.
genClosure_SelectionFunc :: MonadIO m => SelectionFunc -> m (GClosure C_SelectionFunc)
genClosure_SelectionFunc cb = liftIO $ do
    let cb' = drop_closures_SelectionFunc cb
    let cb'' = wrap_SelectionFunc Nothing cb'
    mk_SelectionFunc cb'' >>= B.GClosure.newGClosure


-- | Wrap a `SelectionFunc` into a `C_SelectionFunc`.
wrap_SelectionFunc ::
    Maybe (Ptr (FunPtr C_SelectionFunc)) ->
    SelectionFunc_WithClosures ->
    C_SelectionFunc
wrap_SelectionFunc funptrptr _cb terminal column row data_ = do
    terminal' <- (newObject Vte.Terminal.Terminal) terminal
    result <- _cb  terminal' column row data_
    maybeReleaseFunPtr funptrptr
    let result' = (fromIntegral . fromEnum) result
    return result'