{-# 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.PropertiesGroup
    ( 

-- * Exported types
    PropertiesGroup(..)                     ,
    IsPropertiesGroup                       ,
    toPropertiesGroup                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionAdded]("GI.Gio.Interfaces.ActionGroup#g:method:actionAdded"), [actionEnabledChanged]("GI.Gio.Interfaces.ActionGroup#g:method:actionEnabledChanged"), [actionRemoved]("GI.Gio.Interfaces.ActionGroup#g:method:actionRemoved"), [actionStateChanged]("GI.Gio.Interfaces.ActionGroup#g:method:actionStateChanged"), [activateAction]("GI.Gio.Interfaces.ActionGroup#g:method:activateAction"), [addAllProperties]("GI.Dazzle.Objects.PropertiesGroup#g:method:addAllProperties"), [addProperty]("GI.Dazzle.Objects.PropertiesGroup#g:method:addProperty"), [addPropertyFull]("GI.Dazzle.Objects.PropertiesGroup#g:method:addPropertyFull"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [changeActionState]("GI.Gio.Interfaces.ActionGroup#g:method:changeActionState"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasAction]("GI.Gio.Interfaces.ActionGroup#g:method:hasAction"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [listActions]("GI.Gio.Interfaces.ActionGroup#g:method:listActions"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [queryAction]("GI.Gio.Interfaces.ActionGroup#g:method:queryAction"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Dazzle.Objects.PropertiesGroup#g:method:remove"), [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
-- [getActionEnabled]("GI.Gio.Interfaces.ActionGroup#g:method:getActionEnabled"), [getActionParameterType]("GI.Gio.Interfaces.ActionGroup#g:method:getActionParameterType"), [getActionState]("GI.Gio.Interfaces.ActionGroup#g:method:getActionState"), [getActionStateHint]("GI.Gio.Interfaces.ActionGroup#g:method:getActionStateHint"), [getActionStateType]("GI.Gio.Interfaces.ActionGroup#g:method:getActionStateType"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== 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)
    ResolvePropertiesGroupMethod            ,
#endif

-- ** addAllProperties #method:addAllProperties#

#if defined(ENABLE_OVERLOADING)
    PropertiesGroupAddAllPropertiesMethodInfo,
#endif
    propertiesGroupAddAllProperties         ,


-- ** addProperty #method:addProperty#

#if defined(ENABLE_OVERLOADING)
    PropertiesGroupAddPropertyMethodInfo    ,
#endif
    propertiesGroupAddProperty              ,


-- ** addPropertyFull #method:addPropertyFull#

#if defined(ENABLE_OVERLOADING)
    PropertiesGroupAddPropertyFullMethodInfo,
#endif
    propertiesGroupAddPropertyFull          ,


-- ** new #method:new#

    propertiesGroupNew                      ,


-- ** newForType #method:newForType#

    propertiesGroupNewForType               ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    PropertiesGroupRemoveMethodInfo         ,
#endif
    propertiesGroupRemove                   ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    PropertiesGroupObjectPropertyInfo       ,
#endif
    clearPropertiesGroupObject              ,
    constructPropertiesGroupObject          ,
    getPropertiesGroupObject                ,
#if defined(ENABLE_OVERLOADING)
    propertiesGroupObject                   ,
#endif
    setPropertiesGroupObject                ,


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

#if defined(ENABLE_OVERLOADING)
    PropertiesGroupObjectTypePropertyInfo   ,
#endif
    constructPropertiesGroupObjectType      ,
    getPropertiesGroupObjectType            ,
#if defined(ENABLE_OVERLOADING)
    propertiesGroupObjectType               ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

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

#else
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup

#endif

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

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

foreign import ccall "dzl_properties_group_get_type"
    c_dzl_properties_group_get_type :: IO B.Types.GType

instance B.Types.TypedObject PropertiesGroup where
    glibType :: IO GType
glibType = IO GType
c_dzl_properties_group_get_type

instance B.Types.GObject PropertiesGroup

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

instance O.HasParentTypes PropertiesGroup
type instance O.ParentTypes PropertiesGroup = '[GObject.Object.Object, Gio.ActionGroup.ActionGroup]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePropertiesGroupMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePropertiesGroupMethod "actionAdded" o = Gio.ActionGroup.ActionGroupActionAddedMethodInfo
    ResolvePropertiesGroupMethod "actionEnabledChanged" o = Gio.ActionGroup.ActionGroupActionEnabledChangedMethodInfo
    ResolvePropertiesGroupMethod "actionRemoved" o = Gio.ActionGroup.ActionGroupActionRemovedMethodInfo
    ResolvePropertiesGroupMethod "actionStateChanged" o = Gio.ActionGroup.ActionGroupActionStateChangedMethodInfo
    ResolvePropertiesGroupMethod "activateAction" o = Gio.ActionGroup.ActionGroupActivateActionMethodInfo
    ResolvePropertiesGroupMethod "addAllProperties" o = PropertiesGroupAddAllPropertiesMethodInfo
    ResolvePropertiesGroupMethod "addProperty" o = PropertiesGroupAddPropertyMethodInfo
    ResolvePropertiesGroupMethod "addPropertyFull" o = PropertiesGroupAddPropertyFullMethodInfo
    ResolvePropertiesGroupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePropertiesGroupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePropertiesGroupMethod "changeActionState" o = Gio.ActionGroup.ActionGroupChangeActionStateMethodInfo
    ResolvePropertiesGroupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePropertiesGroupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePropertiesGroupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePropertiesGroupMethod "hasAction" o = Gio.ActionGroup.ActionGroupHasActionMethodInfo
    ResolvePropertiesGroupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePropertiesGroupMethod "listActions" o = Gio.ActionGroup.ActionGroupListActionsMethodInfo
    ResolvePropertiesGroupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePropertiesGroupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePropertiesGroupMethod "queryAction" o = Gio.ActionGroup.ActionGroupQueryActionMethodInfo
    ResolvePropertiesGroupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePropertiesGroupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePropertiesGroupMethod "remove" o = PropertiesGroupRemoveMethodInfo
    ResolvePropertiesGroupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePropertiesGroupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePropertiesGroupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePropertiesGroupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePropertiesGroupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePropertiesGroupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePropertiesGroupMethod "getActionEnabled" o = Gio.ActionGroup.ActionGroupGetActionEnabledMethodInfo
    ResolvePropertiesGroupMethod "getActionParameterType" o = Gio.ActionGroup.ActionGroupGetActionParameterTypeMethodInfo
    ResolvePropertiesGroupMethod "getActionState" o = Gio.ActionGroup.ActionGroupGetActionStateMethodInfo
    ResolvePropertiesGroupMethod "getActionStateHint" o = Gio.ActionGroup.ActionGroupGetActionStateHintMethodInfo
    ResolvePropertiesGroupMethod "getActionStateType" o = Gio.ActionGroup.ActionGroupGetActionStateTypeMethodInfo
    ResolvePropertiesGroupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePropertiesGroupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePropertiesGroupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePropertiesGroupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePropertiesGroupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePropertiesGroupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePropertiesGroupMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

-- | Set the value of the “@object@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' propertiesGroup [ #object 'Data.GI.Base.Attributes.:=' value ]
-- @
setPropertiesGroupObject :: (MonadIO m, IsPropertiesGroup o, GObject.Object.IsObject a) => o -> a -> m ()
setPropertiesGroupObject :: forall (m :: * -> *) o a.
(MonadIO m, IsPropertiesGroup o, IsObject a) =>
o -> a -> m ()
setPropertiesGroupObject o
obj a
val = IO () -> m ()
forall a. IO a -> m a
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 a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"object" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@object@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPropertiesGroupObject :: (IsPropertiesGroup o, MIO.MonadIO m, GObject.Object.IsObject a) => a -> m (GValueConstruct o)
constructPropertiesGroupObject :: forall o (m :: * -> *) a.
(IsPropertiesGroup o, MonadIO m, IsObject a) =>
a -> m (GValueConstruct o)
constructPropertiesGroupObject a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"object" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@object@” 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' #object
-- @
clearPropertiesGroupObject :: (MonadIO m, IsPropertiesGroup o) => o -> m ()
clearPropertiesGroupObject :: forall (m :: * -> *) o.
(MonadIO m, IsPropertiesGroup o) =>
o -> m ()
clearPropertiesGroupObject o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Object -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"object" (Maybe Object
forall a. Maybe a
Nothing :: Maybe GObject.Object.Object)

#if defined(ENABLE_OVERLOADING)
data PropertiesGroupObjectPropertyInfo
instance AttrInfo PropertiesGroupObjectPropertyInfo where
    type AttrAllowedOps PropertiesGroupObjectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PropertiesGroupObjectPropertyInfo = IsPropertiesGroup
    type AttrSetTypeConstraint PropertiesGroupObjectPropertyInfo = GObject.Object.IsObject
    type AttrTransferTypeConstraint PropertiesGroupObjectPropertyInfo = GObject.Object.IsObject
    type AttrTransferType PropertiesGroupObjectPropertyInfo = GObject.Object.Object
    type AttrGetType PropertiesGroupObjectPropertyInfo = (Maybe GObject.Object.Object)
    type AttrLabel PropertiesGroupObjectPropertyInfo = "object"
    type AttrOrigin PropertiesGroupObjectPropertyInfo = PropertiesGroup
    attrGet = getPropertiesGroupObject
    attrSet = setPropertiesGroupObject
    attrTransfer _ v = do
        unsafeCastTo GObject.Object.Object v
    attrConstruct = constructPropertiesGroupObject
    attrClear = clearPropertiesGroupObject
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PropertiesGroup.object"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PropertiesGroup.html#g:attr:object"
        })
#endif

-- VVV Prop "object-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

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

#if defined(ENABLE_OVERLOADING)
data PropertiesGroupObjectTypePropertyInfo
instance AttrInfo PropertiesGroupObjectTypePropertyInfo where
    type AttrAllowedOps PropertiesGroupObjectTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PropertiesGroupObjectTypePropertyInfo = IsPropertiesGroup
    type AttrSetTypeConstraint PropertiesGroupObjectTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint PropertiesGroupObjectTypePropertyInfo = (~) GType
    type AttrTransferType PropertiesGroupObjectTypePropertyInfo = GType
    type AttrGetType PropertiesGroupObjectTypePropertyInfo = GType
    type AttrLabel PropertiesGroupObjectTypePropertyInfo = "object-type"
    type AttrOrigin PropertiesGroupObjectTypePropertyInfo = PropertiesGroup
    attrGet = getPropertiesGroupObjectType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPropertiesGroupObjectType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PropertiesGroup.objectType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PropertiesGroup.html#g:attr:objectType"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PropertiesGroup
type instance O.AttributeList PropertiesGroup = PropertiesGroupAttributeList
type PropertiesGroupAttributeList = ('[ '("object", PropertiesGroupObjectPropertyInfo), '("objectType", PropertiesGroupObjectTypePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
propertiesGroupObject :: AttrLabelProxy "object"
propertiesGroupObject = AttrLabelProxy

propertiesGroupObjectType :: AttrLabelProxy "objectType"
propertiesGroupObjectType = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PropertiesGroup = PropertiesGroupSignalList
type PropertiesGroupSignalList = ('[ '("actionAdded", Gio.ActionGroup.ActionGroupActionAddedSignalInfo), '("actionEnabledChanged", Gio.ActionGroup.ActionGroupActionEnabledChangedSignalInfo), '("actionRemoved", Gio.ActionGroup.ActionGroupActionRemovedSignalInfo), '("actionStateChanged", Gio.ActionGroup.ActionGroupActionStateChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method PropertiesGroup::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The object containing the properties"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "PropertiesGroup" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_properties_group_new" dzl_properties_group_new :: 
    Ptr GObject.Object.Object ->            -- object : TInterface (Name {namespace = "GObject", name = "Object"})
    IO (Ptr PropertiesGroup)

-- | This creates a new t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup' to create stateful actions
-- around properties in /@object@/.
-- 
-- Call 'GI.Dazzle.Objects.PropertiesGroup.propertiesGroupAddProperty' to add a property to
-- action name mapping for this group. Until you\'ve called this,
-- no actions are mapped.
-- 
-- Note that t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup' only holds a weak reference to
-- /@object@/ and therefore you must keep /@object@/ alive elsewhere.
-- 
-- /Since: 3.26/
propertiesGroupNew ::
    (B.CallStack.HasCallStack, MonadIO m, GObject.Object.IsObject a) =>
    a
    -- ^ /@object@/: The object containing the properties
    -> m PropertiesGroup
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup'
propertiesGroupNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsObject a) =>
a -> m PropertiesGroup
propertiesGroupNew a
object = IO PropertiesGroup -> m PropertiesGroup
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropertiesGroup -> m PropertiesGroup)
-> IO PropertiesGroup -> m PropertiesGroup
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- a -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
object
    Ptr PropertiesGroup
result <- Ptr Object -> IO (Ptr PropertiesGroup)
dzl_properties_group_new Ptr Object
object'
    Text -> Ptr PropertiesGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertiesGroupNew" Ptr PropertiesGroup
result
    PropertiesGroup
result' <- ((ManagedPtr PropertiesGroup -> PropertiesGroup)
-> Ptr PropertiesGroup -> IO PropertiesGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PropertiesGroup -> PropertiesGroup
PropertiesGroup) Ptr PropertiesGroup
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
object
    PropertiesGroup -> IO PropertiesGroup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PropertiesGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PropertiesGroup::new_for_type
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "object_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GObjectClass based type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "PropertiesGroup" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_properties_group_new_for_type" dzl_properties_group_new_for_type :: 
    CGType ->                               -- object_type : TBasicType TGType
    IO (Ptr PropertiesGroup)

-- | This creates a new t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup' for which the initial object is
-- 'P.Nothing'.
-- 
-- Set /@objectType@/ to a type of a class which is a t'GI.GObject.Objects.Object.Object'-based type.
propertiesGroupNewForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@objectType@/: A t'GI.GObject.Structs.ObjectClass.ObjectClass' based type
    -> m PropertiesGroup
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup'.
propertiesGroupNewForType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> m PropertiesGroup
propertiesGroupNewForType GType
objectType = IO PropertiesGroup -> m PropertiesGroup
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropertiesGroup -> m PropertiesGroup)
-> IO PropertiesGroup -> m PropertiesGroup
forall a b. (a -> b) -> a -> b
$ do
    let objectType' :: CGType
objectType' = GType -> CGType
gtypeToCGType GType
objectType
    Ptr PropertiesGroup
result <- CGType -> IO (Ptr PropertiesGroup)
dzl_properties_group_new_for_type CGType
objectType'
    Text -> Ptr PropertiesGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propertiesGroupNewForType" Ptr PropertiesGroup
result
    PropertiesGroup
result' <- ((ManagedPtr PropertiesGroup -> PropertiesGroup)
-> Ptr PropertiesGroup -> IO PropertiesGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PropertiesGroup -> PropertiesGroup
PropertiesGroup) Ptr PropertiesGroup
result
    PropertiesGroup -> IO PropertiesGroup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PropertiesGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PropertiesGroup::add_all_properties
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PropertiesGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlPropertiesGroup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_properties_group_add_all_properties" dzl_properties_group_add_all_properties :: 
    Ptr PropertiesGroup ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "PropertiesGroup"})
    IO ()

