{-# 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.Dazzle.Objects.ChildPropertyAction
    ( 

-- * Exported types
    ChildPropertyAction(..)                 ,
    IsChildPropertyAction                   ,
    toChildPropertyAction                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activate]("GI.Gio.Interfaces.Action#g:method:activate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [changeState]("GI.Gio.Interfaces.Action#g:method:changeState"), [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"), [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"), [getEnabled]("GI.Gio.Interfaces.Action#g:method:getEnabled"), [getName]("GI.Gio.Interfaces.Action#g:method:getName"), [getParameterType]("GI.Gio.Interfaces.Action#g:method:getParameterType"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getState]("GI.Gio.Interfaces.Action#g:method:getState"), [getStateHint]("GI.Gio.Interfaces.Action#g:method:getStateHint"), [getStateType]("GI.Gio.Interfaces.Action#g:method:getStateType").
-- 
-- ==== 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)
    ResolveChildPropertyActionMethod        ,
#endif

-- ** new #method:new#

    childPropertyActionNew                  ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    ChildPropertyActionChildPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    childPropertyActionChild                ,
#endif
    getChildPropertyActionChild             ,


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

#if defined(ENABLE_OVERLOADING)
    ChildPropertyActionChildPropertyNamePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    childPropertyActionChildPropertyName    ,
#endif
    getChildPropertyActionChildPropertyName ,


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

#if defined(ENABLE_OVERLOADING)
    ChildPropertyActionContainerPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    childPropertyActionContainer            ,
#endif
    getChildPropertyActionContainer         ,




    ) 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Action as Gio.Action
import qualified GI.Gtk.Objects.Container as Gtk.Container
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Action as Gio.Action
import qualified GI.Gtk.Objects.Container as Gtk.Container
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_child_property_action_get_type"
    c_dzl_child_property_action_get_type :: IO B.Types.GType

instance B.Types.TypedObject ChildPropertyAction where
    glibType :: IO GType
glibType = IO GType
c_dzl_child_property_action_get_type

instance B.Types.GObject ChildPropertyAction

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

instance O.HasParentTypes ChildPropertyAction
type instance O.ParentTypes ChildPropertyAction = '[GObject.Object.Object, Gio.Action.Action]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveChildPropertyActionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveChildPropertyActionMethod "activate" o = Gio.Action.ActionActivateMethodInfo
    ResolveChildPropertyActionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveChildPropertyActionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveChildPropertyActionMethod "changeState" o = Gio.Action.ActionChangeStateMethodInfo
    ResolveChildPropertyActionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveChildPropertyActionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveChildPropertyActionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveChildPropertyActionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveChildPropertyActionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveChildPropertyActionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveChildPropertyActionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveChildPropertyActionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveChildPropertyActionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveChildPropertyActionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveChildPropertyActionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveChildPropertyActionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveChildPropertyActionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveChildPropertyActionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveChildPropertyActionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveChildPropertyActionMethod "getEnabled" o = Gio.Action.ActionGetEnabledMethodInfo
    ResolveChildPropertyActionMethod "getName" o = Gio.Action.ActionGetNameMethodInfo
    ResolveChildPropertyActionMethod "getParameterType" o = Gio.Action.ActionGetParameterTypeMethodInfo
    ResolveChildPropertyActionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveChildPropertyActionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveChildPropertyActionMethod "getState" o = Gio.Action.ActionGetStateMethodInfo
    ResolveChildPropertyActionMethod "getStateHint" o = Gio.Action.ActionGetStateHintMethodInfo
    ResolveChildPropertyActionMethod "getStateType" o = Gio.Action.ActionGetStateTypeMethodInfo
    ResolveChildPropertyActionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveChildPropertyActionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveChildPropertyActionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveChildPropertyActionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "child"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Widget"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ChildPropertyActionChildPropertyInfo
instance AttrInfo ChildPropertyActionChildPropertyInfo where
    type AttrAllowedOps ChildPropertyActionChildPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ChildPropertyActionChildPropertyInfo = IsChildPropertyAction
    type AttrSetTypeConstraint ChildPropertyActionChildPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ChildPropertyActionChildPropertyInfo = (~) ()
    type AttrTransferType ChildPropertyActionChildPropertyInfo = ()
    type AttrGetType ChildPropertyActionChildPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel ChildPropertyActionChildPropertyInfo = "child"
    type AttrOrigin ChildPropertyActionChildPropertyInfo = ChildPropertyAction
    attrGet = getChildPropertyActionChild
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ChildPropertyAction.child"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ChildPropertyAction.html#g:attr:child"
        })
#endif

-- VVV Prop "child-property-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@child-property-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' childPropertyAction #childPropertyName
-- @
getChildPropertyActionChildPropertyName :: (MonadIO m, IsChildPropertyAction o) => o -> m (Maybe T.Text)
getChildPropertyActionChildPropertyName :: forall (m :: * -> *) o.
(MonadIO m, IsChildPropertyAction o) =>
o -> m (Maybe Text)
getChildPropertyActionChildPropertyName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"child-property-name"

