{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An AtkRelation describes a relation between an object and one or
-- more other objects. The actual relations that an object has with
-- other objects are defined as an AtkRelationSet, which is a set of
-- AtkRelations.

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

module GI.Atk.Objects.Relation
    ( 

-- * Exported types
    Relation(..)                            ,
    IsRelation                              ,
    toRelation                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addTarget]("GI.Atk.Objects.Relation#g:method:addTarget"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [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"), [removeTarget]("GI.Atk.Objects.Relation#g:method:removeTarget"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [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"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRelationType]("GI.Atk.Objects.Relation#g:method:getRelationType"), [getTarget]("GI.Atk.Objects.Relation#g:method:getTarget").
-- 
-- ==== 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").

#if defined(ENABLE_OVERLOADING)
    ResolveRelationMethod                   ,
#endif

-- ** addTarget #method:addTarget#

#if defined(ENABLE_OVERLOADING)
    RelationAddTargetMethodInfo             ,
#endif
    relationAddTarget                       ,


-- ** getRelationType #method:getRelationType#

#if defined(ENABLE_OVERLOADING)
    RelationGetRelationTypeMethodInfo       ,
#endif
    relationGetRelationType                 ,


-- ** getTarget #method:getTarget#

#if defined(ENABLE_OVERLOADING)
    RelationGetTargetMethodInfo             ,
#endif
    relationGetTarget                       ,


-- ** new #method:new#

    relationNew                             ,


-- ** removeTarget #method:removeTarget#

#if defined(ENABLE_OVERLOADING)
    RelationRemoveTargetMethodInfo          ,
#endif
    relationRemoveTarget                    ,




 -- * Properties


-- ** relationType #attr:relationType#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    RelationRelationTypePropertyInfo        ,
#endif
    constructRelationRelationType           ,
    getRelationRelationType                 ,
#if defined(ENABLE_OVERLOADING)
    relationRelationType                    ,
#endif
    setRelationRelationType                 ,


-- ** target #attr:target#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    RelationTargetPropertyInfo              ,
#endif
    clearRelationTarget                     ,
    constructRelationTarget                 ,
    getRelationTarget                       ,
#if defined(ENABLE_OVERLOADING)
    relationTarget                          ,
#endif
    setRelationTarget                       ,




    ) 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.Enums as Atk.Enums
import {-# SOURCE #-} qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ValueArray as GObject.ValueArray

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

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

foreign import ccall "atk_relation_get_type"
    c_atk_relation_get_type :: IO B.Types.GType

instance B.Types.TypedObject Relation where
    glibType :: IO GType
glibType = IO GType
c_atk_relation_get_type

instance B.Types.GObject Relation

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

instance O.HasParentTypes Relation
type instance O.ParentTypes Relation = '[GObject.Object.Object]

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

-- | Convert 'Relation' 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 Relation) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_atk_relation_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Relation -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Relation
P.Nothing = Ptr GValue -> Ptr Relation -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Relation
forall a. Ptr a
FP.nullPtr :: FP.Ptr Relation)
    gvalueSet_ Ptr GValue
gv (P.Just Relation
obj) = Relation -> (Ptr Relation -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Relation
obj (Ptr GValue -> Ptr Relation -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Relation)
gvalueGet_ Ptr GValue
gv = do
        Ptr Relation
ptr <- Ptr GValue -> IO (Ptr Relation)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Relation)
        if Ptr Relation
ptr Ptr Relation -> Ptr Relation -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Relation
forall a. Ptr a
FP.nullPtr
        then Relation -> Maybe Relation
forall a. a -> Maybe a
P.Just (Relation -> Maybe Relation) -> IO Relation -> IO (Maybe Relation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Relation -> Relation) -> Ptr Relation -> IO Relation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Relation -> Relation
Relation Ptr Relation
ptr
        else Maybe Relation -> IO (Maybe Relation)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Relation
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveRelationMethod (t :: Symbol) (o :: *) :: * where
    ResolveRelationMethod "addTarget" o = RelationAddTargetMethodInfo
    ResolveRelationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRelationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRelationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRelationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRelationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRelationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRelationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRelationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRelationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRelationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRelationMethod "removeTarget" o = RelationRemoveTargetMethodInfo
    ResolveRelationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRelationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRelationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRelationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRelationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRelationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRelationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRelationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRelationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRelationMethod "getRelationType" o = RelationGetRelationTypeMethodInfo
    ResolveRelationMethod "getTarget" o = RelationGetTargetMethodInfo
    ResolveRelationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRelationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRelationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRelationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "relation-type"
   -- Type: TInterface (Name {namespace = "Atk", name = "RelationType"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@relation-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' relation #relationType
-- @
getRelationRelationType :: (MonadIO m, IsRelation o) => o -> m Atk.Enums.RelationType
getRelationRelationType :: forall (m :: * -> *) o.
(MonadIO m, IsRelation o) =>
o -> m RelationType
getRelationRelationType o
obj = IO RelationType -> m RelationType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO RelationType -> m RelationType)
-> IO RelationType -> m RelationType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO RelationType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"relation-type"

-- | Set the value of the “@relation-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' relation [ #relationType 'Data.GI.Base.Attributes.:=' value ]
-- @
setRelationRelationType :: (MonadIO m, IsRelation o) => o -> Atk.Enums.RelationType -> m ()
setRelationRelationType :: forall (m :: * -> *) o.
(MonadIO m, IsRelation o) =>
o -> RelationType -> m ()
setRelationRelationType o
obj RelationType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> RelationType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"relation-type" RelationType
val

-- | Construct a `GValueConstruct` with valid value for the “@relation-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRelationRelationType :: (IsRelation o, MIO.MonadIO m) => Atk.Enums.RelationType -> m (GValueConstruct o)
constructRelationRelationType :: forall o (m :: * -> *).
(IsRelation o, MonadIO m) =>
RelationType -> m (GValueConstruct o)
constructRelationRelationType RelationType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> RelationType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"relation-type" RelationType
val

#if defined(ENABLE_OVERLOADING)
data RelationRelationTypePropertyInfo
instance AttrInfo RelationRelationTypePropertyInfo where
    type AttrAllowedOps RelationRelationTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RelationRelationTypePropertyInfo = IsRelation
    type AttrSetTypeConstraint RelationRelationTypePropertyInfo = (~) Atk.Enums.RelationType
    type AttrTransferTypeConstraint RelationRelationTypePropertyInfo = (~) Atk.Enums.RelationType
    type AttrTransferType RelationRelationTypePropertyInfo = Atk.Enums.RelationType
    type AttrGetType RelationRelationTypePropertyInfo = Atk.Enums.RelationType
    type AttrLabel RelationRelationTypePropertyInfo = "relation-type"
    type AttrOrigin RelationRelationTypePropertyInfo = Relation
    attrGet = getRelationRelationType
    attrSet = setRelationRelationType
    attrTransfer _ v = do
        return v
    attrConstruct = constructRelationRelationType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.Relation.relationType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-Relation.html#g:attr:relationType"
        })
