{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Vte.Objects.Pty
    ( 

-- * Exported types
    Pty(..)                                 ,
    IsPty                                   ,
    toPty                                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childSetup]("GI.Vte.Objects.Pty#g:method:childSetup"), [close]("GI.Vte.Objects.Pty#g:method:close"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [spawnAsync]("GI.Vte.Objects.Pty#g:method:spawnAsync"), [spawnFinish]("GI.Vte.Objects.Pty#g:method:spawnFinish"), [spawnWithFdsAsync]("GI.Vte.Objects.Pty#g:method:spawnWithFdsAsync"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFd]("GI.Vte.Objects.Pty#g:method:getFd"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSize]("GI.Vte.Objects.Pty#g:method:getSize").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSize]("GI.Vte.Objects.Pty#g:method:setSize"), [setUtf8]("GI.Vte.Objects.Pty#g:method:setUtf8").

#if defined(ENABLE_OVERLOADING)
    ResolvePtyMethod                        ,
#endif

-- ** childSetup #method:childSetup#

#if defined(ENABLE_OVERLOADING)
    PtyChildSetupMethodInfo                 ,
#endif
    ptyChildSetup                           ,


-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    PtyCloseMethodInfo                      ,
#endif
    ptyClose                                ,


-- ** getFd #method:getFd#

#if defined(ENABLE_OVERLOADING)
    PtyGetFdMethodInfo                      ,
#endif
    ptyGetFd                                ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    PtyGetSizeMethodInfo                    ,
#endif
    ptyGetSize                              ,


-- ** newForeignSync #method:newForeignSync#

    ptyNewForeignSync                       ,


-- ** newSync #method:newSync#

    ptyNewSync                              ,


-- ** setSize #method:setSize#

#if defined(ENABLE_OVERLOADING)
    PtySetSizeMethodInfo                    ,
#endif
    ptySetSize                              ,


-- ** setUtf8 #method:setUtf8#

#if defined(ENABLE_OVERLOADING)
    PtySetUtf8MethodInfo                    ,
#endif
    ptySetUtf8                              ,


-- ** spawnAsync #method:spawnAsync#

#if defined(ENABLE_OVERLOADING)
    PtySpawnAsyncMethodInfo                 ,
#endif
    ptySpawnAsync                           ,


-- ** spawnFinish #method:spawnFinish#

#if defined(ENABLE_OVERLOADING)
    PtySpawnFinishMethodInfo                ,
#endif
    ptySpawnFinish                          ,


-- ** spawnWithFdsAsync #method:spawnWithFdsAsync#

#if defined(ENABLE_OVERLOADING)
    PtySpawnWithFdsAsyncMethodInfo          ,
#endif
    ptySpawnWithFdsAsync                    ,




 -- * Properties


-- ** fd #attr:fd#
-- | The file descriptor of the PTY master.

#if defined(ENABLE_OVERLOADING)
    PtyFdPropertyInfo                       ,
#endif
    constructPtyFd                          ,
    getPtyFd                                ,
#if defined(ENABLE_OVERLOADING)
    ptyFd                                   ,
#endif


-- ** flags #attr:flags#
-- | Flags.

#if defined(ENABLE_OVERLOADING)
    PtyFlagsPropertyInfo                    ,
#endif
    constructPtyFlags                       ,
    getPtyFlags                             ,
#if defined(ENABLE_OVERLOADING)
    ptyFlags                                ,
#endif




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Flags as GLib.Flags
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Vte.Flags as Vte.Flags

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Flags as GLib.Flags
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Vte.Flags as Vte.Flags

#endif

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

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

foreign import ccall "vte_pty_get_type"
    c_vte_pty_get_type :: IO B.Types.GType

instance B.Types.TypedObject Pty where
    glibType :: IO GType
glibType = IO GType
c_vte_pty_get_type

instance B.Types.GObject Pty

-- | Type class for types which can be safely cast to t'Pty', for instance with `toPty`.
class (SP.GObject o, O.IsDescendantOf Pty o) => IsPty o
instance (SP.GObject o, O.IsDescendantOf Pty o) => IsPty o

instance O.HasParentTypes Pty
type instance O.ParentTypes Pty = '[GObject.Object.Object, Gio.Initable.Initable]

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

-- | Convert t'Pty' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Pty) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_vte_pty_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Pty -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Pty
P.Nothing = Ptr GValue -> Ptr Pty -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Pty
forall a. Ptr a
FP.nullPtr :: FP.Ptr Pty)
    gvalueSet_ Ptr GValue
gv (P.Just Pty
obj) = Pty -> (Ptr Pty -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Pty
obj (Ptr GValue -> Ptr Pty -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Pty)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr Pty)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Pty)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject Pty ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePtyMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePtyMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePtyMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePtyMethod "childSetup" o = PtyChildSetupMethodInfo
    ResolvePtyMethod "close" o = PtyCloseMethodInfo
    ResolvePtyMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePtyMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePtyMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePtyMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolvePtyMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePtyMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePtyMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePtyMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePtyMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePtyMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePtyMethod "spawnAsync" o = PtySpawnAsyncMethodInfo
    ResolvePtyMethod "spawnFinish" o = PtySpawnFinishMethodInfo
    ResolvePtyMethod "spawnWithFdsAsync" o = PtySpawnWithFdsAsyncMethodInfo
    ResolvePtyMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePtyMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePtyMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePtyMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePtyMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePtyMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePtyMethod "getFd" o = PtyGetFdMethodInfo
    ResolvePtyMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePtyMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePtyMethod "getSize" o = PtyGetSizeMethodInfo
    ResolvePtyMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePtyMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePtyMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePtyMethod "setSize" o = PtySetSizeMethodInfo
    ResolvePtyMethod "setUtf8" o = PtySetUtf8MethodInfo
    ResolvePtyMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePtyMethod t Pty, O.OverloadedMethod info Pty p) => OL.IsLabel t (Pty -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePtyMethod t Pty, O.OverloadedMethod info Pty p, R.HasField t Pty p) => R.HasField t Pty p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- VVV Prop "fd"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data PtyFdPropertyInfo
instance AttrInfo PtyFdPropertyInfo where
    type AttrAllowedOps PtyFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PtyFdPropertyInfo = IsPty
    type AttrSetTypeConstraint PtyFdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint PtyFdPropertyInfo = (~) Int32
    type AttrTransferType PtyFdPropertyInfo = Int32
    type AttrGetType PtyFdPropertyInfo = Int32
    type AttrLabel PtyFdPropertyInfo = "fd"
    type AttrOrigin PtyFdPropertyInfo = Pty
    attrGet = getPtyFd
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPtyFd
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.fd"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#g:attr:fd"
        })
#endif