#if defined(ENABLE_OVERLOADING)
data ChildPropertyActionChildPropertyNamePropertyInfo
instance AttrInfo ChildPropertyActionChildPropertyNamePropertyInfo where
    type AttrAllowedOps ChildPropertyActionChildPropertyNamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ChildPropertyActionChildPropertyNamePropertyInfo = IsChildPropertyAction
    type AttrSetTypeConstraint ChildPropertyActionChildPropertyNamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ChildPropertyActionChildPropertyNamePropertyInfo = (~) ()
    type AttrTransferType ChildPropertyActionChildPropertyNamePropertyInfo = ()
    type AttrGetType ChildPropertyActionChildPropertyNamePropertyInfo = (Maybe T.Text)
    type AttrLabel ChildPropertyActionChildPropertyNamePropertyInfo = "child-property-name"
    type AttrOrigin ChildPropertyActionChildPropertyNamePropertyInfo = ChildPropertyAction
    attrGet = getChildPropertyActionChildPropertyName
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ChildPropertyAction.childPropertyName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ChildPropertyAction.html#g:attr:childPropertyName"
        })
#endif

-- VVV Prop "container"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Container"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ChildPropertyActionContainerPropertyInfo
instance AttrInfo ChildPropertyActionContainerPropertyInfo where
    type AttrAllowedOps ChildPropertyActionContainerPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ChildPropertyActionContainerPropertyInfo = IsChildPropertyAction
    type AttrSetTypeConstraint ChildPropertyActionContainerPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ChildPropertyActionContainerPropertyInfo = (~) ()
    type AttrTransferType ChildPropertyActionContainerPropertyInfo = ()
    type AttrGetType ChildPropertyActionContainerPropertyInfo = (Maybe Gtk.Container.Container)
    type AttrLabel ChildPropertyActionContainerPropertyInfo = "container"
    type AttrOrigin ChildPropertyActionContainerPropertyInfo = ChildPropertyAction
    attrGet = getChildPropertyActionContainer
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ChildPropertyAction.container"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ChildPropertyAction.html#g:attr:container"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ChildPropertyAction
type instance O.AttributeList ChildPropertyAction = ChildPropertyActionAttributeList
type ChildPropertyActionAttributeList = ('[ '("child", ChildPropertyActionChildPropertyInfo), '("childPropertyName", ChildPropertyActionChildPropertyNamePropertyInfo), '("container", ChildPropertyActionContainerPropertyInfo), '("enabled", Gio.Action.ActionEnabledPropertyInfo), '("name", Gio.Action.ActionNamePropertyInfo), '("parameterType", Gio.Action.ActionParameterTypePropertyInfo), '("state", Gio.Action.ActionStatePropertyInfo), '("stateType", Gio.Action.ActionStateTypePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
childPropertyActionChild :: AttrLabelProxy "child"
childPropertyActionChild = AttrLabelProxy

childPropertyActionChildPropertyName :: AttrLabelProxy "childPropertyName"
childPropertyActionChildPropertyName = AttrLabelProxy

childPropertyActionContainer :: AttrLabelProxy "container"
childPropertyActionContainer = AttrLabelProxy

#endif

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

#endif

-- method ChildPropertyAction::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "container"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Container" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the container of the widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the widget for the child property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child_property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the child property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Action" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_child_property_action_new" dzl_child_property_action_new :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gtk.Container.Container ->          -- container : TInterface (Name {namespace = "Gtk", name = "Container"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CString ->                              -- child_property_name : TBasicType TUTF8
    IO (Ptr Gio.Action.Action)

-- | This creates a new t'GI.Gio.Interfaces.Action.Action' that will change when the underlying child
-- property of /@container@/ changes for /@child@/.
childPropertyActionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Container.IsContainer a, Gtk.Widget.IsWidget b) =>
    T.Text
    -- ^ /@name@/: the name of the action
    -> a
    -- ^ /@container@/: the container of the widget
    -> b
    -- ^ /@child@/: the widget for the child property
    -> T.Text
    -- ^ /@childPropertyName@/: the name of the child property
    -> m Gio.Action.Action
    -- ^ __Returns:__ A new t'GI.Dazzle.Objects.ChildPropertyAction.ChildPropertyAction'.
childPropertyActionNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
Text -> a -> b -> Text -> m Action
childPropertyActionNew Text
name a
container b
child Text
childPropertyName = IO Action -> m Action
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> m Action) -> IO Action -> m Action
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Container
container' <- a -> IO (Ptr Container)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
container
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    CString
childPropertyName' <- Text -> IO CString
textToCString Text
childPropertyName
    Ptr Action
result <- CString
-> Ptr Container -> Ptr Widget -> CString -> IO (Ptr Action)
dzl_child_property_action_new CString
name' Ptr Container
container' Ptr Widget
child' CString
childPropertyName'
    Text -> Ptr Action -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"childPropertyActionNew" Ptr Action
result
    Action
result' <- ((ManagedPtr Action -> Action) -> Ptr Action -> IO Action
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Action -> Action
Gio.Action.Action) Ptr Action
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
container
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
childPropertyName'
    Action -> IO Action
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Action
result'

#if defined(ENABLE_OVERLOADING)
#endif