#endif

-- VVV Prop "target"
   -- Type: TInterface (Name {namespace = "GObject", name = "ValueArray"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' relation #target
-- @
getRelationTarget :: (MonadIO m, IsRelation o) => o -> m (Maybe GObject.ValueArray.ValueArray)
getRelationTarget :: forall (m :: * -> *) o.
(MonadIO m, IsRelation o) =>
o -> m (Maybe ValueArray)
getRelationTarget o
obj = IO (Maybe ValueArray) -> m (Maybe ValueArray)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe ValueArray) -> m (Maybe ValueArray))
-> IO (Maybe ValueArray) -> m (Maybe ValueArray)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ValueArray -> ValueArray)
-> IO (Maybe ValueArray)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"target" ManagedPtr ValueArray -> ValueArray
GObject.ValueArray.ValueArray

-- | Set the value of the “@target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' relation [ #target 'Data.GI.Base.Attributes.:=' value ]
-- @
setRelationTarget :: (MonadIO m, IsRelation o) => o -> GObject.ValueArray.ValueArray -> m ()
setRelationTarget :: forall (m :: * -> *) o.
(MonadIO m, IsRelation o) =>
o -> ValueArray -> m ()
setRelationTarget o
obj ValueArray
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe ValueArray -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"target" (ValueArray -> Maybe ValueArray
forall a. a -> Maybe a
Just ValueArray
val)