-- VVV Prop "flags"
   -- Type: TInterface (Name {namespace = "Vte", name = "PtyFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pty #flags
-- @
getPtyFlags :: (MonadIO m, IsPty o) => o -> m [Vte.Flags.PtyFlags]
getPtyFlags :: forall (m :: * -> *) o. (MonadIO m, IsPty o) => o -> m [PtyFlags]
getPtyFlags o
obj = IO [PtyFlags] -> m [PtyFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [PtyFlags] -> m [PtyFlags]) -> IO [PtyFlags] -> m [PtyFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [PtyFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"flags"

-- | Construct a t'GValueConstruct' with valid value for the “@flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPtyFlags :: (IsPty o, MIO.MonadIO m) => [Vte.Flags.PtyFlags] -> m (GValueConstruct o)
constructPtyFlags :: forall o (m :: * -> *).
(IsPty o, MonadIO m) =>
[PtyFlags] -> m (GValueConstruct o)
constructPtyFlags [PtyFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [PtyFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"flags" [PtyFlags]
val

#if defined(ENABLE_OVERLOADING)
data PtyFlagsPropertyInfo
instance AttrInfo PtyFlagsPropertyInfo where
    type AttrAllowedOps PtyFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PtyFlagsPropertyInfo = IsPty
    type AttrSetTypeConstraint PtyFlagsPropertyInfo = (~) [Vte.Flags.PtyFlags]
    type AttrTransferTypeConstraint PtyFlagsPropertyInfo = (~) [Vte.Flags.PtyFlags]
    type AttrTransferType PtyFlagsPropertyInfo = [Vte.Flags.PtyFlags]
    type AttrGetType PtyFlagsPropertyInfo = [Vte.Flags.PtyFlags]
    type AttrLabel PtyFlagsPropertyInfo = "flags"
    type AttrOrigin PtyFlagsPropertyInfo = Pty
    attrGet = getPtyFlags
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPtyFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#g:attr:flags"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Pty
type instance O.AttributeList Pty = PtyAttributeList
type PtyAttributeList = ('[ '("fd", PtyFdPropertyInfo), '("flags", PtyFlagsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
ptyFd :: AttrLabelProxy "fd"
ptyFd = AttrLabelProxy

ptyFlags :: AttrLabelProxy "flags"
ptyFlags = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Pty = PtySignalList
type PtySignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Pty::new_foreign_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "fd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor to the PTY"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Pty" })
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_new_foreign_sync" vte_pty_new_foreign_sync :: 
    Int32 ->                                -- fd : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pty)

-- | Creates a new t'GI.Vte.Objects.Pty.Pty' for the PTY master /@fd@/.
-- 
-- No entry will be made in the lastlog, utmp or wtmp system files.
-- 
-- Note that the newly created t'GI.Vte.Objects.Pty.Pty' will take ownership of /@fd@/
-- and close it on finalize.
ptyNewForeignSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Int32
    -- ^ /@fd@/: a file descriptor to the PTY
    -> Maybe (a)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Pty
    -- ^ __Returns:__ a new t'GI.Vte.Objects.Pty.Pty' for /@fd@/, or 'P.Nothing' on error with /@error@/ filled in /(Can throw 'Data.GI.Base.GError.GError')/
ptyNewForeignSync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
Int32 -> Maybe a -> m Pty
ptyNewForeignSync Int32
fd Maybe a
cancellable = IO Pty -> m Pty
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pty -> m Pty) -> IO Pty -> m Pty
forall a b. (a -> b) -> a -> b
$ do
    maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ vte_pty_new_foreign_sync fd maybeCancellable
        checkUnexpectedReturnNULL "ptyNewForeignSync" result
        result' <- (wrapObject Pty) result
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Pty::new_sync
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Vte" , name = "PtyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags from #VtePtyFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Pty" })
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_new_sync" vte_pty_new_sync :: 
    CUInt ->                                -- flags : TInterface (Name {namespace = "Vte", name = "PtyFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pty)

-- | Allocates a new pseudo-terminal.
-- 
-- You can later use @/fork()/@ or the 'GI.GLib.Functions.spawnAsync' family of functions
-- to start a process on the PTY.
-- 
-- If using @/fork()/@, you MUST call 'GI.Vte.Objects.Pty.ptyChildSetup' in the child.
-- 
-- If using 'GI.GLib.Functions.spawnAsync' and friends, you MUST either use
-- 'GI.Vte.Objects.Pty.ptyChildSetup' directly as the child setup function, or call
-- 'GI.Vte.Objects.Pty.ptyChildSetup' from your own child setup function supplied.
-- 
-- When using 'GI.Vte.Objects.Terminal.terminalSpawnSync' with a custom child setup
-- function, 'GI.Vte.Objects.Pty.ptyChildSetup' will be called before the supplied
-- function; you must not call it again.
-- 
-- Also, you MUST pass the 'GI.GLib.Flags.SpawnFlagsDoNotReapChild' flag.
-- 
-- Note also that 'GI.GLib.Flags.SpawnFlagsStdoutToDevNull', 'GI.GLib.Flags.SpawnFlagsStderrToDevNull',
-- and 'GI.GLib.Flags.SpawnFlagsChildInheritsStdin' are not supported, since stdin, stdout
-- and stderr of the child process will always be connected to the PTY.
-- 
-- Note that you should set the PTY\'s size using 'GI.Vte.Objects.Pty.ptySetSize' before
-- spawning the child process, so that the child process has the correct
-- size from the start instead of starting with a default size and then
-- shortly afterwards receiving a \<literal>SIGWINCH\<\/literal> signal. You
-- should prefer using 'GI.Vte.Objects.Terminal.terminalPtyNewSync' which does this
-- automatically.
ptyNewSync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    [Vte.Flags.PtyFlags]
    -- ^ /@flags@/: flags from t'GI.Vte.Flags.PtyFlags'
    -> Maybe (a)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Pty
    -- ^ __Returns:__ a new t'GI.Vte.Objects.Pty.Pty', or 'P.Nothing' on error with /@error@/ filled in /(Can throw 'Data.GI.Base.GError.GError')/
ptyNewSync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
[PtyFlags] -> Maybe a -> m Pty
ptyNewSync [PtyFlags]
flags Maybe a
cancellable = IO Pty -> m Pty
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pty -> m Pty) -> IO Pty -> m Pty
forall a b. (a -> b) -> a -> b
$ do
    let flags' :: CUInt
flags' = [PtyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PtyFlags]
flags
    maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ vte_pty_new_sync flags' maybeCancellable
        checkUnexpectedReturnNULL "ptyNewSync" result
        result' <- (wrapObject Pty) result
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Pty::child_setup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vte_pty_child_setup" vte_pty_child_setup :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    IO ()

-- | /No description available in the introspection data./
ptyChildSetup ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> m ()
ptyChildSetup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPty a) =>
a -> m ()
ptyChildSetup a
pty = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    vte_pty_child_setup pty'
    touchManagedPtr pty
    return ()

#if defined(ENABLE_OVERLOADING)
data PtyChildSetupMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPty a) => O.OverloadedMethod PtyChildSetupMethodInfo a signature where
    overloadedMethod = ptyChildSetup

instance O.OverloadedMethodInfo PtyChildSetupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptyChildSetup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptyChildSetup"
        })


#endif

-- method Pty::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vte_pty_close" vte_pty_close :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    IO ()

{-# DEPRECATED ptyClose ["(Since version 0.42)"] #-}
-- | Since 0.42 this is a no-op.
ptyClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> m ()
ptyClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPty a) =>
a -> m ()
ptyClose a
pty = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    vte_pty_close pty'
    touchManagedPtr pty
    return ()

#if defined(ENABLE_OVERLOADING)
data PtyCloseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPty a) => O.OverloadedMethod PtyCloseMethodInfo a signature where
    overloadedMethod = ptyClose

instance O.OverloadedMethodInfo PtyCloseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptyClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptyClose"
        })


#endif

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

foreign import ccall "vte_pty_get_fd" vte_pty_get_fd :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    IO Int32

-- | /No description available in the introspection data./
ptyGetFd ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> m Int32
    -- ^ __Returns:__ the file descriptor of the PTY master in /@pty@/. The
    --   file descriptor belongs to /@pty@/ and must not be closed or have
    --   its flags changed
ptyGetFd :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPty a) =>
a -> m Int32
ptyGetFd a
pty = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    result <- vte_pty_get_fd pty'
    touchManagedPtr pty
    return result

#if defined(ENABLE_OVERLOADING)
data PtyGetFdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPty a) => O.OverloadedMethod PtyGetFdMethodInfo a signature where
    overloadedMethod = ptyGetFd

instance O.OverloadedMethodInfo PtyGetFdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptyGetFd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptyGetFd"
        })


#endif

-- method Pty::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rows"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a location to store the number of rows, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a location to store the number of columns, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_get_size" vte_pty_get_size :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    Ptr Int32 ->                            -- rows : TBasicType TInt
    Ptr Int32 ->                            -- columns : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Reads the pseudo terminal\'s window size.
-- 
-- If getting the window size failed, /@error@/ will be set to a t'GI.GLib.Enums.IOError'.
ptyGetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> m ((Int32, Int32))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
ptyGetSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPty a) =>
a -> m (Int32, Int32)
ptyGetSize a
pty = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    rows <- allocMem :: IO (Ptr Int32)
    columns <- allocMem :: IO (Ptr Int32)
    onException (do
        _ <- propagateGError $ vte_pty_get_size pty' rows columns
        rows' <- peek rows
        columns' <- peek columns
        touchManagedPtr pty
        freeMem rows
        freeMem columns
        return (rows', columns')
     ) (do
        freeMem rows
        freeMem columns
     )

#if defined(ENABLE_OVERLOADING)
data PtyGetSizeMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m, IsPty a) => O.OverloadedMethod PtyGetSizeMethodInfo a signature where
    overloadedMethod = ptyGetSize

instance O.OverloadedMethodInfo PtyGetSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptyGetSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptyGetSize"
        })


#endif

-- method Pty::set_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rows"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the desired number of rows"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "columns"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the desired number of columns"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_set_size" vte_pty_set_size :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    Int32 ->                                -- rows : TBasicType TInt
    Int32 ->                                -- columns : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to resize the pseudo terminal\'s window size.  If successful, the
-- OS kernel will send \<literal>SIGWINCH\<\/literal> to the child process group.
-- 
-- If setting the window size failed, /@error@/ will be set to a t'GI.GLib.Enums.IOError'.
ptySetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> Int32
    -- ^ /@rows@/: the desired number of rows
    -> Int32
    -- ^ /@columns@/: the desired number of columns
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
ptySetSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPty a) =>
a -> Int32 -> Int32 -> m ()
ptySetSize a
pty Int32
rows Int32
columns = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    onException (do
        _ <- propagateGError $ vte_pty_set_size pty' rows columns
        touchManagedPtr pty
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data PtySetSizeMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsPty a) => O.OverloadedMethod PtySetSizeMethodInfo a signature where
    overloadedMethod = ptySetSize

instance O.OverloadedMethodInfo PtySetSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptySetSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptySetSize"
        })


#endif

-- method Pty::set_utf8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "utf8"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether or not the pty is in UTF-8 mode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_set_utf8" vte_pty_set_utf8 :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    CInt ->                                 -- utf8 : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tells the kernel whether the terminal is UTF-8 or not, in case it can make
-- use of the info.  Linux 2.6.5 or so defines IUTF8 to make the line
-- discipline do multibyte backspace correctly.
ptySetUtf8 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> Bool
    -- ^ /@utf8@/: whether or not the pty is in UTF-8 mode
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
ptySetUtf8 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPty a) =>
a -> Bool -> m ()
ptySetUtf8 a
pty Bool
utf8 = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    let utf8' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
utf8
    onException (do
        _ <- propagateGError $ vte_pty_set_utf8 pty' utf8'
        touchManagedPtr pty
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data PtySetUtf8MethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPty a) => O.OverloadedMethod PtySetUtf8MethodInfo a signature where
    overloadedMethod = ptySetUtf8

