Pty.hs


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

module GI.Vte.Objects.Pty
    ( 

-- * Exported types
    Pty(..)                                 ,
    PtyK                                    ,
    toPty                                   ,
    noPty                                   ,


 -- * Methods
-- ** ptyChildSetup
    PtyChildSetupMethodInfo                 ,
    ptyChildSetup                           ,


-- ** ptyGetFd
    PtyGetFdMethodInfo                      ,
    ptyGetFd                                ,


-- ** ptyGetSize
    PtyGetSizeMethodInfo                    ,
    ptyGetSize                              ,


-- ** ptyNewForeignSync
    ptyNewForeignSync                       ,


-- ** ptyNewSync
    ptyNewSync                              ,


-- ** ptySetSize
    PtySetSizeMethodInfo                    ,
    ptySetSize                              ,


-- ** ptySetUtf8
    PtySetUtf8MethodInfo                    ,
    ptySetUtf8                              ,




 -- * Properties
-- ** Fd
    PtyFdPropertyInfo                       ,
    constructPtyFd                          ,
    getPtyFd                                ,


-- ** Flags
    PtyFlagsPropertyInfo                    ,
    constructPtyFlags                       ,
    getPtyFlags                             ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Vte.Types
import GI.Vte.Callbacks
import qualified GI.GObject as GObject
import qualified GI.Gio as Gio

newtype Pty = Pty (ForeignPtr Pty)
foreign import ccall "vte_pty_get_type"
    c_vte_pty_get_type :: IO GType

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

instance GObject Pty where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_vte_pty_get_type
    

class GObject o => PtyK o
instance (GObject o, IsDescendantOf Pty o) => PtyK o

toPty :: PtyK o => o -> IO Pty
toPty = unsafeCastTo Pty

noPty :: Maybe Pty
noPty = Nothing

type family ResolvePtyMethod (t :: Symbol) (o :: *) :: * where
    ResolvePtyMethod "bindProperty" o = GObject.ObjectBindPropertyMethodInfo
    ResolvePtyMethod "bindPropertyFull" o = GObject.ObjectBindPropertyFullMethodInfo
    ResolvePtyMethod "childSetup" o = PtyChildSetupMethodInfo
    ResolvePtyMethod "forceFloating" o = GObject.ObjectForceFloatingMethodInfo
    ResolvePtyMethod "freezeNotify" o = GObject.ObjectFreezeNotifyMethodInfo
    ResolvePtyMethod "init" o = Gio.InitableInitMethodInfo
    ResolvePtyMethod "isFloating" o = GObject.ObjectIsFloatingMethodInfo
    ResolvePtyMethod "notify" o = GObject.ObjectNotifyMethodInfo
    ResolvePtyMethod "notifyByPspec" o = GObject.ObjectNotifyByPspecMethodInfo
    ResolvePtyMethod "ref" o = GObject.ObjectRefMethodInfo
    ResolvePtyMethod "refSink" o = GObject.ObjectRefSinkMethodInfo
    ResolvePtyMethod "replaceData" o = GObject.ObjectReplaceDataMethodInfo
    ResolvePtyMethod "replaceQdata" o = GObject.ObjectReplaceQdataMethodInfo
    ResolvePtyMethod "runDispose" o = GObject.ObjectRunDisposeMethodInfo
    ResolvePtyMethod "stealData" o = GObject.ObjectStealDataMethodInfo
    ResolvePtyMethod "stealQdata" o = GObject.ObjectStealQdataMethodInfo
    ResolvePtyMethod "thawNotify" o = GObject.ObjectThawNotifyMethodInfo
    ResolvePtyMethod "unref" o = GObject.ObjectUnrefMethodInfo
    ResolvePtyMethod "watchClosure" o = GObject.ObjectWatchClosureMethodInfo
    ResolvePtyMethod "getData" o = GObject.ObjectGetDataMethodInfo
    ResolvePtyMethod "getFd" o = PtyGetFdMethodInfo
    ResolvePtyMethod "getProperty" o = GObject.ObjectGetPropertyMethodInfo
    ResolvePtyMethod "getQdata" o = GObject.ObjectGetQdataMethodInfo
    ResolvePtyMethod "getSize" o = PtyGetSizeMethodInfo
    ResolvePtyMethod "setData" o = GObject.ObjectSetDataMethodInfo
    ResolvePtyMethod "setProperty" o = GObject.ObjectSetPropertyMethodInfo
    ResolvePtyMethod "setSize" o = PtySetSizeMethodInfo
    ResolvePtyMethod "setUtf8" o = PtySetUtf8MethodInfo
    ResolvePtyMethod l o = MethodResolutionFailed l o

instance (info ~ ResolvePtyMethod t Pty, MethodInfo info Pty p) => IsLabelProxy t (Pty -> p) where
    fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolvePtyMethod t Pty, MethodInfo info Pty p) => IsLabel t (Pty -> p) where
    fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info)
#endif

-- VVV Prop "fd"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getPtyFd :: (MonadIO m, PtyK o) => o -> m Int32
getPtyFd obj = liftIO $ getObjectPropertyCInt obj "fd"

constructPtyFd :: Int32 -> IO ([Char], GValue)
constructPtyFd val = constructObjectPropertyCInt "fd" val

data PtyFdPropertyInfo
instance AttrInfo PtyFdPropertyInfo where
    type AttrAllowedOps PtyFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PtyFdPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint PtyFdPropertyInfo = PtyK
    type AttrGetType PtyFdPropertyInfo = Int32
    type AttrLabel PtyFdPropertyInfo = "fd"
    attrGet _ = getPtyFd
    attrSet _ = undefined
    attrConstruct _ = constructPtyFd

-- VVV Prop "flags"
   -- Type: TInterface "Vte" "PtyFlags"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getPtyFlags :: (MonadIO m, PtyK o) => o -> m [PtyFlags]
getPtyFlags obj = liftIO $ getObjectPropertyFlags obj "flags"

constructPtyFlags :: [PtyFlags] -> IO ([Char], GValue)
constructPtyFlags val = constructObjectPropertyFlags "flags" val

data PtyFlagsPropertyInfo
instance AttrInfo PtyFlagsPropertyInfo where
    type AttrAllowedOps PtyFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint PtyFlagsPropertyInfo = (~) [PtyFlags]
    type AttrBaseTypeConstraint PtyFlagsPropertyInfo = PtyK
    type AttrGetType PtyFlagsPropertyInfo = [PtyFlags]
    type AttrLabel PtyFlagsPropertyInfo = "flags"
    attrGet _ = getPtyFlags
    attrSet _ = undefined
    attrConstruct _ = constructPtyFlags

type instance AttributeList Pty = PtyAttributeList
type PtyAttributeList = ('[ '("fd", PtyFdPropertyInfo), '("flags", PtyFlagsPropertyInfo)] :: [(Symbol, *)])

type instance SignalList Pty = PtySignalList
type PtySignalList = ('[ '("notify", GObject.ObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Pty::new_foreign_sync
-- method type : Constructor
-- Args : [Arg {argCName = "fd", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TInterface "Vte" "Pty"
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_new_foreign_sync" vte_pty_new_foreign_sync :: 
    Int32 ->                                -- fd : TBasicType TInt32
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pty)


ptyNewForeignSync ::
    (MonadIO m, Gio.CancellableK a) =>
    Int32                                   -- fd
    -> Maybe (a)                            -- cancellable
    -> m Pty                                -- result
ptyNewForeignSync fd cancellable = liftIO $ do
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ vte_pty_new_foreign_sync fd maybeCancellable
        checkUnexpectedReturnNULL "vte_pty_new_foreign_sync" result
        result' <- (wrapObject Pty) result
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

-- method Pty::new_sync
-- method type : Constructor
-- Args : [Arg {argCName = "flags", argType = TInterface "Vte" "PtyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TInterface "Vte" "Pty"
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_new_sync" vte_pty_new_sync :: 
    CUInt ->                                -- flags : TInterface "Vte" "PtyFlags"
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pty)


ptyNewSync ::
    (MonadIO m, Gio.CancellableK a) =>
    [PtyFlags]                              -- flags
    -> Maybe (a)                            -- cancellable
    -> m Pty                                -- result
ptyNewSync flags cancellable = liftIO $ do
    let flags' = gflagsToWord flags
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ vte_pty_new_sync flags' maybeCancellable
        checkUnexpectedReturnNULL "vte_pty_new_sync" result
        result' <- (wrapObject Pty) result
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

-- method Pty::child_setup
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Vte" "Pty", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_pty_child_setup" vte_pty_child_setup :: 
    Ptr Pty ->                              -- _obj : TInterface "Vte" "Pty"
    IO ()


ptyChildSetup ::
    (MonadIO m, PtyK a) =>
    a                                       -- _obj
    -> m ()                                 -- result
ptyChildSetup _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_pty_child_setup _obj'
    touchManagedPtr _obj
    return ()

data PtyChildSetupMethodInfo
instance (signature ~ (m ()), MonadIO m, PtyK a) => MethodInfo PtyChildSetupMethodInfo a signature where
    overloadedMethod _ = ptyChildSetup

-- method Pty::get_fd
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Vte" "Pty", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "vte_pty_get_fd" vte_pty_get_fd :: 
    Ptr Pty ->                              -- _obj : TInterface "Vte" "Pty"
    IO Int32


ptyGetFd ::
    (MonadIO m, PtyK a) =>
    a                                       -- _obj
    -> m Int32                              -- result
ptyGetFd _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_pty_get_fd _obj'
    touchManagedPtr _obj
    return result

data PtyGetFdMethodInfo
instance (signature ~ (m Int32), MonadIO m, PtyK a) => MethodInfo PtyGetFdMethodInfo a signature where
    overloadedMethod _ = ptyGetFd

-- method Pty::get_size
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Vte" "Pty", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "rows", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything},Arg {argCName = "columns", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_get_size" vte_pty_get_size :: 
    Ptr Pty ->                              -- _obj : TInterface "Vte" "Pty"
    Ptr Int32 ->                            -- rows : TBasicType TInt32
    Ptr Int32 ->                            -- columns : TBasicType TInt32
    Ptr (Ptr GError) ->                     -- error
    IO CInt


ptyGetSize ::
    (MonadIO m, PtyK a) =>
    a                                       -- _obj
    -> m (Int32,Int32)                      -- result
ptyGetSize _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    rows <- allocMem :: IO (Ptr Int32)
    columns <- allocMem :: IO (Ptr Int32)
    onException (do
        _ <- propagateGError $ vte_pty_get_size _obj' rows columns
        rows' <- peek rows
        columns' <- peek columns
        touchManagedPtr _obj
        freeMem rows
        freeMem columns
        return (rows', columns')
     ) (do
        freeMem rows
        freeMem columns
     )

data PtyGetSizeMethodInfo
instance (signature ~ (m (Int32,Int32)), MonadIO m, PtyK a) => MethodInfo PtyGetSizeMethodInfo a signature where
    overloadedMethod _ = ptyGetSize

-- method Pty::set_size
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Vte" "Pty", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "rows", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "columns", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_set_size" vte_pty_set_size :: 
    Ptr Pty ->                              -- _obj : TInterface "Vte" "Pty"
    Int32 ->                                -- rows : TBasicType TInt32
    Int32 ->                                -- columns : TBasicType TInt32
    Ptr (Ptr GError) ->                     -- error
    IO CInt


ptySetSize ::
    (MonadIO m, PtyK a) =>
    a                                       -- _obj
    -> Int32                                -- rows
    -> Int32                                -- columns
    -> m ()                                 -- result
ptySetSize _obj rows columns = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    onException (do
        _ <- propagateGError $ vte_pty_set_size _obj' rows columns
        touchManagedPtr _obj
        return ()
     ) (do
        return ()
     )

data PtySetSizeMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, PtyK a) => MethodInfo PtySetSizeMethodInfo a signature where
    overloadedMethod _ = ptySetSize

-- method Pty::set_utf8
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "_obj", argType = TInterface "Vte" "Pty", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "utf8", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "vte_pty_set_utf8" vte_pty_set_utf8 :: 
    Ptr Pty ->                              -- _obj : TInterface "Vte" "Pty"
    CInt ->                                 -- utf8 : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt


ptySetUtf8 ::
    (MonadIO m, PtyK a) =>
    a                                       -- _obj
    -> Bool                                 -- utf8
    -> m ()                                 -- result
ptySetUtf8 _obj utf8 = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let utf8' = (fromIntegral . fromEnum) utf8
    onException (do
        _ <- propagateGError $ vte_pty_set_utf8 _obj' utf8'
        touchManagedPtr _obj
        return ()
     ) (do
        return ()
     )

data PtySetUtf8MethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, PtyK a) => MethodInfo PtySetUtf8MethodInfo a signature where
    overloadedMethod _ = ptySetUtf8