-- | This function will try to add all properties found on the target
-- instance to the group. Only properties that are supported by the
-- t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup' will be added.
-- 
-- The action name of all added properties will be identical to their
-- property name.
-- 
-- /Since: 3.26/
propertiesGroupAddAllProperties ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropertiesGroup a) =>
    a
    -- ^ /@self@/: A t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup'
    -> m ()
propertiesGroupAddAllProperties :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPropertiesGroup a) =>
a -> m ()
propertiesGroupAddAllProperties a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropertiesGroup
self' <- a -> IO (Ptr PropertiesGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr PropertiesGroup -> IO ()
dzl_properties_group_add_all_properties Ptr PropertiesGroup
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertiesGroupAddAllPropertiesMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPropertiesGroup a) => O.OverloadedMethod PropertiesGroupAddAllPropertiesMethodInfo a signature where
    overloadedMethod = propertiesGroupAddAllProperties

instance O.OverloadedMethodInfo PropertiesGroupAddAllPropertiesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PropertiesGroup.propertiesGroupAddAllProperties",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PropertiesGroup.html#v:propertiesGroupAddAllProperties"
        })


#endif

-- method PropertiesGroup::add_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PropertiesGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlPropertiesGroup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , 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 = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_properties_group_add_property" dzl_properties_group_add_property :: 
    Ptr PropertiesGroup ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "PropertiesGroup"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- property_name : TBasicType TUTF8
    IO ()