instance O.OverloadedMethodInfo PtySetUtf8MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptySetUtf8",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptySetUtf8"
        })


#endif

-- method Pty::spawn_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "working_directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of a directory the command should start\n  in, or %NULL to use the current working directory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "argv"
--           , argType = TCArray True (-1) (-1) (TBasicType TFileName)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "child's argument vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "envv"
--           , argType = TCArray True (-1) (-1) (TBasicType TFileName)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a list of environment\n  variables to be added to the environment before starting the process, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spawn_flags"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SpawnFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags from #GSpawnFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_setup"
--           , argType =
--               TInterface
--                 Name { namespace = "GLib" , name = "SpawnChildSetupFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an extra child setup function to run in the child just before exec(), or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = 7
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_setup_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @child_setup, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_setup_data_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GDestroyNotify for @child_setup_data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a timeout value in ms, -1 for the default timeout, or G_MAXINT to wait indefinitely"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 11
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vte_pty_spawn_async" vte_pty_spawn_async :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    CString ->                              -- working_directory : TBasicType TUTF8
    Ptr CString ->                          -- argv : TCArray True (-1) (-1) (TBasicType TFileName)
    Ptr CString ->                          -- envv : TCArray True (-1) (-1) (TBasicType TFileName)
    CUInt ->                                -- spawn_flags : TInterface (Name {namespace = "GLib", name = "SpawnFlags"})
    FunPtr GLib.Callbacks.C_SpawnChildSetupFunc -> -- child_setup : TInterface (Name {namespace = "GLib", name = "SpawnChildSetupFunc"})
    Ptr () ->                               -- child_setup_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- child_setup_data_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    Int32 ->                                -- timeout : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Like 'GI.Vte.Objects.Pty.ptySpawnWithFdsAsync', except that this function does not
-- allow passing file descriptors to the child process. See 'GI.Vte.Objects.Pty.ptySpawnWithFdsAsync'
-- for more information.
-- 
-- /Since: 0.48/
ptySpawnAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> Maybe (T.Text)
    -- ^ /@workingDirectory@/: the name of a directory the command should start
    --   in, or 'P.Nothing' to use the current working directory
    -> [[Char]]
    -- ^ /@argv@/: child\'s argument vector
    -> Maybe ([[Char]])
    -- ^ /@envv@/: a list of environment
    --   variables to be added to the environment before starting the process, or 'P.Nothing'
    -> [GLib.Flags.SpawnFlags]
    -- ^ /@spawnFlags@/: flags from t'GI.GLib.Flags.SpawnFlags'
    -> Maybe (GLib.Callbacks.SpawnChildSetupFunc)
    -- ^ /@childSetup@/: an extra child setup function to run in the child just before @/exec()/@, or 'P.Nothing'
    -> Int32
    -- ^ /@timeout@/: a timeout value in ms, -1 for the default timeout, or G_MAXINT to wait indefinitely
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback', or 'P.Nothing'
    -> m ()
ptySpawnAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPty a, IsCancellable b) =>
a
-> Maybe Text
-> [String]
-> Maybe [String]
-> [SpawnFlags]
-> Maybe SpawnChildSetupFunc
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
ptySpawnAsync a
pty Maybe Text
workingDirectory [String]
argv Maybe [String]
envv [SpawnFlags]
spawnFlags Maybe SpawnChildSetupFunc
childSetup Int32
timeout Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    maybeWorkingDirectory <- case workingDirectory of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jWorkingDirectory -> do
            jWorkingDirectory' <- Text -> IO (Ptr CChar)
textToCString Text
jWorkingDirectory
            return jWorkingDirectory'
    argv' <- packZeroTerminatedFileNameArray argv
    maybeEnvv <- case envv of
        Maybe [String]
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
FP.nullPtr
        Just [String]
jEnvv -> do
            jEnvv' <- [String] -> IO (Ptr (Ptr CChar))
packZeroTerminatedFileNameArray [String]
jEnvv
            return jEnvv'
    let spawnFlags' = [SpawnFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SpawnFlags]
spawnFlags
    maybeChildSetup <- case childSetup of
        Maybe SpawnChildSetupFunc
