{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- See t'GI.Atk.Objects.Socket.Socket'

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

module GI.Atk.Objects.Plug
    ( 

-- * Exported types
    Plug(..)                                ,
    IsPlug                                  ,
    toPlug                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addRelationship]("GI.Atk.Objects.Object#g:method:addRelationship"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [contains]("GI.Atk.Interfaces.Component#g:method:contains"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Atk.Interfaces.Component#g:method:grabFocus"), [initialize]("GI.Atk.Objects.Object#g:method:initialize"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [notifyStateChange]("GI.Atk.Objects.Object#g:method:notifyStateChange"), [peekParent]("GI.Atk.Objects.Object#g:method:peekParent"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refAccessibleAtPoint]("GI.Atk.Interfaces.Component#g:method:refAccessibleAtPoint"), [refAccessibleChild]("GI.Atk.Objects.Object#g:method:refAccessibleChild"), [refRelationSet]("GI.Atk.Objects.Object#g:method:refRelationSet"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [refStateSet]("GI.Atk.Objects.Object#g:method:refStateSet"), [removeFocusHandler]("GI.Atk.Interfaces.Component#g:method:removeFocusHandler"), [removePropertyChangeHandler]("GI.Atk.Objects.Object#g:method:removePropertyChangeHandler"), [removeRelationship]("GI.Atk.Objects.Object#g:method:removeRelationship"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [scrollTo]("GI.Atk.Interfaces.Component#g:method:scrollTo"), [scrollToPoint]("GI.Atk.Interfaces.Component#g:method:scrollToPoint"), [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
-- [getAccessibleId]("GI.Atk.Objects.Object#g:method:getAccessibleId"), [getAlpha]("GI.Atk.Interfaces.Component#g:method:getAlpha"), [getAttributes]("GI.Atk.Objects.Object#g:method:getAttributes"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.Atk.Objects.Object#g:method:getDescription"), [getExtents]("GI.Atk.Interfaces.Component#g:method:getExtents"), [getId]("GI.Atk.Objects.Plug#g:method:getId"), [getIndexInParent]("GI.Atk.Objects.Object#g:method:getIndexInParent"), [getLayer]("GI.Atk.Objects.Object#g:method:getLayer"), [getMdiZorder]("GI.Atk.Objects.Object#g:method:getMdiZorder"), [getNAccessibleChildren]("GI.Atk.Objects.Object#g:method:getNAccessibleChildren"), [getName]("GI.Atk.Objects.Object#g:method:getName"), [getObjectLocale]("GI.Atk.Objects.Object#g:method:getObjectLocale"), [getParent]("GI.Atk.Objects.Object#g:method:getParent"), [getPosition]("GI.Atk.Interfaces.Component#g:method:getPosition"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRole]("GI.Atk.Objects.Object#g:method:getRole"), [getSize]("GI.Atk.Interfaces.Component#g:method:getSize").
-- 
-- ==== Setters
-- [setAccessibleId]("GI.Atk.Objects.Object#g:method:setAccessibleId"), [setChild]("GI.Atk.Objects.Plug#g:method:setChild"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDescription]("GI.Atk.Objects.Object#g:method:setDescription"), [setExtents]("GI.Atk.Interfaces.Component#g:method:setExtents"), [setName]("GI.Atk.Objects.Object#g:method:setName"), [setParent]("GI.Atk.Objects.Object#g:method:setParent"), [setPosition]("GI.Atk.Interfaces.Component#g:method:setPosition"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRole]("GI.Atk.Objects.Object#g:method:setRole"), [setSize]("GI.Atk.Interfaces.Component#g:method:setSize").

#if defined(ENABLE_OVERLOADING)
    ResolvePlugMethod                       ,
#endif

-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    PlugGetIdMethodInfo                     ,
#endif
    plugGetId                               ,


-- ** new #method:new#

    plugNew                                 ,


-- ** setChild #method:setChild#

#if defined(ENABLE_OVERLOADING)
    PlugSetChildMethodInfo                  ,
#endif
    plugSetChild                            ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Atk.Interfaces.Component as Atk.Component
import {-# SOURCE #-} qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "atk_plug_get_type"
    c_atk_plug_get_type :: IO B.Types.GType

instance B.Types.TypedObject Plug where
    glibType :: IO GType
glibType = IO GType
c_atk_plug_get_type

instance B.Types.GObject Plug

-- | Type class for types which can be safely cast to `Plug`, for instance with `toPlug`.
class (SP.GObject o, O.IsDescendantOf Plug o) => IsPlug o
instance (SP.GObject o, O.IsDescendantOf Plug o) => IsPlug o

instance O.HasParentTypes Plug
type instance O.ParentTypes Plug = '[Atk.Object.Object, GObject.Object.Object, Atk.Component.Component]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePlugMethod (t :: Symbol) (o :: *) :: * where
    ResolvePlugMethod "addRelationship" o = Atk.Object.ObjectAddRelationshipMethodInfo
    ResolvePlugMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePlugMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePlugMethod "contains" o = Atk.Component.ComponentContainsMethodInfo
    ResolvePlugMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePlugMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePlugMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePlugMethod "grabFocus" o = Atk.Component.ComponentGrabFocusMethodInfo
    ResolvePlugMethod "initialize" o = Atk.Object.ObjectInitializeMethodInfo
    ResolvePlugMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePlugMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePlugMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePlugMethod "notifyStateChange" o = Atk.Object.ObjectNotifyStateChangeMethodInfo
    ResolvePlugMethod "peekParent" o = Atk.Object.ObjectPeekParentMethodInfo
    ResolvePlugMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePlugMethod "refAccessibleAtPoint" o = Atk.Component.ComponentRefAccessibleAtPointMethodInfo
    ResolvePlugMethod "refAccessibleChild" o = Atk.Object.ObjectRefAccessibleChildMethodInfo
    ResolvePlugMethod "refRelationSet" o = Atk.Object.ObjectRefRelationSetMethodInfo
    ResolvePlugMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePlugMethod "refStateSet" o = Atk.Object.ObjectRefStateSetMethodInfo
    ResolvePlugMethod "removeFocusHandler" o = Atk.Component.ComponentRemoveFocusHandlerMethodInfo
    ResolvePlugMethod "removePropertyChangeHandler" o = Atk.Object.ObjectRemovePropertyChangeHandlerMethodInfo
    ResolvePlugMethod "removeRelationship" o = Atk.Object.ObjectRemoveRelationshipMethodInfo
    ResolvePlugMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePlugMethod "scrollTo" o = Atk.Component.ComponentScrollToMethodInfo
    ResolvePlugMethod "scrollToPoint" o = Atk.Component.ComponentScrollToPointMethodInfo
    ResolvePlugMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePlugMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePlugMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePlugMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePlugMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePlugMethod "getAccessibleId" o = Atk.Object.ObjectGetAccessibleIdMethodInfo
    ResolvePlugMethod "getAlpha" o = Atk.Component.ComponentGetAlphaMethodInfo
    ResolvePlugMethod "getAttributes" o = Atk.Object.ObjectGetAttributesMethodInfo
    ResolvePlugMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePlugMethod "getDescription" o = Atk.Object.ObjectGetDescriptionMethodInfo
    ResolvePlugMethod "getExtents" o = Atk.Component.ComponentGetExtentsMethodInfo
    ResolvePlugMethod "getId" o = PlugGetIdMethodInfo
    ResolvePlugMethod "getIndexInParent" o = Atk.Object.ObjectGetIndexInParentMethodInfo
    ResolvePlugMethod "getLayer" o = Atk.Object.ObjectGetLayerMethodInfo
    ResolvePlugMethod "getMdiZorder" o = Atk.Object.ObjectGetMdiZorderMethodInfo
    ResolvePlugMethod "getNAccessibleChildren" o = Atk.Object.ObjectGetNAccessibleChildrenMethodInfo
    ResolvePlugMethod "getName" o = Atk.Object.ObjectGetNameMethodInfo
    ResolvePlugMethod "getObjectLocale" o = Atk.Object.ObjectGetObjectLocaleMethodInfo
    ResolvePlugMethod "getParent" o = Atk.Object.ObjectGetParentMethodInfo
    ResolvePlugMethod "getPosition" o = Atk.Component.ComponentGetPositionMethodInfo
    ResolvePlugMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePlugMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePlugMethod "getRole" o = Atk.Object.ObjectGetRoleMethodInfo
    ResolvePlugMethod "getSize" o = Atk.Component.ComponentGetSizeMethodInfo
    ResolvePlugMethod "setAccessibleId" o = Atk.Object.ObjectSetAccessibleIdMethodInfo
    ResolvePlugMethod "setChild" o = PlugSetChildMethodInfo
    ResolvePlugMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePlugMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePlugMethod "setDescription" o = Atk.Object.ObjectSetDescriptionMethodInfo
    ResolvePlugMethod "setExtents" o = Atk.Component.ComponentSetExtentsMethodInfo
    ResolvePlugMethod "setName" o = Atk.Object.ObjectSetNameMethodInfo
    ResolvePlugMethod "setParent" o = Atk.Object.ObjectSetParentMethodInfo
    ResolvePlugMethod "setPosition" o = Atk.Component.ComponentSetPositionMethodInfo
    ResolvePlugMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePlugMethod "setRole" o = Atk.Object.ObjectSetRoleMethodInfo
    ResolvePlugMethod "setSize" o = Atk.Component.ComponentSetSizeMethodInfo
    ResolvePlugMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePlugMethod t Plug, O.OverloadedMethod info Plug p) => OL.IsLabel t (Plug -> 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 ~ ResolvePlugMethod t Plug, O.OverloadedMethod info Plug p, R.HasField t Plug p) => R.HasField t Plug p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Plug
type instance O.AttributeList Plug = PlugAttributeList
type PlugAttributeList = ('[ '("accessibleComponentLayer", Atk.Object.ObjectAccessibleComponentLayerPropertyInfo), '("accessibleComponentMdiZorder", Atk.Object.ObjectAccessibleComponentMdiZorderPropertyInfo), '("accessibleDescription", Atk.Object.ObjectAccessibleDescriptionPropertyInfo), '("accessibleHypertextNlinks", Atk.Object.ObjectAccessibleHypertextNlinksPropertyInfo), '("accessibleName", Atk.Object.ObjectAccessibleNamePropertyInfo), '("accessibleParent", Atk.Object.ObjectAccessibleParentPropertyInfo), '("accessibleRole", Atk.Object.ObjectAccessibleRolePropertyInfo), '("accessibleTableCaption", Atk.Object.ObjectAccessibleTableCaptionPropertyInfo), '("accessibleTableCaptionObject", Atk.Object.ObjectAccessibleTableCaptionObjectPropertyInfo), '("accessibleTableColumnDescription", Atk.Object.ObjectAccessibleTableColumnDescriptionPropertyInfo), '("accessibleTableColumnHeader", Atk.Object.ObjectAccessibleTableColumnHeaderPropertyInfo), '("accessibleTableRowDescription", Atk.Object.ObjectAccessibleTableRowDescriptionPropertyInfo), '("accessibleTableRowHeader", Atk.Object.ObjectAccessibleTableRowHeaderPropertyInfo), '("accessibleTableSummary", Atk.Object.ObjectAccessibleTableSummaryPropertyInfo), '("accessibleValue", Atk.Object.ObjectAccessibleValuePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Plug = PlugSignalList
type PlugSignalList = ('[ '("activeDescendantChanged", Atk.Object.ObjectActiveDescendantChangedSignalInfo), '("boundsChanged", Atk.Component.ComponentBoundsChangedSignalInfo), '("childrenChanged", Atk.Object.ObjectChildrenChangedSignalInfo), '("focusEvent", Atk.Object.ObjectFocusEventSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("propertyChange", Atk.Object.ObjectPropertyChangeSignalInfo), '("stateChange", Atk.Object.ObjectStateChangeSignalInfo), '("visibleDataChanged", Atk.Object.ObjectVisibleDataChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Plug::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Plug" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_plug_new" atk_plug_new :: 
    IO (Ptr Plug)

-- | Creates a new t'GI.Atk.Objects.Plug.Plug' instance.
-- 
-- /Since: 1.30/
plugNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Plug
    -- ^ __Returns:__ the newly created t'GI.Atk.Objects.Plug.Plug'
plugNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Plug
plugNew  = IO Plug -> m Plug
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Plug -> m Plug) -> IO Plug -> m Plug
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plug
result <- IO (Ptr Plug)
atk_plug_new
    Text -> Ptr Plug -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"plugNew" Ptr Plug
result
    Plug
result' <- ((ManagedPtr Plug -> Plug) -> Ptr Plug -> IO Plug
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Plug -> Plug
Plug) Ptr Plug
result
    Plug -> IO Plug
forall (m :: * -> *) a. Monad m => a -> m a
return Plug
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Plug::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plug"
--           , argType = TInterface Name { namespace = "Atk" , name = "Plug" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkPlug" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "atk_plug_get_id" atk_plug_get_id :: 
    Ptr Plug ->                             -- plug : TInterface (Name {namespace = "Atk", name = "Plug"})
    IO CString

-- | Gets the unique ID of an t'GI.Atk.Objects.Plug.Plug' object, which can be used to
-- embed inside of an t'GI.Atk.Objects.Socket.Socket' using 'GI.Atk.Objects.Socket.socketEmbed'.
-- 
-- Internally, this calls a class function that should be registered
-- by the IPC layer (usually at-spi2-atk). The implementor of an
-- t'GI.Atk.Objects.Plug.Plug' object should call this function (after atk-bridge is
-- loaded) and pass the value to the process implementing the
-- t'GI.Atk.Objects.Socket.Socket', so it could embed the plug.
-- 
-- /Since: 1.30/
plugGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlug a) =>
    a
    -- ^ /@plug@/: an t'GI.Atk.Objects.Plug.Plug'
    -> m T.Text
    -- ^ __Returns:__ the unique ID for the plug
plugGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlug a) =>
a -> m Text
plugGetId a
plug = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plug
plug' <- a -> IO (Ptr Plug)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plug
    CString
result <- Ptr Plug -> IO CString
atk_plug_get_id Ptr Plug
plug'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"plugGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plug
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PlugGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPlug a) => O.OverloadedMethod PlugGetIdMethodInfo a signature where
    overloadedMethod = plugGetId

instance O.OverloadedMethodInfo PlugGetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.Plug.plugGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-Plug.html#v:plugGetId"
        })


#endif

-- method Plug::set_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plug"
--           , argType = TInterface Name { namespace = "Atk" , name = "Plug" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an #AtkPlug to be set as accessible parent of @child."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an #AtkObject to be set as accessible child of @plug."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_plug_set_child" atk_plug_set_child :: 
    Ptr Plug ->                             -- plug : TInterface (Name {namespace = "Atk", name = "Plug"})
    Ptr Atk.Object.Object ->                -- child : TInterface (Name {namespace = "Atk", name = "Object"})
    IO ()

-- | Sets /@child@/ as accessible child of /@plug@/ and /@plug@/ as accessible parent of
-- /@child@/. /@child@/ can be NULL.
-- 
-- In some cases, one can not use the AtkPlug type directly as accessible
-- object for the toplevel widget of the application. For instance in the gtk
-- case, GtkPlugAccessible can not inherit both from GtkWindowAccessible and
-- from AtkPlug. In such a case, one can create, in addition to the standard
-- accessible object for the toplevel widget, an AtkPlug object, and make the
-- former the child of the latter by calling 'GI.Atk.Objects.Plug.plugSetChild'.
-- 
-- /Since: 2.35.0/
plugSetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsPlug a, Atk.Object.IsObject b) =>
    a
    -- ^ /@plug@/: an t'GI.Atk.Objects.Plug.Plug' to be set as accessible parent of /@child@/.
    -> b
    -- ^ /@child@/: an t'GI.Atk.Objects.Object.Object' to be set as accessible child of /@plug@/.
    -> m ()
plugSetChild :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPlug a, IsObject b) =>
a -> b -> m ()
plugSetChild a
plug b
child = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Plug
plug' <- a -> IO (Ptr Plug)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plug
    Ptr Object
child' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr Plug -> Ptr Object -> IO ()
atk_plug_set_child Ptr Plug
plug' Ptr Object
child'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plug
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PlugSetChildMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPlug a, Atk.Object.IsObject b) => O.OverloadedMethod PlugSetChildMethodInfo a signature where
    overloadedMethod = plugSetChild

instance O.OverloadedMethodInfo PlugSetChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.Plug.plugSetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-Plug.html#v:plugSetChild"
        })


#endif