{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque structure used as the base of all classes.

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

module GI.GObject.Structs.TypeClass
    ( 

-- * Exported types
    TypeClass(..)                           ,
    newZeroTypeClass                        ,
    noTypeClass                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTypeClassMethod                  ,
#endif


-- ** addPrivate #method:addPrivate#

#if defined(ENABLE_OVERLOADING)
    TypeClassAddPrivateMethodInfo           ,
#endif
    typeClassAddPrivate                     ,


-- ** adjustPrivateOffset #method:adjustPrivateOffset#

    typeClassAdjustPrivateOffset            ,


-- ** getPrivate #method:getPrivate#

#if defined(ENABLE_OVERLOADING)
    TypeClassGetPrivateMethodInfo           ,
#endif
    typeClassGetPrivate                     ,


-- ** peek #method:peek#

    typeClassPeek                           ,


-- ** peekParent #method:peekParent#

#if defined(ENABLE_OVERLOADING)
    TypeClassPeekParentMethodInfo           ,
#endif
    typeClassPeekParent                     ,


-- ** peekStatic #method:peekStatic#

    typeClassPeekStatic                     ,


-- ** ref #method:ref#

    typeClassRef                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TypeClassUnrefMethodInfo                ,
#endif
    typeClassUnref                          ,




    ) 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


-- | Memory-managed wrapper type.
newtype TypeClass = TypeClass (ManagedPtr TypeClass)
    deriving (TypeClass -> TypeClass -> Bool
(TypeClass -> TypeClass -> Bool)
-> (TypeClass -> TypeClass -> Bool) -> Eq TypeClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeClass -> TypeClass -> Bool
$c/= :: TypeClass -> TypeClass -> Bool
== :: TypeClass -> TypeClass -> Bool
$c== :: TypeClass -> TypeClass -> Bool
Eq)
instance WrappedPtr TypeClass where
    wrappedPtrCalloc :: IO (Ptr TypeClass)
wrappedPtrCalloc = Int -> IO (Ptr TypeClass)
forall a. Int -> IO (Ptr a)
callocBytes 8
    wrappedPtrCopy :: TypeClass -> IO TypeClass
wrappedPtrCopy = \p :: TypeClass
p -> TypeClass -> (Ptr TypeClass -> IO TypeClass) -> IO TypeClass
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeClass
p (Int -> Ptr TypeClass -> IO (Ptr TypeClass)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 8 (Ptr TypeClass -> IO (Ptr TypeClass))
-> (Ptr TypeClass -> IO TypeClass) -> Ptr TypeClass -> IO TypeClass
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr TypeClass -> TypeClass)
-> Ptr TypeClass -> IO TypeClass
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr TypeClass -> TypeClass
TypeClass)
    wrappedPtrFree :: Maybe (GDestroyNotify TypeClass)
wrappedPtrFree = GDestroyNotify TypeClass -> Maybe (GDestroyNotify TypeClass)
forall a. a -> Maybe a
Just GDestroyNotify TypeClass
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `TypeClass` struct initialized to zero.
newZeroTypeClass :: MonadIO m => m TypeClass
newZeroTypeClass :: m TypeClass
newZeroTypeClass = IO TypeClass -> m TypeClass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeClass -> m TypeClass) -> IO TypeClass -> m TypeClass
forall a b. (a -> b) -> a -> b
$ IO (Ptr TypeClass)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr TypeClass)
-> (Ptr TypeClass -> IO TypeClass) -> IO TypeClass
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr TypeClass -> TypeClass)
-> Ptr TypeClass -> IO TypeClass
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr TypeClass -> TypeClass
TypeClass

instance tag ~ 'AttrSet => Constructible TypeClass tag where
    new :: (ManagedPtr TypeClass -> TypeClass)
-> [AttrOp TypeClass tag] -> m TypeClass
new _ attrs :: [AttrOp TypeClass tag]
attrs = do
        TypeClass
o <- m TypeClass
forall (m :: * -> *). MonadIO m => m TypeClass
newZeroTypeClass
        TypeClass -> [AttrOp TypeClass 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set TypeClass
o [AttrOp TypeClass tag]
[AttrOp TypeClass 'AttrSet]
attrs
        TypeClass -> m TypeClass
forall (m :: * -> *) a. Monad m => a -> m a
return TypeClass
o


-- | A convenience alias for `Nothing` :: `Maybe` `TypeClass`.
noTypeClass :: Maybe TypeClass
noTypeClass :: Maybe TypeClass
noTypeClass = Maybe TypeClass
forall a. Maybe a
Nothing


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

-- method TypeClass::add_private
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "g_class"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "TypeClass" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "class structure for an instantiatable\n   type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "private_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "size of private structure"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_add_private" g_type_class_add_private :: 
    Ptr TypeClass ->                        -- g_class : TInterface (Name {namespace = "GObject", name = "TypeClass"})
    Word64 ->                               -- private_size : TBasicType TUInt64
    IO ()

{-# DEPRECATED typeClassAddPrivate ["(Since version 2.58)","Use the @/G_ADD_PRIVATE()/@ macro with the @G_DEFINE_*@","  family of macros to add instance private data to a type"] #-}
-- | Registers a private structure for an instantiatable type.
-- 
-- When an object is allocated, the private structures for
-- the type and all of its parent types are allocated
-- sequentially in the same memory block as the public
-- structures, and are zero-filled.
-- 
-- Note that the accumulated size of the private structures of
-- a type and all its parent types cannot exceed 64 KiB.
-- 
-- This function should be called in the type\'s @/class_init()/@ function.
-- The private structure can be retrieved using the
-- @/G_TYPE_INSTANCE_GET_PRIVATE()/@ macro.
-- 
-- The following example shows attaching a private structure
-- MyObjectPrivate to an object MyObject defined in the standard
-- GObject fashion in the type\'s @/class_init()/@ function.
-- 
-- Note the use of a structure member \"priv\" to avoid the overhead
-- of repeatedly calling @/MY_OBJECT_GET_PRIVATE()/@.
-- 
-- 
-- === /C code/
-- >
-- >typedef struct _MyObject        MyObject;
-- >typedef struct _MyObjectPrivate MyObjectPrivate;
-- >
-- >struct _MyObject {
-- > GObject parent;
-- >
-- > MyObjectPrivate *priv;
-- >};
-- >
-- >struct _MyObjectPrivate {
-- >  int some_field;
-- >};
-- >
-- >static void
-- >my_object_class_init (MyObjectClass *klass)
-- >{
-- >  g_type_class_add_private (klass, sizeof (MyObjectPrivate));
-- >}
-- >
-- >static void
-- >my_object_init (MyObject *my_object)
-- >{
-- >  my_object->priv = G_TYPE_INSTANCE_GET_PRIVATE (my_object,
-- >                                                 MY_TYPE_OBJECT,
-- >                                                 MyObjectPrivate);
-- >  // my_object->priv->some_field will be automatically initialised to 0
-- >}
-- >
-- >static int
-- >my_object_get_some_field (MyObject *my_object)
-- >{
-- >  MyObjectPrivate *priv;
-- >
-- >  g_return_val_if_fail (MY_IS_OBJECT (my_object), 0);
-- >
-- >  priv = my_object->priv;
-- >
-- >  return priv->some_field;
-- >}
-- 
-- 
-- /Since: 2.4/
typeClassAddPrivate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeClass
    -- ^ /@gClass@/: class structure for an instantiatable
    --    type
    -> Word64
    -- ^ /@privateSize@/: size of private structure
    -> m ()
typeClassAddPrivate :: TypeClass -> Word64 -> m ()
typeClassAddPrivate gClass :: TypeClass
gClass privateSize :: Word64
privateSize = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeClass
gClass' <- TypeClass -> IO (Ptr TypeClass)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeClass
gClass
    Ptr TypeClass -> Word64 -> IO ()
g_type_class_add_private Ptr TypeClass
gClass' Word64
privateSize
    TypeClass -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeClass
gClass
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TypeClassAddPrivateMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m) => O.MethodInfo TypeClassAddPrivateMethodInfo TypeClass signature where
    overloadedMethod = typeClassAddPrivate

#endif

-- method TypeClass::get_private
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "klass"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "TypeClass" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "private_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_get_private" g_type_class_get_private :: 
    Ptr TypeClass ->                        -- klass : TInterface (Name {namespace = "GObject", name = "TypeClass"})
    CGType ->                               -- private_type : TBasicType TGType
    IO (Ptr ())

-- | /No description available in the introspection data./
typeClassGetPrivate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeClass
    -> GType
    -> m (Ptr ())
typeClassGetPrivate :: TypeClass -> GType -> m (Ptr ())
typeClassGetPrivate klass :: TypeClass
klass privateType :: GType
privateType = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeClass
klass' <- TypeClass -> IO (Ptr TypeClass)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeClass
klass
    let privateType' :: Word64
privateType' = GType -> Word64
gtypeToCGType GType
privateType
    Ptr ()
result <- Ptr TypeClass -> Word64 -> IO (Ptr ())
g_type_class_get_private Ptr TypeClass
klass' Word64
privateType'
    TypeClass -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeClass
klass
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data TypeClassGetPrivateMethodInfo
instance (signature ~ (GType -> m (Ptr ())), MonadIO m) => O.MethodInfo TypeClassGetPrivateMethodInfo TypeClass signature where
    overloadedMethod = typeClassGetPrivate

#endif

-- method TypeClass::peek_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "g_class"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "TypeClass" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GTypeClass structure to\n    retrieve the parent class for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GObject" , name = "TypeClass" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_peek_parent" g_type_class_peek_parent :: 
    Ptr TypeClass ->                        -- g_class : TInterface (Name {namespace = "GObject", name = "TypeClass"})
    IO (Ptr TypeClass)

-- | This is a convenience function often needed in class initializers.
-- It returns the class structure of the immediate parent type of the
-- class passed in.  Since derived classes hold a reference count on
-- their parent classes as long as they are instantiated, the returned
-- class will always exist.
-- 
-- This function is essentially equivalent to:
-- g_type_class_peek (g_type_parent (G_TYPE_FROM_CLASS (g_class)))
typeClassPeekParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeClass
    -- ^ /@gClass@/: the t'GI.GObject.Structs.TypeClass.TypeClass' structure to
    --     retrieve the parent class for
    -> m TypeClass
    -- ^ __Returns:__ the parent class
    --     of /@gClass@/
typeClassPeekParent :: TypeClass -> m TypeClass
typeClassPeekParent gClass :: TypeClass
gClass = IO TypeClass -> m TypeClass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeClass -> m TypeClass) -> IO TypeClass -> m TypeClass
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeClass
gClass' <- TypeClass -> IO (Ptr TypeClass)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeClass
gClass
    Ptr TypeClass
result <- Ptr TypeClass -> IO (Ptr TypeClass)
g_type_class_peek_parent Ptr TypeClass
gClass'
    Text -> Ptr TypeClass -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "typeClassPeekParent" Ptr TypeClass
result
    TypeClass
result' <- ((ManagedPtr TypeClass -> TypeClass)
-> Ptr TypeClass -> IO TypeClass
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr TypeClass -> TypeClass
TypeClass) Ptr TypeClass
result
    TypeClass -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeClass
gClass
    TypeClass -> IO TypeClass
forall (m :: * -> *) a. Monad m => a -> m a
return TypeClass
result'

#if defined(ENABLE_OVERLOADING)
data TypeClassPeekParentMethodInfo
instance (signature ~ (m TypeClass), MonadIO m) => O.MethodInfo TypeClassPeekParentMethodInfo TypeClass signature where
    overloadedMethod = typeClassPeekParent

#endif

-- method TypeClass::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "g_class"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "TypeClass" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTypeClass structure to unref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_unref" g_type_class_unref :: 
    Ptr TypeClass ->                        -- g_class : TInterface (Name {namespace = "GObject", name = "TypeClass"})
    IO ()

-- | Decrements the reference count of the class structure being passed in.
-- Once the last reference count of a class has been released, classes
-- may be finalized by the type system, so further dereferencing of a
-- class pointer after 'GI.GObject.Structs.TypeClass.typeClassUnref' are invalid.
typeClassUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TypeClass
    -- ^ /@gClass@/: a t'GI.GObject.Structs.TypeClass.TypeClass' structure to unref
    -> m ()
typeClassUnref :: TypeClass -> m ()
typeClassUnref gClass :: TypeClass
gClass = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TypeClass
gClass' <- TypeClass -> IO (Ptr TypeClass)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TypeClass
gClass
    Ptr TypeClass -> IO ()
g_type_class_unref Ptr TypeClass
gClass'
    TypeClass -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TypeClass
gClass
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TypeClassUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo TypeClassUnrefMethodInfo TypeClass signature where
    overloadedMethod = typeClassUnref

#endif

-- method TypeClass::adjust_private_offset
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "g_class"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "private_size_or_offset"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_adjust_private_offset" g_type_class_adjust_private_offset :: 
    Ptr () ->                               -- g_class : TBasicType TPtr
    Int32 ->                                -- private_size_or_offset : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
typeClassAdjustPrivateOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -> Int32
    -> m ()
typeClassAdjustPrivateOffset :: Ptr () -> Int32 -> m ()
typeClassAdjustPrivateOffset gClass :: Ptr ()
gClass privateSizeOrOffset :: Int32
privateSizeOrOffset = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr () -> Int32 -> IO ()
g_type_class_adjust_private_offset Ptr ()
gClass Int32
privateSizeOrOffset
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method TypeClass::peek
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "type ID of a classed type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GObject" , name = "TypeClass" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_peek" g_type_class_peek :: 
    CGType ->                               -- type : TBasicType TGType
    IO (Ptr TypeClass)

-- | This function is essentially the same as 'GI.GObject.Functions.typeClassRef',
-- except that the classes reference count isn\'t incremented.
-- As a consequence, this function may return 'P.Nothing' if the class
-- of the type passed in does not currently exist (hasn\'t been
-- referenced before).
typeClassPeek ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: type ID of a classed type
    -> m TypeClass
    -- ^ __Returns:__ the t'GI.GObject.Structs.TypeClass.TypeClass'
    --     structure for the given type ID or 'P.Nothing' if the class does not
    --     currently exist
typeClassPeek :: GType -> m TypeClass
typeClassPeek type_ :: GType
type_ = IO TypeClass -> m TypeClass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeClass -> m TypeClass) -> IO TypeClass -> m TypeClass
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: Word64
type_' = GType -> Word64
gtypeToCGType GType
type_
    Ptr TypeClass
result <- Word64 -> IO (Ptr TypeClass)
g_type_class_peek Word64
type_'
    Text -> Ptr TypeClass -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "typeClassPeek" Ptr TypeClass
result
    TypeClass
result' <- ((ManagedPtr TypeClass -> TypeClass)
-> Ptr TypeClass -> IO TypeClass
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr TypeClass -> TypeClass
TypeClass) Ptr TypeClass
result
    TypeClass -> IO TypeClass
forall (m :: * -> *) a. Monad m => a -> m a
return TypeClass
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TypeClass::peek_static
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "type ID of a classed type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GObject" , name = "TypeClass" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_peek_static" g_type_class_peek_static :: 
    CGType ->                               -- type : TBasicType TGType
    IO (Ptr TypeClass)

-- | A more efficient version of 'GI.GObject.Functions.typeClassPeek' which works only for
-- static types.
-- 
-- /Since: 2.4/
typeClassPeekStatic ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: type ID of a classed type
    -> m TypeClass
    -- ^ __Returns:__ the t'GI.GObject.Structs.TypeClass.TypeClass'
    --     structure for the given type ID or 'P.Nothing' if the class does not
    --     currently exist or is dynamically loaded
typeClassPeekStatic :: GType -> m TypeClass
typeClassPeekStatic type_ :: GType
type_ = IO TypeClass -> m TypeClass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeClass -> m TypeClass) -> IO TypeClass -> m TypeClass
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: Word64
type_' = GType -> Word64
gtypeToCGType GType
type_
    Ptr TypeClass
result <- Word64 -> IO (Ptr TypeClass)
g_type_class_peek_static Word64
type_'
    Text -> Ptr TypeClass -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "typeClassPeekStatic" Ptr TypeClass
result
    TypeClass
result' <- ((ManagedPtr TypeClass -> TypeClass)
-> Ptr TypeClass -> IO TypeClass
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr TypeClass -> TypeClass
TypeClass) Ptr TypeClass
result
    TypeClass -> IO TypeClass
forall (m :: * -> *) a. Monad m => a -> m a
return TypeClass
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TypeClass::ref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "type ID of a classed type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GObject" , name = "TypeClass" })
-- throws : False
-- Skip return : False

foreign import ccall "g_type_class_ref" g_type_class_ref :: 
    CGType ->                               -- type : TBasicType TGType
    IO (Ptr TypeClass)

-- | Increments the reference count of the class structure belonging to
-- /@type@/. This function will demand-create the class if it doesn\'t
-- exist already.
typeClassRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: type ID of a classed type
    -> m TypeClass
    -- ^ __Returns:__ the t'GI.GObject.Structs.TypeClass.TypeClass'
    --     structure for the given type ID
typeClassRef :: GType -> m TypeClass
typeClassRef type_ :: GType
type_ = IO TypeClass -> m TypeClass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypeClass -> m TypeClass) -> IO TypeClass -> m TypeClass
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: Word64
type_' = GType -> Word64
gtypeToCGType GType
type_
    Ptr TypeClass
result <- Word64 -> IO (Ptr TypeClass)
g_type_class_ref Word64
type_'
    Text -> Ptr TypeClass -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "typeClassRef" Ptr TypeClass
result
    TypeClass
result' <- ((ManagedPtr TypeClass -> TypeClass)
-> Ptr TypeClass -> IO TypeClass
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr TypeClass -> TypeClass
TypeClass) Ptr TypeClass
result
    TypeClass -> IO TypeClass
forall (m :: * -> *) a. Monad m => a -> m a
return TypeClass
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTypeClassMethod (t :: Symbol) (o :: *) :: * where
    ResolveTypeClassMethod "addPrivate" o = TypeClassAddPrivateMethodInfo
    ResolveTypeClassMethod "peekParent" o = TypeClassPeekParentMethodInfo
    ResolveTypeClassMethod "unref" o = TypeClassUnrefMethodInfo
    ResolveTypeClassMethod "getPrivate" o = TypeClassGetPrivateMethodInfo
    ResolveTypeClassMethod l o = O.MethodResolutionFailed l o

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

#endif