Nothing -> FunPtr SpawnChildSetupFunc -> IO (FunPtr SpawnChildSetupFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr SpawnChildSetupFunc
forall a. FunPtr a
FP.nullFunPtr
        Just SpawnChildSetupFunc
jChildSetup -> do
            ptrchildSetup <- IO (Ptr (FunPtr SpawnChildSetupFunc))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_SpawnChildSetupFunc))
            jChildSetup' <- GLib.Callbacks.mk_SpawnChildSetupFunc (GLib.Callbacks.wrap_SpawnChildSetupFunc (Just ptrchildSetup) jChildSetup)
            poke ptrchildSetup jChildSetup'
            return jChildSetup'
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let childSetupData = Ptr a
forall a. Ptr a
nullPtr
    let childSetupDataDestroy = FunPtr a
forall a. FunPtr a
FP.nullFunPtr
    let userData = Ptr a
forall a. Ptr a
nullPtr
    vte_pty_spawn_async pty' maybeWorkingDirectory argv' maybeEnvv spawnFlags' maybeChildSetup childSetupData childSetupDataDestroy timeout maybeCancellable maybeCallback userData
    touchManagedPtr pty
    whenJust cancellable touchManagedPtr
    freeMem maybeWorkingDirectory
    mapZeroTerminatedCArray freeMem argv'
    freeMem argv'
    mapZeroTerminatedCArray freeMem maybeEnvv
    freeMem maybeEnvv
    return ()

#if defined(ENABLE_OVERLOADING)
data PtySpawnAsyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> [[Char]] -> Maybe ([[Char]]) -> [GLib.Flags.SpawnFlags] -> Maybe (GLib.Callbacks.SpawnChildSetupFunc) -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsPty a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PtySpawnAsyncMethodInfo a signature where
    overloadedMethod = ptySpawnAsync

instance O.OverloadedMethodInfo PtySpawnAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptySpawnAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptySpawnAsync"
        })


#endif

-- method Pty::spawn_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_pid"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the child PID, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_spawn_finish" vte_pty_spawn_finish :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Int32 ->                            -- child_pid : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 0.48/
ptySpawnFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (Int32)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
ptySpawnFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPty a, IsAsyncResult b) =>
a -> b -> m Int32
ptySpawnFinish a
pty b
result_ = 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
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    result_' <- unsafeManagedPtrCastPtr result_
    childPid <- allocMem :: IO (Ptr Int32)
    onException (do
        _ <- propagateGError $ vte_pty_spawn_finish pty' result_' childPid
        childPid' <- peek childPid
        touchManagedPtr pty
        touchManagedPtr result_
        freeMem childPid
        return childPid'
     ) (do
        freeMem childPid
     )

#if defined(ENABLE_OVERLOADING)
data PtySpawnFinishMethodInfo
instance (signature ~ (b -> m (Int32)), MonadIO m, IsPty a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod PtySpawnFinishMethodInfo a signature where
    overloadedMethod = ptySpawnFinish

instance O.OverloadedMethodInfo PtySpawnFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptySpawnFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptySpawnFinish"
        })


#endif

-- method Pty::spawn_with_fds_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pty"
--           , argType = TInterface Name { namespace = "Vte" , name = "Pty" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VtePty" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "working_directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name of a directory the command should start\n  in, or %NULL to use the current working directory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "argv"
--           , argType = TCArray True (-1) (-1) (TBasicType TFileName)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "child's argument vector"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "envv"
--           , argType = TCArray True (-1) (-1) (TBasicType TFileName)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a list of environment\n  variables to be added to the environment before starting the process, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fds"
--           , argType = TCArray False (-1) 5 (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of file descriptors, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_fds"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the number of file descriptors in @fds, or 0 if @fds is %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "map_fds"
--           , argType = TCArray False (-1) 7 (TBasicType TInt)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of integers, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_map_fds"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the number of elements in @map_fds, or 0 if @map_fds is %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spawn_flags"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "SpawnFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags from #GSpawnFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_setup"
--           , argType =
--               TInterface
--                 Name { namespace = "GLib" , name = "SpawnChildSetupFunc" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an extra child setup function to run in the child just before exec(), or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 10
--           , argDestroy = 11
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_setup_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @child_setup, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_setup_data_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GDestroyNotify for @child_setup_data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a timeout value in ms, -1 for the default timeout, or G_MAXINT to wait indefinitely"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 15
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_map_fds"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "the number of elements in @map_fds, or 0 if @map_fds is %NULL"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          , Arg
--              { argCName = "n_fds"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "the number of file descriptors in @fds, or 0 if @fds is %NULL"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "vte_pty_spawn_with_fds_async" vte_pty_spawn_with_fds_async :: 
    Ptr Pty ->                              -- pty : TInterface (Name {namespace = "Vte", name = "Pty"})
    CString ->                              -- working_directory : TBasicType TUTF8
    Ptr CString ->                          -- argv : TCArray True (-1) (-1) (TBasicType TFileName)
    Ptr CString ->                          -- envv : TCArray True (-1) (-1) (TBasicType TFileName)
    Ptr Int32 ->                            -- fds : TCArray False (-1) 5 (TBasicType TInt)
    Int32 ->                                -- n_fds : TBasicType TInt
    Ptr Int32 ->                            -- map_fds : TCArray False (-1) 7 (TBasicType TInt)
    Int32 ->                                -- n_map_fds : TBasicType TInt
    CUInt ->                                -- spawn_flags : TInterface (Name {namespace = "GLib", name = "SpawnFlags"})
    FunPtr GLib.Callbacks.C_SpawnChildSetupFunc -> -- child_setup : TInterface (Name {namespace = "GLib", name = "SpawnChildSetupFunc"})
    Ptr () ->                               -- child_setup_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- child_setup_data_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    Int32 ->                                -- timeout : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Starts the specified command under the pseudo-terminal /@pty@/.
-- The /@argv@/ and /@envv@/ lists should be 'P.Nothing'-terminated.
-- The \"TERM\" environment variable is automatically set to a default value,
-- but can be overridden from /@envv@/.
-- /@ptyFlags@/ controls logging the session to the specified system log files.
-- 
-- Note also that 'GI.GLib.Flags.SpawnFlagsStdoutToDevNull', 'GI.GLib.Flags.SpawnFlagsStderrToDevNull',
-- and 'GI.GLib.Flags.SpawnFlagsChildInheritsStdin' are not supported in /@spawnFlags@/, since
-- stdin, stdout and stderr of the child process will always be connected to
-- the PTY. Also 'GI.GLib.Flags.SpawnFlagsLeaveDescriptorsOpen' is not supported; and
-- 'GI.GLib.Flags.SpawnFlagsDoNotReapChild' will always be added to /@spawnFlags@/.
-- 
-- If /@fds@/ is not 'P.Nothing', the child process will map the file descriptors from
-- /@fds@/ according to /@mapFds@/; /@nMapFds@/ must be less or equal to /@nFds@/.
-- This function will take ownership of the file descriptors in /@fds@/;
-- you must not use or close them after this call. All file descriptors in /@fds@/
-- must have the FD_CLOEXEC flag set on them; it will be unset in the child process
-- before calling man:execve(2). Note also that no file descriptor may be mapped
-- to stdin, stdout, or stderr (file descriptors 0, 1, or 2), since these will be
-- assigned to the PTY. All open file descriptors apart from those mapped as above
-- will be closed when @/execve()/@ is called.
-- 
-- Beginning with 0.60, and on linux only, and unless 'GI.Vte.Constants.SPAWN_NO_SYSTEMD_SCOPE' is
-- passed in /@spawnFlags@/, the newly created child process will be moved to its own
-- systemd user scope; and if 'GI.Vte.Constants.SPAWN_REQUIRE_SYSTEMD_SCOPE' is passed, and creation
-- of the systemd user scope fails, the whole spawn will fail.
-- You can override the options used for the systemd user scope by
-- providing a systemd override file for \'vte-spawn-.scope\' unit. See man:systemd.unit(5)
-- for further information.
-- 
-- See @/vte_pty_new()/@, and 'GI.Vte.Objects.Terminal.terminalWatchChild' for more information.
-- 
-- /Since: 0.62/
ptySpawnWithFdsAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsPty a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@pty@/: a t'GI.Vte.Objects.Pty.Pty'
    -> Maybe (T.Text)
    -- ^ /@workingDirectory@/: the name of a directory the command should start
    --   in, or 'P.Nothing' to use the current working directory
    -> [[Char]]
    -- ^ /@argv@/: child\'s argument vector
    -> Maybe ([[Char]])
    -- ^ /@envv@/: a list of environment
    --   variables to be added to the environment before starting the process, or 'P.Nothing'
    -> Maybe ([Int32])
    -- ^ /@fds@/: an array of file descriptors, or 'P.Nothing'
    -> Maybe ([Int32])
    -- ^ /@mapFds@/: an array of integers, or 'P.Nothing'
    -> [GLib.Flags.SpawnFlags]
    -- ^ /@spawnFlags@/: flags from t'GI.GLib.Flags.SpawnFlags'
    -> Maybe (GLib.Callbacks.SpawnChildSetupFunc)
    -- ^ /@childSetup@/: an extra child setup function to run in the child just before @/exec()/@, or 'P.Nothing'
    -> Int32
    -- ^ /@timeout@/: a timeout value in ms, -1 for the default timeout, or G_MAXINT to wait indefinitely
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback', or 'P.Nothing'
    -> m ()
ptySpawnWithFdsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPty a, IsCancellable b) =>
a
-> Maybe Text
-> [String]
-> Maybe [String]
-> Maybe [Int32]
-> Maybe [Int32]
-> [SpawnFlags]
-> Maybe SpawnChildSetupFunc
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
ptySpawnWithFdsAsync a
pty Maybe Text
workingDirectory [String]
argv Maybe [String]
envv Maybe [Int32]
fds Maybe [Int32]
mapFds [SpawnFlags]
spawnFlags Maybe SpawnChildSetupFunc
childSetup Int32
timeout Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nMapFds :: Int32
nMapFds = case Maybe [Int32]
mapFds of
            Maybe [Int32]
Nothing -> Int32
0
            Just [Int32]
jMapFds -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
jMapFds
    let nFds :: Int32
nFds = case Maybe [Int32]
fds of
            Maybe [Int32]
Nothing -> Int32
0
            Just [Int32]
jFds -> Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Int32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Int32]
jFds
    pty' <- a -> IO (Ptr Pty)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pty
    maybeWorkingDirectory <- case workingDirectory of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jWorkingDirectory -> do
            jWorkingDirectory' <- Text -> IO (Ptr CChar)
textToCString Text
jWorkingDirectory
            return jWorkingDirectory'
    argv' <- packZeroTerminatedFileNameArray argv
    maybeEnvv <- case envv of
        Maybe [String]
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
FP.nullPtr
        Just [String]
jEnvv -> do
            jEnvv' <- [String] -> IO (Ptr (Ptr CChar))
packZeroTerminatedFileNameArray [String]
jEnvv
            return jEnvv'
    maybeFds <- case fds of
        Maybe [Int32]
Nothing -> Ptr Int32 -> IO (Ptr Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Int32
forall a. Ptr a
FP.nullPtr
        Just [Int32]
jFds -> do
            jFds' <- [Int32] -> IO (Ptr Int32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int32]
jFds
            return jFds'
    maybeMapFds <- case mapFds of
        Maybe [Int32]
Nothing -> Ptr Int32 -> IO (Ptr Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Int32
forall a. Ptr a
FP.nullPtr
        Just [Int32]
jMapFds -> do
            jMapFds' <- [Int32] -> IO (Ptr Int32)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Int32]
jMapFds
            return jMapFds'
    let spawnFlags' = [SpawnFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SpawnFlags]
spawnFlags
    maybeChildSetup <- case childSetup of
        Maybe SpawnChildSetupFunc
Nothing -> FunPtr SpawnChildSetupFunc -> IO (FunPtr SpawnChildSetupFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr SpawnChildSetupFunc
forall a. FunPtr a
FP.nullFunPtr
        Just SpawnChildSetupFunc
jChildSetup -> do
            jChildSetup' <- SpawnChildSetupFunc -> IO (FunPtr SpawnChildSetupFunc)
GLib.Callbacks.mk_SpawnChildSetupFunc (Maybe (Ptr (FunPtr SpawnChildSetupFunc))
-> SpawnChildSetupFunc -> SpawnChildSetupFunc
GLib.Callbacks.wrap_SpawnChildSetupFunc Maybe (Ptr (FunPtr SpawnChildSetupFunc))
forall a. Maybe a
Nothing SpawnChildSetupFunc
jChildSetup)
            return jChildSetup'
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let childSetupData = FunPtr SpawnChildSetupFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr SpawnChildSetupFunc
maybeChildSetup
    let childSetupDataDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    let userData = Ptr a
forall a. Ptr a
nullPtr
    vte_pty_spawn_with_fds_async pty' maybeWorkingDirectory argv' maybeEnvv maybeFds nFds maybeMapFds nMapFds spawnFlags' maybeChildSetup childSetupData childSetupDataDestroy timeout maybeCancellable maybeCallback userData
    touchManagedPtr pty
    whenJust cancellable touchManagedPtr
    freeMem maybeWorkingDirectory
    mapZeroTerminatedCArray freeMem argv'
    freeMem argv'
    mapZeroTerminatedCArray freeMem maybeEnvv
    freeMem maybeEnvv
    freeMem maybeFds
    freeMem maybeMapFds
    return ()

#if defined(ENABLE_OVERLOADING)
data PtySpawnWithFdsAsyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> [[Char]] -> Maybe ([[Char]]) -> Maybe ([Int32]) -> Maybe ([Int32]) -> [GLib.Flags.SpawnFlags] -> Maybe (GLib.Callbacks.SpawnChildSetupFunc) -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsPty a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PtySpawnWithFdsAsyncMethodInfo a signature where
    overloadedMethod = ptySpawnWithFdsAsync

instance O.OverloadedMethodInfo PtySpawnWithFdsAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Vte.Objects.Pty.ptySpawnWithFdsAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Objects-Pty.html#v:ptySpawnWithFdsAsync"
        })


#endif