{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Wnck.Objects.ClassGroup.ClassGroup' struct contains only private fields and should not be
-- directly accessed.

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

module GI.Wnck.Objects.ClassGroup
    ( 

-- * Exported types
    ClassGroup(..)                          ,
    IsClassGroup                            ,
    toClassGroup                            ,
    noClassGroup                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveClassGroupMethod                 ,
#endif


-- ** get #method:get#

    classGroupGet                           ,


-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    ClassGroupGetIconMethodInfo             ,
#endif
    classGroupGetIcon                       ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    ClassGroupGetIdMethodInfo               ,
#endif
    classGroupGetId                         ,


-- ** getMiniIcon #method:getMiniIcon#

#if defined(ENABLE_OVERLOADING)
    ClassGroupGetMiniIconMethodInfo         ,
#endif
    classGroupGetMiniIcon                   ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ClassGroupGetNameMethodInfo             ,
#endif
    classGroupGetName                       ,


-- ** getResClass #method:getResClass#

#if defined(ENABLE_OVERLOADING)
    ClassGroupGetResClassMethodInfo         ,
#endif
    classGroupGetResClass                   ,


-- ** getWindows #method:getWindows#

#if defined(ENABLE_OVERLOADING)
    ClassGroupGetWindowsMethodInfo          ,
#endif
    classGroupGetWindows                    ,




 -- * Signals
-- ** iconChanged #signal:iconChanged#

    C_ClassGroupIconChangedCallback         ,
    ClassGroupIconChangedCallback           ,
#if defined(ENABLE_OVERLOADING)
    ClassGroupIconChangedSignalInfo         ,
#endif
    afterClassGroupIconChanged              ,
    genClosure_ClassGroupIconChanged        ,
    mk_ClassGroupIconChangedCallback        ,
    noClassGroupIconChangedCallback         ,
    onClassGroupIconChanged                 ,
    wrap_ClassGroupIconChangedCallback      ,


-- ** nameChanged #signal:nameChanged#

    C_ClassGroupNameChangedCallback         ,
    ClassGroupNameChangedCallback           ,
#if defined(ENABLE_OVERLOADING)
    ClassGroupNameChangedSignalInfo         ,
#endif
    afterClassGroupNameChanged              ,
    genClosure_ClassGroupNameChanged        ,
    mk_ClassGroupNameChangedCallback        ,
    noClassGroupNameChangedCallback         ,
    onClassGroupNameChanged                 ,
    wrap_ClassGroupNameChangedCallback      ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import {-# SOURCE #-} qualified GI.Wnck.Objects.Window as Wnck.Window

-- | Memory-managed wrapper type.
newtype ClassGroup = ClassGroup (ManagedPtr ClassGroup)
    deriving (ClassGroup -> ClassGroup -> Bool
(ClassGroup -> ClassGroup -> Bool)
-> (ClassGroup -> ClassGroup -> Bool) -> Eq ClassGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassGroup -> ClassGroup -> Bool
$c/= :: ClassGroup -> ClassGroup -> Bool
== :: ClassGroup -> ClassGroup -> Bool
$c== :: ClassGroup -> ClassGroup -> Bool
Eq)
foreign import ccall "wnck_class_group_get_type"
    c_wnck_class_group_get_type :: IO GType

instance GObject ClassGroup where
    gobjectType :: IO GType
gobjectType = IO GType
c_wnck_class_group_get_type
    

-- | Convert 'ClassGroup' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue ClassGroup where
    toGValue :: ClassGroup -> IO GValue
toGValue o :: ClassGroup
o = do
        GType
gtype <- IO GType
c_wnck_class_group_get_type
        ClassGroup -> (Ptr ClassGroup -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ClassGroup
o (GType
-> (GValue -> Ptr ClassGroup -> IO ())
-> Ptr ClassGroup
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr ClassGroup -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO ClassGroup
fromGValue gv :: GValue
gv = do
        Ptr ClassGroup
ptr <- GValue -> IO (Ptr ClassGroup)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr ClassGroup)
        (ManagedPtr ClassGroup -> ClassGroup)
-> Ptr ClassGroup -> IO ClassGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ClassGroup -> ClassGroup
ClassGroup Ptr ClassGroup
ptr
        
    

-- | Type class for types which can be safely cast to `ClassGroup`, for instance with `toClassGroup`.
class (GObject o, O.IsDescendantOf ClassGroup o) => IsClassGroup o
instance (GObject o, O.IsDescendantOf ClassGroup o) => IsClassGroup o

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

-- | Cast to `ClassGroup`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toClassGroup :: (MonadIO m, IsClassGroup o) => o -> m ClassGroup
toClassGroup :: o -> m ClassGroup
toClassGroup = IO ClassGroup -> m ClassGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClassGroup -> m ClassGroup)
-> (o -> IO ClassGroup) -> o -> m ClassGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ClassGroup -> ClassGroup) -> o -> IO ClassGroup
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr ClassGroup -> ClassGroup
ClassGroup

-- | A convenience alias for `Nothing` :: `Maybe` `ClassGroup`.
noClassGroup :: Maybe ClassGroup
noClassGroup :: Maybe ClassGroup
noClassGroup = Maybe ClassGroup
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveClassGroupMethod (t :: Symbol) (o :: *) :: * where
    ResolveClassGroupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveClassGroupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveClassGroupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveClassGroupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveClassGroupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveClassGroupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveClassGroupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveClassGroupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveClassGroupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveClassGroupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveClassGroupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveClassGroupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveClassGroupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveClassGroupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveClassGroupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveClassGroupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveClassGroupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveClassGroupMethod "getIcon" o = ClassGroupGetIconMethodInfo
    ResolveClassGroupMethod "getId" o = ClassGroupGetIdMethodInfo
    ResolveClassGroupMethod "getMiniIcon" o = ClassGroupGetMiniIconMethodInfo
    ResolveClassGroupMethod "getName" o = ClassGroupGetNameMethodInfo
    ResolveClassGroupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveClassGroupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveClassGroupMethod "getResClass" o = ClassGroupGetResClassMethodInfo
    ResolveClassGroupMethod "getWindows" o = ClassGroupGetWindowsMethodInfo
    ResolveClassGroupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveClassGroupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveClassGroupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveClassGroupMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveClassGroupMethod t ClassGroup, O.MethodInfo info ClassGroup p) => OL.IsLabel t (ClassGroup -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal ClassGroup::icon-changed
-- | Emitted when the icon of /@classGroup@/ changes.
type ClassGroupIconChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassGroupIconChangedCallback`@.
noClassGroupIconChangedCallback :: Maybe ClassGroupIconChangedCallback
noClassGroupIconChangedCallback :: Maybe (IO ())
noClassGroupIconChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ClassGroupIconChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClassGroupIconChangedCallback`.
foreign import ccall "wrapper"
    mk_ClassGroupIconChangedCallback :: C_ClassGroupIconChangedCallback -> IO (FunPtr C_ClassGroupIconChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ClassGroupIconChanged :: MonadIO m => ClassGroupIconChangedCallback -> m (GClosure C_ClassGroupIconChangedCallback)
genClosure_ClassGroupIconChanged :: IO () -> m (GClosure C_ClassGroupIconChangedCallback)
genClosure_ClassGroupIconChanged cb :: IO ()
cb = IO (GClosure C_ClassGroupIconChangedCallback)
-> m (GClosure C_ClassGroupIconChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassGroupIconChangedCallback)
 -> m (GClosure C_ClassGroupIconChangedCallback))
-> IO (GClosure C_ClassGroupIconChangedCallback)
-> m (GClosure C_ClassGroupIconChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGroupIconChangedCallback
cb' = IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupIconChangedCallback IO ()
cb
    C_ClassGroupIconChangedCallback
-> IO (FunPtr C_ClassGroupIconChangedCallback)
mk_ClassGroupIconChangedCallback C_ClassGroupIconChangedCallback
cb' IO (FunPtr C_ClassGroupIconChangedCallback)
-> (FunPtr C_ClassGroupIconChangedCallback
    -> IO (GClosure C_ClassGroupIconChangedCallback))
-> IO (GClosure C_ClassGroupIconChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassGroupIconChangedCallback
-> IO (GClosure C_ClassGroupIconChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassGroupIconChangedCallback` into a `C_ClassGroupIconChangedCallback`.
wrap_ClassGroupIconChangedCallback ::
    ClassGroupIconChangedCallback ->
    C_ClassGroupIconChangedCallback
wrap_ClassGroupIconChangedCallback :: IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupIconChangedCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [iconChanged](#signal:iconChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' classGroup #iconChanged callback
-- @
-- 
-- 
onClassGroupIconChanged :: (IsClassGroup a, MonadIO m) => a -> ClassGroupIconChangedCallback -> m SignalHandlerId
onClassGroupIconChanged :: a -> IO () -> m SignalHandlerId
onClassGroupIconChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGroupIconChangedCallback
cb' = IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupIconChangedCallback IO ()
cb
    FunPtr C_ClassGroupIconChangedCallback
cb'' <- C_ClassGroupIconChangedCallback
-> IO (FunPtr C_ClassGroupIconChangedCallback)
mk_ClassGroupIconChangedCallback C_ClassGroupIconChangedCallback
cb'
    a
-> Text
-> FunPtr C_ClassGroupIconChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "icon-changed" FunPtr C_ClassGroupIconChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [iconChanged](#signal:iconChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' classGroup #iconChanged callback
-- @
-- 
-- 
afterClassGroupIconChanged :: (IsClassGroup a, MonadIO m) => a -> ClassGroupIconChangedCallback -> m SignalHandlerId
afterClassGroupIconChanged :: a -> IO () -> m SignalHandlerId
afterClassGroupIconChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGroupIconChangedCallback
cb' = IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupIconChangedCallback IO ()
cb
    FunPtr C_ClassGroupIconChangedCallback
cb'' <- C_ClassGroupIconChangedCallback
-> IO (FunPtr C_ClassGroupIconChangedCallback)
mk_ClassGroupIconChangedCallback C_ClassGroupIconChangedCallback
cb'
    a
-> Text
-> FunPtr C_ClassGroupIconChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "icon-changed" FunPtr C_ClassGroupIconChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClassGroupIconChangedSignalInfo
instance SignalInfo ClassGroupIconChangedSignalInfo where
    type HaskellCallbackType ClassGroupIconChangedSignalInfo = ClassGroupIconChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClassGroupIconChangedCallback cb
        cb'' <- mk_ClassGroupIconChangedCallback cb'
        connectSignalFunPtr obj "icon-changed" cb'' connectMode detail

#endif

-- signal ClassGroup::name-changed
-- | Emitted when the name of /@classGroup@/ changes.
type ClassGroupNameChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassGroupNameChangedCallback`@.
noClassGroupNameChangedCallback :: Maybe ClassGroupNameChangedCallback
noClassGroupNameChangedCallback :: Maybe (IO ())
noClassGroupNameChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ClassGroupNameChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClassGroupNameChangedCallback`.
foreign import ccall "wrapper"
    mk_ClassGroupNameChangedCallback :: C_ClassGroupNameChangedCallback -> IO (FunPtr C_ClassGroupNameChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ClassGroupNameChanged :: MonadIO m => ClassGroupNameChangedCallback -> m (GClosure C_ClassGroupNameChangedCallback)
genClosure_ClassGroupNameChanged :: IO () -> m (GClosure C_ClassGroupIconChangedCallback)
genClosure_ClassGroupNameChanged cb :: IO ()
cb = IO (GClosure C_ClassGroupIconChangedCallback)
-> m (GClosure C_ClassGroupIconChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassGroupIconChangedCallback)
 -> m (GClosure C_ClassGroupIconChangedCallback))
-> IO (GClosure C_ClassGroupIconChangedCallback)
-> m (GClosure C_ClassGroupIconChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGroupIconChangedCallback
cb' = IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupNameChangedCallback IO ()
cb
    C_ClassGroupIconChangedCallback
-> IO (FunPtr C_ClassGroupIconChangedCallback)
mk_ClassGroupNameChangedCallback C_ClassGroupIconChangedCallback
cb' IO (FunPtr C_ClassGroupIconChangedCallback)
-> (FunPtr C_ClassGroupIconChangedCallback
    -> IO (GClosure C_ClassGroupIconChangedCallback))
-> IO (GClosure C_ClassGroupIconChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassGroupIconChangedCallback
-> IO (GClosure C_ClassGroupIconChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassGroupNameChangedCallback` into a `C_ClassGroupNameChangedCallback`.
wrap_ClassGroupNameChangedCallback ::
    ClassGroupNameChangedCallback ->
    C_ClassGroupNameChangedCallback
wrap_ClassGroupNameChangedCallback :: IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupNameChangedCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [nameChanged](#signal:nameChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' classGroup #nameChanged callback
-- @
-- 
-- 
onClassGroupNameChanged :: (IsClassGroup a, MonadIO m) => a -> ClassGroupNameChangedCallback -> m SignalHandlerId
onClassGroupNameChanged :: a -> IO () -> m SignalHandlerId
onClassGroupNameChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGroupIconChangedCallback
cb' = IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupNameChangedCallback IO ()
cb
    FunPtr C_ClassGroupIconChangedCallback
cb'' <- C_ClassGroupIconChangedCallback
-> IO (FunPtr C_ClassGroupIconChangedCallback)
mk_ClassGroupNameChangedCallback C_ClassGroupIconChangedCallback
cb'
    a
-> Text
-> FunPtr C_ClassGroupIconChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "name-changed" FunPtr C_ClassGroupIconChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [nameChanged](#signal:nameChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' classGroup #nameChanged callback
-- @
-- 
-- 
afterClassGroupNameChanged :: (IsClassGroup a, MonadIO m) => a -> ClassGroupNameChangedCallback -> m SignalHandlerId
afterClassGroupNameChanged :: a -> IO () -> m SignalHandlerId
afterClassGroupNameChanged obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGroupIconChangedCallback
cb' = IO () -> C_ClassGroupIconChangedCallback
wrap_ClassGroupNameChangedCallback IO ()
cb
    FunPtr C_ClassGroupIconChangedCallback
cb'' <- C_ClassGroupIconChangedCallback
-> IO (FunPtr C_ClassGroupIconChangedCallback)
mk_ClassGroupNameChangedCallback C_ClassGroupIconChangedCallback
cb'
    a
-> Text
-> FunPtr C_ClassGroupIconChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "name-changed" FunPtr C_ClassGroupIconChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClassGroupNameChangedSignalInfo
instance SignalInfo ClassGroupNameChangedSignalInfo where
    type HaskellCallbackType ClassGroupNameChangedSignalInfo = ClassGroupNameChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClassGroupNameChangedCallback cb
        cb'' <- mk_ClassGroupNameChangedCallback cb'
        connectSignalFunPtr obj "name-changed" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ClassGroup
type instance O.AttributeList ClassGroup = ClassGroupAttributeList
type ClassGroupAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ClassGroup = ClassGroupSignalList
type ClassGroupSignalList = ('[ '("iconChanged", ClassGroupIconChangedSignalInfo), '("nameChanged", ClassGroupNameChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method ClassGroup::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "class_group"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "ClassGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckClassGroup." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_class_group_get_icon" wnck_class_group_get_icon :: 
    Ptr ClassGroup ->                       -- class_group : TInterface (Name {namespace = "Wnck", name = "ClassGroup"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Gets the icon to be used for /@classGroup@/. Since there is no way to
-- properly find the icon, a suboptimal heuristic is used to find it. The icon
-- is the first icon found by looking at all the t'GI.Wnck.Objects.Application.Application' for each
-- t'GI.Wnck.Objects.Window.Window' in /@classGroup@/, then at all the t'GI.Wnck.Objects.Window.Window' in /@classGroup@/. If
-- no icon was found, a fallback icon is used.
-- 
-- /Since: 2.2/
classGroupGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsClassGroup a) =>
    a
    -- ^ /@classGroup@/: a t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ the icon for /@classGroup@/. The caller should
    -- reference the returned \<classname>GdkPixbuf\<\/classname> if it needs to keep
    -- the icon around.
classGroupGetIcon :: a -> m Pixbuf
classGroupGetIcon classGroup :: a
classGroup = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClassGroup
classGroup' <- a -> IO (Ptr ClassGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
classGroup
    Ptr Pixbuf
result <- Ptr ClassGroup -> IO (Ptr Pixbuf)
wnck_class_group_get_icon Ptr ClassGroup
classGroup'
    Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "classGroupGetIcon" Ptr Pixbuf
result
    Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
classGroup
    Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'

#if defined(ENABLE_OVERLOADING)
data ClassGroupGetIconMethodInfo
instance (signature ~ (m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsClassGroup a) => O.MethodInfo ClassGroupGetIconMethodInfo a signature where
    overloadedMethod = classGroupGetIcon

#endif

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

foreign import ccall "wnck_class_group_get_id" wnck_class_group_get_id :: 
    Ptr ClassGroup ->                       -- class_group : TInterface (Name {namespace = "Wnck", name = "ClassGroup"})
    IO CString

-- | Gets the identifier name for /@classGroup@/. This is the resource class for
-- /@classGroup@/.
-- 
-- /Since: 3.2/
classGroupGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsClassGroup a) =>
    a
    -- ^ /@classGroup@/: a t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> m T.Text
    -- ^ __Returns:__ the identifier name of /@classGroup@/, or an
    -- empty string if the group has no identifier name.
classGroupGetId :: a -> m Text
classGroupGetId classGroup :: a
classGroup = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClassGroup
classGroup' <- a -> IO (Ptr ClassGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
classGroup
    CString
result <- Ptr ClassGroup -> IO CString
wnck_class_group_get_id Ptr ClassGroup
classGroup'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "classGroupGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
classGroup
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClassGroupGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClassGroup a) => O.MethodInfo ClassGroupGetIdMethodInfo a signature where
    overloadedMethod = classGroupGetId

#endif

-- method ClassGroup::get_mini_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "class_group"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "ClassGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckClassGroup." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_class_group_get_mini_icon" wnck_class_group_get_mini_icon :: 
    Ptr ClassGroup ->                       -- class_group : TInterface (Name {namespace = "Wnck", name = "ClassGroup"})
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)

-- | Gets the mini-icon to be used for /@classGroup@/. Since there is no way to
-- properly find the mini-icon, the same suboptimal heuristic as the one for
-- 'GI.Wnck.Objects.ClassGroup.classGroupGetIcon' is used to find it.
-- 
-- /Since: 2.2/
classGroupGetMiniIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsClassGroup a) =>
    a
    -- ^ /@classGroup@/: a t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> m GdkPixbuf.Pixbuf.Pixbuf
    -- ^ __Returns:__ the mini-icon for /@classGroup@/. The caller
    -- should reference the returned \<classname>GdkPixbuf\<\/classname> if it needs
    -- to keep the mini-icon around.
classGroupGetMiniIcon :: a -> m Pixbuf
classGroupGetMiniIcon classGroup :: a
classGroup = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClassGroup
classGroup' <- a -> IO (Ptr ClassGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
classGroup
    Ptr Pixbuf
result <- Ptr ClassGroup -> IO (Ptr Pixbuf)
wnck_class_group_get_mini_icon Ptr ClassGroup
classGroup'
    Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "classGroupGetMiniIcon" Ptr Pixbuf
result
    Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
classGroup
    Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'

#if defined(ENABLE_OVERLOADING)
data ClassGroupGetMiniIconMethodInfo
instance (signature ~ (m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m, IsClassGroup a) => O.MethodInfo ClassGroupGetMiniIconMethodInfo a signature where
    overloadedMethod = classGroupGetMiniIcon

#endif

-- method ClassGroup::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "class_group"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "ClassGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckClassGroup." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "wnck_class_group_get_name" wnck_class_group_get_name :: 
    Ptr ClassGroup ->                       -- class_group : TInterface (Name {namespace = "Wnck", name = "ClassGroup"})
    IO CString

-- | Gets an human-readable name for /@classGroup@/. Since there is no way to
-- properly find this name, a suboptimal heuristic is used to find it. The name
-- is the name of all t'GI.Wnck.Objects.Application.Application' for each t'GI.Wnck.Objects.Window.Window' in /@classGroup@/ if
-- they all have the same name. If all t'GI.Wnck.Objects.Application.Application' don\'t have the same
-- name, the name is the name of all t'GI.Wnck.Objects.Window.Window' in /@classGroup@/ if they all
-- have the same name. If all t'GI.Wnck.Objects.Window.Window' don\'t have the same name, the
-- resource class name is used.
-- 
-- /Since: 2.2/
classGroupGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsClassGroup a) =>
    a
    -- ^ /@classGroup@/: a t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> m T.Text
    -- ^ __Returns:__ an human-readable name for /@classGroup@/.
classGroupGetName :: a -> m Text
classGroupGetName classGroup :: a
classGroup = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClassGroup
classGroup' <- a -> IO (Ptr ClassGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
classGroup
    CString
result <- Ptr ClassGroup -> IO CString
wnck_class_group_get_name Ptr ClassGroup
classGroup'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "classGroupGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
classGroup
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClassGroupGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClassGroup a) => O.MethodInfo ClassGroupGetNameMethodInfo a signature where
    overloadedMethod = classGroupGetName

#endif

-- method ClassGroup::get_res_class
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "class_group"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "ClassGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckClassGroup." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "wnck_class_group_get_res_class" wnck_class_group_get_res_class :: 
    Ptr ClassGroup ->                       -- class_group : TInterface (Name {namespace = "Wnck", name = "ClassGroup"})
    IO CString

{-# DEPRECATED classGroupGetResClass ["(Since version 3.2)","Use 'GI.Wnck.Objects.ClassGroup.classGroupGetId' instead."] #-}
-- | Gets the resource class name for /@classGroup@/.
-- 
-- /Since: 2.2/
classGroupGetResClass ::
    (B.CallStack.HasCallStack, MonadIO m, IsClassGroup a) =>
    a
    -- ^ /@classGroup@/: a t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> m T.Text
    -- ^ __Returns:__ the resource class name of /@classGroup@/, or an
    -- empty string if the group has no resource class name.
classGroupGetResClass :: a -> m Text
classGroupGetResClass classGroup :: a
classGroup = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClassGroup
classGroup' <- a -> IO (Ptr ClassGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
classGroup
    CString
result <- Ptr ClassGroup -> IO CString
wnck_class_group_get_res_class Ptr ClassGroup
classGroup'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "classGroupGetResClass" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
classGroup
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClassGroupGetResClassMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClassGroup a) => O.MethodInfo ClassGroupGetResClassMethodInfo a signature where
    overloadedMethod = classGroupGetResClass

#endif

-- method ClassGroup::get_windows
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "class_group"
--           , argType =
--               TInterface Name { namespace = "Wnck" , name = "ClassGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WnckClassGroup." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Wnck" , name = "Window" }))
-- throws : False
-- Skip return : False

foreign import ccall "wnck_class_group_get_windows" wnck_class_group_get_windows :: 
    Ptr ClassGroup ->                       -- class_group : TInterface (Name {namespace = "Wnck", name = "ClassGroup"})
    IO (Ptr (GList (Ptr Wnck.Window.Window)))

-- | Gets the list of t'GI.Wnck.Objects.Window.Window' that are grouped in /@classGroup@/.
-- 
-- /Since: 2.2/
classGroupGetWindows ::
    (B.CallStack.HasCallStack, MonadIO m, IsClassGroup a) =>
    a
    -- ^ /@classGroup@/: a t'GI.Wnck.Objects.ClassGroup.ClassGroup'.
    -> m [Wnck.Window.Window]
    -- ^ __Returns:__ the list of
    -- t'GI.Wnck.Objects.Window.Window' grouped in /@classGroup@/, or 'P.Nothing' if the group contains no
    -- window. The list should not be modified nor freed, as it is owned by
    -- /@classGroup@/.
classGroupGetWindows :: a -> m [Window]
classGroupGetWindows classGroup :: a
classGroup = IO [Window] -> m [Window]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Window] -> m [Window]) -> IO [Window] -> m [Window]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClassGroup
classGroup' <- a -> IO (Ptr ClassGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
classGroup
    Ptr (GList (Ptr Window))
result <- Ptr ClassGroup -> IO (Ptr (GList (Ptr Window)))
wnck_class_group_get_windows Ptr ClassGroup
classGroup'
    [Ptr Window]
result' <- Ptr (GList (Ptr Window)) -> IO [Ptr Window]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Window))
result
    [Window]
result'' <- (Ptr Window -> IO Window) -> [Ptr Window] -> IO [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Wnck.Window.Window) [Ptr Window]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
classGroup
    [Window] -> IO [Window]
forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
result''

#if defined(ENABLE_OVERLOADING)
data ClassGroupGetWindowsMethodInfo
instance (signature ~ (m [Wnck.Window.Window]), MonadIO m, IsClassGroup a) => O.MethodInfo ClassGroupGetWindowsMethodInfo a signature where
    overloadedMethod = classGroupGetWindows

#endif

-- method ClassGroup::get
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "identifier name of the sought resource class."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Wnck" , name = "ClassGroup" })
-- throws : False
-- Skip return : False

foreign import ccall "wnck_class_group_get" wnck_class_group_get :: 
    CString ->                              -- id : TBasicType TUTF8
    IO (Ptr ClassGroup)

-- | Gets the t'GI.Wnck.Objects.ClassGroup.ClassGroup' corresponding to /@id@/.
-- 
-- /Since: 2.2/
classGroupGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@id@/: identifier name of the sought resource class.
    -> m ClassGroup
    -- ^ __Returns:__ the t'GI.Wnck.Objects.ClassGroup.ClassGroup' corresponding to
    -- /@id@/, or 'P.Nothing' if there is no t'GI.Wnck.Objects.ClassGroup.ClassGroup' with the specified
    -- /@id@/. The returned t'GI.Wnck.Objects.ClassGroup.ClassGroup' is owned by libwnck and must not be
    -- referenced or unreferenced.
classGroupGet :: Text -> m ClassGroup
classGroupGet id :: Text
id = IO ClassGroup -> m ClassGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClassGroup -> m ClassGroup) -> IO ClassGroup -> m ClassGroup
forall a b. (a -> b) -> a -> b
$ do
    CString
id' <- Text -> IO CString
textToCString Text
id
    Ptr ClassGroup
result <- CString -> IO (Ptr ClassGroup)
wnck_class_group_get CString
id'
    Text -> Ptr ClassGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "classGroupGet" Ptr ClassGroup
result
    ClassGroup
result' <- ((ManagedPtr ClassGroup -> ClassGroup)
-> Ptr ClassGroup -> IO ClassGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ClassGroup -> ClassGroup
ClassGroup) Ptr ClassGroup
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    ClassGroup -> IO ClassGroup
forall (m :: * -> *) a. Monad m => a -> m a
return ClassGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif