TypeClass.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)

An opaque structure used as the base of all classes.
-}

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

module GI.GObject.Structs.TypeClass
    ( 

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


 -- * Methods
-- ** addPrivate #method:addPrivate#

#if ENABLE_OVERLOADING
    TypeClassAddPrivateMethodInfo           ,
#endif
    typeClassAddPrivate                     ,


-- ** adjustPrivateOffset #method:adjustPrivateOffset#

    typeClassAdjustPrivateOffset            ,


-- ** getPrivate #method:getPrivate#

#if ENABLE_OVERLOADING
    TypeClassGetPrivateMethodInfo           ,
#endif
    typeClassGetPrivate                     ,


-- ** peek #method:peek#

    typeClassPeek                           ,


-- ** peekParent #method:peekParent#

#if ENABLE_OVERLOADING
    TypeClassPeekParentMethodInfo           ,
#endif
    typeClassPeekParent                     ,


-- ** peekStatic #method:peekStatic#

    typeClassPeekStatic                     ,


-- ** ref #method:ref#

    typeClassRef                            ,


-- ** unref #method:unref#

#if 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.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)
instance WrappedPtr TypeClass where
    wrappedPtrCalloc = callocBytes 8
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 8 >=> wrapPtr TypeClass)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `TypeClass` struct initialized to zero.
newZeroTypeClass :: MonadIO m => m TypeClass
newZeroTypeClass = liftIO $ wrappedPtrCalloc >>= wrapPtr TypeClass

instance tag ~ 'AttrSet => Constructible TypeClass tag where
    new _ attrs = do
        o <- newZeroTypeClass
        GI.Attributes.set o attrs
        return o


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


#if 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 gClass privateSize = liftIO $ do
    gClass' <- unsafeManagedPtrGetPtr gClass
    g_type_class_add_private gClass' privateSize
    touchManagedPtr gClass
    return ()

#if 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 klass privateType = liftIO $ do
    klass' <- unsafeManagedPtrGetPtr klass
    let privateType' = gtypeToCGType privateType
    result <- g_type_class_get_private klass' privateType'
    touchManagedPtr klass
    return result

#if 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 'GI.GObject.Structs.TypeClass.TypeClass' structure to
    retrieve the parent class for -}
    -> m TypeClass
    {- ^ __Returns:__ the parent class
    of /@gClass@/ -}
typeClassPeekParent gClass = liftIO $ do
    gClass' <- unsafeManagedPtrGetPtr gClass
    result <- g_type_class_peek_parent gClass'
    checkUnexpectedReturnNULL "typeClassPeekParent" result
    result' <- (newPtr TypeClass) result
    touchManagedPtr gClass
    return result'

#if 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 'GI.GObject.Structs.TypeClass.TypeClass' structure to unref -}
    -> m ()
typeClassUnref gClass = liftIO $ do
    gClass' <- unsafeManagedPtrGetPtr gClass
    g_type_class_unref gClass'
    touchManagedPtr gClass
    return ()

#if 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 gClass privateSizeOrOffset = liftIO $ do
    g_type_class_adjust_private_offset gClass privateSizeOrOffset
    return ()

#if 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 '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 'GI.GObject.Structs.TypeClass.TypeClass'
    structure for the given type ID or 'Nothing' if the class does not
    currently exist -}
typeClassPeek type_ = liftIO $ do
    let type_' = gtypeToCGType type_
    result <- g_type_class_peek type_'
    checkUnexpectedReturnNULL "typeClassPeek" result
    result' <- (newPtr TypeClass) result
    return result'

#if 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 'GI.GObject.Structs.TypeClass.TypeClass'
    structure for the given type ID or 'Nothing' if the class does not
    currently exist or is dynamically loaded -}
typeClassPeekStatic type_ = liftIO $ do
    let type_' = gtypeToCGType type_
    result <- g_type_class_peek_static type_'
    checkUnexpectedReturnNULL "typeClassPeekStatic" result
    result' <- (newPtr TypeClass) result
    return result'

#if 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 'GI.GObject.Structs.TypeClass.TypeClass'
    structure for the given type ID -}
typeClassRef type_ = liftIO $ do
    let type_' = gtypeToCGType type_
    result <- g_type_class_ref type_'
    checkUnexpectedReturnNULL "typeClassRef" result
    result' <- (newPtr TypeClass) result
    return result'

#if ENABLE_OVERLOADING
#endif

#if 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 (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif

#endif