-- | Adds a new stateful action named /@name@/ which maps to the underlying
-- property /@propertyName@/ of [PropertiesGroup:object]("GI.Dazzle.Objects.PropertiesGroup#g:attr:object").
-- 
-- /Since: 3.26/
propertiesGroupAddProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropertiesGroup a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup'
    -> T.Text
    -- ^ /@name@/: the name of the action
    -> T.Text
    -- ^ /@propertyName@/: the name of the property
    -> m ()
propertiesGroupAddProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPropertiesGroup a) =>
a -> Text -> Text -> m ()
propertiesGroupAddProperty a
self Text
name Text
propertyName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropertiesGroup
self' <- a -> IO (Ptr PropertiesGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr PropertiesGroup -> CString -> CString -> IO ()
dzl_properties_group_add_property Ptr PropertiesGroup
self' CString
name' CString
propertyName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertiesGroupAddPropertyMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsPropertiesGroup a) => O.OverloadedMethod PropertiesGroupAddPropertyMethodInfo a signature where
    overloadedMethod = propertiesGroupAddProperty

instance O.OverloadedMethodInfo PropertiesGroupAddPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PropertiesGroup.propertiesGroupAddProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PropertiesGroup.html#v:propertiesGroupAddProperty"
        })


#endif

-- method PropertiesGroup::add_property_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PropertiesGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlPropertiesGroup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , 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 = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PropertiesFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional flags for the action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_properties_group_add_property_full" dzl_properties_group_add_property_full :: 
    Ptr PropertiesGroup ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "PropertiesGroup"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- property_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Dazzle", name = "PropertiesFlags"})
    IO ()

-- | Adds a new stateful action named /@name@/ which maps to the underlying
-- property /@propertyName@/ of [PropertiesGroup:object]("GI.Dazzle.Objects.PropertiesGroup#g:attr:object").
-- 
-- Seting /@flags@/ allows you to tweak some settings about the action.
-- 
-- /Since: 3.26/
propertiesGroupAddPropertyFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropertiesGroup a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup'
    -> T.Text
    -- ^ /@name@/: the name of the action
    -> T.Text
    -- ^ /@propertyName@/: the name of the property
    -> [Dazzle.Flags.PropertiesFlags]
    -- ^ /@flags@/: optional flags for the action
    -> m ()
propertiesGroupAddPropertyFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPropertiesGroup a) =>
a -> Text -> Text -> [PropertiesFlags] -> m ()
propertiesGroupAddPropertyFull a
self Text
name Text
propertyName [PropertiesFlags]
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropertiesGroup
self' <- a -> IO (Ptr PropertiesGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let flags' :: CUInt
flags' = [PropertiesFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PropertiesFlags]
flags
    Ptr PropertiesGroup -> CString -> CString -> CUInt -> IO ()