-- | Construct a `GValueConstruct` with valid value for the “@target@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRelationTarget :: (IsRelation o, MIO.MonadIO m) => GObject.ValueArray.ValueArray -> m (GValueConstruct o)
constructRelationTarget :: forall o (m :: * -> *).
(IsRelation o, MonadIO m) =>
ValueArray -> m (GValueConstruct o)
constructRelationTarget ValueArray
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Maybe ValueArray -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"target" (ValueArray -> Maybe ValueArray
forall a. a -> Maybe a
P.Just ValueArray
val)

-- | Set the value of the “@target@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #target
-- @
clearRelationTarget :: (MonadIO m, IsRelation o) => o -> m ()
clearRelationTarget :: forall (m :: * -> *) o. (MonadIO m, IsRelation o) => o -> m ()
clearRelationTarget o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ValueArray -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"target" (Maybe ValueArray
forall a. Maybe a
Nothing :: Maybe GObject.ValueArray.ValueArray)

#if defined(ENABLE_OVERLOADING)
data RelationTargetPropertyInfo
instance AttrInfo RelationTargetPropertyInfo where
    type AttrAllowedOps RelationTargetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RelationTargetPropertyInfo = IsRelation
    type AttrSetTypeConstraint RelationTargetPropertyInfo = (~) GObject.ValueArray.ValueArray
    type AttrTransferTypeConstraint RelationTargetPropertyInfo = (~) GObject.ValueArray.ValueArray
    type AttrTransferType RelationTargetPropertyInfo = GObject.ValueArray.ValueArray
    type AttrGetType RelationTargetPropertyInfo = (Maybe GObject.ValueArray.ValueArray)
    type AttrLabel RelationTargetPropertyInfo = "target"
    type AttrOrigin RelationTargetPropertyInfo = Relation
    attrGet = getRelationTarget
    attrSet = setRelationTarget
    attrTransfer _ v = do
        return v
    attrConstruct = constructRelationTarget
    attrClear = clearRelationTarget
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.Relation.target"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-Relation.html#g:attr:target"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Relation
type instance O.AttributeList Relation = RelationAttributeList
type RelationAttributeList = ('[ '("relationType", RelationRelationTypePropertyInfo), '("target", RelationTargetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
relationRelationType :: AttrLabelProxy "relationType"
relationRelationType = AttrLabelProxy

relationTarget :: AttrLabelProxy "target"
relationTarget = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Relation = RelationSignalList
type RelationSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Relation::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "targets"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Atk" , name = "Object" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of pointers to\n #AtkObjects"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_targets"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of #AtkObjects pointed to by @targets"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "relationship"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "RelationType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an #AtkRelationType with which to create the new\n #AtkRelation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_targets"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of #AtkObjects pointed to by @targets"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Relation" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_relation_new" atk_relation_new :: 
    Ptr (Ptr Atk.Object.Object) ->          -- targets : TCArray False (-1) 1 (TInterface (Name {namespace = "Atk", name = "Object"}))
    Int32 ->                                -- n_targets : TBasicType TInt
    CUInt ->                                -- relationship : TInterface (Name {namespace = "Atk", name = "RelationType"})
    IO (Ptr Relation)

-- | Create a new relation for the specified key and the specified list
-- of targets.  See also 'GI.Atk.Objects.Object.objectAddRelationship'.
relationNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Atk.Object.Object]
    -- ^ /@targets@/: an array of pointers to
    --  @/AtkObjects/@
    -> Atk.Enums.RelationType
    -- ^ /@relationship@/: an t'GI.Atk.Enums.RelationType' with which to create the new
    --  t'GI.Atk.Objects.Relation.Relation'
    -> m Relation
    -- ^ __Returns:__ a pointer to a new t'GI.Atk.Objects.Relation.Relation'
relationNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Object] -> RelationType -> m Relation
relationNew [Object]
targets RelationType
relationship = IO Relation -> m Relation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Relation -> m Relation) -> IO Relation -> m Relation
forall a b. (a -> b) -> a -> b
$ do
    let nTargets :: Int32
nTargets = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [Object] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Object]
targets
    [Ptr Object]
targets' <- (Object -> IO (Ptr Object)) -> [Object] -> IO [Ptr Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Object -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Object]
targets
    Ptr (Ptr Object)
targets'' <- [Ptr Object] -> IO (Ptr (Ptr Object))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Object]
targets'
    let relationship' :: CUInt
relationship' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (RelationType -> Int) -> RelationType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationType -> Int
forall a. Enum a => a -> Int
fromEnum) RelationType
relationship
    Ptr Relation
result <- Ptr (Ptr Object) -> Int32 -> CUInt -> IO (Ptr Relation)
atk_relation_new Ptr (Ptr Object)
targets'' Int32
nTargets CUInt
relationship'
    Text -> Ptr Relation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"relationNew" Ptr Relation
result
    Relation
result' <- ((ManagedPtr Relation -> Relation) -> Ptr Relation -> IO Relation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Relation -> Relation
Relation) Ptr Relation
result
    (Object -> IO ()) -> [Object] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Object]
targets
    Ptr (Ptr Object) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Object)
targets''
    Relation -> IO Relation
forall (m :: * -> *) a. Monad m => a -> m a
return Relation
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Relation::add_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "relation"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Relation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkRelation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_relation_add_target" atk_relation_add_target :: 
    Ptr Relation ->                         -- relation : TInterface (Name {namespace = "Atk", name = "Relation"})
    Ptr Atk.Object.Object ->                -- target : TInterface (Name {namespace = "Atk", name = "Object"})
    IO ()

-- | Adds the specified AtkObject to the target for the relation, if it is
-- not already present.  See also 'GI.Atk.Objects.Object.objectAddRelationship'.
-- 
-- /Since: 1.9/
relationAddTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsRelation a, Atk.Object.IsObject b) =>
    a
    -- ^ /@relation@/: an t'GI.Atk.Objects.Relation.Relation'
    -> b
    -- ^ /@target@/: an t'GI.Atk.Objects.Object.Object'
    -> m ()
relationAddTarget :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRelation a, IsObject b) =>
a -> b -> m ()
relationAddTarget a
relation b
target = 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 Relation
relation' <- a -> IO (Ptr Relation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
relation
    Ptr Object
target' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
target
    Ptr Relation -> Ptr Object -> IO ()
atk_relation_add_target Ptr Relation
relation' Ptr Object
target'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
relation
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

foreign import ccall "atk_relation_get_relation_type" atk_relation_get_relation_type :: 
    Ptr Relation ->                         -- relation : TInterface (Name {namespace = "Atk", name = "Relation"})
    IO CUInt

-- | Gets the type of /@relation@/
relationGetRelationType ::
    (B.CallStack.HasCallStack, MonadIO m, IsRelation a) =>
    a
    -- ^ /@relation@/: an t'GI.Atk.Objects.Relation.Relation'
    -> m Atk.Enums.RelationType
    -- ^ __Returns:__ the type of /@relation@/
relationGetRelationType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRelation a) =>
a -> m RelationType
relationGetRelationType a
relation = IO RelationType -> m RelationType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RelationType -> m RelationType)
-> IO RelationType -> m RelationType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Relation
relation' <- a -> IO (Ptr Relation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
relation
    CUInt
result <- Ptr Relation -> IO CUInt
atk_relation_get_relation_type Ptr Relation
relation'
    let result' :: RelationType
result' = (Int -> RelationType
forall a. Enum a => Int -> a
toEnum (Int -> RelationType) -> (CUInt -> Int) -> CUInt -> RelationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
relation
    RelationType -> IO RelationType
forall (m :: * -> *) a. Monad m => a -> m a
return RelationType
result'

#if defined(ENABLE_OVERLOADING)
data RelationGetRelationTypeMethodInfo
instance (signature ~ (m Atk.Enums.RelationType), MonadIO m, IsRelation a) => O.OverloadedMethod RelationGetRelationTypeMethodInfo a signature where
    overloadedMethod = relationGetRelationType

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


#endif

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

foreign import ccall "atk_relation_get_target" atk_relation_get_target :: 
    Ptr Relation ->                         -- relation : TInterface (Name {namespace = "Atk", name = "Relation"})
    IO (Ptr (GPtrArray (Ptr Atk.Object.Object)))

-- | Gets the target list of /@relation@/
relationGetTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsRelation a) =>
    a
    -- ^ /@relation@/: an t'GI.Atk.Objects.Relation.Relation'
    -> m [Atk.Object.Object]
    -- ^ __Returns:__ the target list of /@relation@/
relationGetTarget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRelation a) =>
a -> m [Object]
relationGetTarget a
relation = IO [Object] -> m [Object]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Object] -> m [Object]) -> IO [Object] -> m [Object]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Relation
relation' <- a -> IO (Ptr Relation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
relation
    Ptr (GPtrArray (Ptr Object))
result <- Ptr Relation -> IO (Ptr (GPtrArray (Ptr Object)))
atk_relation_get_target Ptr Relation
relation'
    Text -> Ptr (GPtrArray (Ptr Object)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"relationGetTarget" Ptr (GPtrArray (Ptr Object))
result
    [Ptr Object]
result' <- Ptr (GPtrArray (Ptr Object)) -> IO [Ptr Object]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr Object))
result
    [Object]
result'' <- (Ptr Object -> IO Object) -> [Ptr Object] -> IO [Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Atk.Object.Object) [Ptr Object]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
relation
    [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return [Object]
result''

#if defined(ENABLE_OVERLOADING)
data RelationGetTargetMethodInfo
instance (signature ~ (m [Atk.Object.Object]), MonadIO m, IsRelation a) => O.OverloadedMethod RelationGetTargetMethodInfo a signature where
    overloadedMethod = relationGetTarget

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


#endif

-- method Relation::remove_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "relation"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Relation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkRelation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkObject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "atk_relation_remove_target" atk_relation_remove_target :: 
    Ptr Relation ->                         -- relation : TInterface (Name {namespace = "Atk", name = "Relation"})
    Ptr Atk.Object.Object ->                -- target : TInterface (Name {namespace = "Atk", name = "Object"})
    IO CInt

-- | Remove the specified AtkObject from the target for the relation.
relationRemoveTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsRelation a, Atk.Object.IsObject b) =>
    a
    -- ^ /@relation@/: an t'GI.Atk.Objects.Relation.Relation'
    -> b
    -- ^ /@target@/: an t'GI.Atk.Objects.Object.Object'
    -> m Bool
    -- ^ __Returns:__ TRUE if the removal is successful.
relationRemoveTarget :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsRelation a, IsObject b) =>
a -> b -> m Bool
relationRemoveTarget a
relation b
target = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Relation
relation' <- a -> IO (Ptr Relation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
relation
    Ptr Object
target' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
target
    CInt
result <- Ptr Relation -> Ptr Object -> IO CInt
atk_relation_remove_target Ptr Relation
relation' Ptr Object
target'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
relation
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RelationRemoveTargetMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsRelation a, Atk.Object.IsObject b) => O.OverloadedMethod RelationRemoveTargetMethodInfo a signature where
    overloadedMethod = relationRemoveTarget

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


#endif