dzl_properties_group_add_property_full Ptr PropertiesGroup
self' CString
name' CString
propertyName' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertiesGroupAddPropertyFullMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Dazzle.Flags.PropertiesFlags] -> m ()), MonadIO m, IsPropertiesGroup a) => O.OverloadedMethod PropertiesGroupAddPropertyFullMethodInfo a signature where
    overloadedMethod = propertiesGroupAddPropertyFull

instance O.OverloadedMethodInfo PropertiesGroupAddPropertyFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PropertiesGroup.propertiesGroupAddPropertyFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PropertiesGroup.html#v:propertiesGroupAddPropertyFull"
        })


#endif

-- method PropertiesGroup::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "PropertiesGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlPropertiesGroup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_properties_group_remove" dzl_properties_group_remove :: 
    Ptr PropertiesGroup ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "PropertiesGroup"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Removes an action from /@self@/ that was previously added with
-- 'GI.Dazzle.Objects.PropertiesGroup.propertiesGroupAddProperty'. /@name@/ should match the
-- name parameter to that function.
-- 
-- /Since: 3.26/
propertiesGroupRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropertiesGroup a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.PropertiesGroup.PropertiesGroup'
    -> T.Text
    -- ^ /@name@/: the name of the action
    -> m ()
propertiesGroupRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPropertiesGroup a) =>
a -> Text -> m ()
propertiesGroupRemove a
self Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropertiesGroup
self' <- a -> IO (Ptr PropertiesGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr PropertiesGroup -> CString -> IO ()
dzl_properties_group_remove Ptr PropertiesGroup
self' CString
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropertiesGroupRemoveMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsPropertiesGroup a) => O.OverloadedMethod PropertiesGroupRemoveMethodInfo a signature where
    overloadedMethod = propertiesGroupRemove

instance O.OverloadedMethodInfo PropertiesGroupRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.PropertiesGroup.propertiesGroupRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-PropertiesGroup.html#v:propertiesGroupRemove"
        })


#endif