{-# LANGUAGE TypeApplications #-} -- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte -- License : LGPL-2.1 -- Maintainer : Iñaki García Etxebarria -- -- The GObject type system supports dynamic loading of types. -- The t'GI.GObject.Interfaces.TypePlugin.TypePlugin' interface is used to handle the lifecycle -- of dynamically loaded types. It goes as follows: -- -- 1. The type is initially introduced (usually upon loading the module -- the first time, or by your main application that knows what modules -- introduces what types), like this: -- -- === /C code/ -- > -- > new_type_id = g_type_register_dynamic (parent_type_id, -- > "TypeName", -- > new_type_plugin, -- > type_flags); -- > -- -- where /@newTypePlugin@/ is an implementation of the -- t'GI.GObject.Interfaces.TypePlugin.TypePlugin' interface. -- -- 2. The type\'s implementation is referenced, e.g. through -- 'GI.GObject.Functions.typeClassRef' or through @/g_type_create_instance()/@ (this is -- being called by @/g_object_new()/@) or through one of the above done on -- a type derived from /@newTypeId@/. -- -- 3. This causes the type system to load the type\'s implementation by -- calling 'GI.GObject.Interfaces.TypePlugin.typePluginUse' and 'GI.GObject.Interfaces.TypePlugin.typePluginCompleteTypeInfo' -- on /@newTypePlugin@/. -- -- 4. At some point the type\'s implementation isn\'t required anymore, -- e.g. after 'GI.GObject.Structs.TypeClass.typeClassUnref' or 'GI.GObject.Functions.typeFreeInstance' (called -- when the reference count of an instance drops to zero). -- -- 5. This causes the type system to throw away the information retrieved -- from 'GI.GObject.Interfaces.TypePlugin.typePluginCompleteTypeInfo' and then it calls -- 'GI.GObject.Interfaces.TypePlugin.typePluginUnuse' on /@newTypePlugin@/. -- -- 6. Things may repeat from the second step. -- -- So basically, you need to implement a t'GI.GObject.Interfaces.TypePlugin.TypePlugin' type that -- carries a use_count, once use_count goes from zero to one, you need -- to load the implementation to successfully handle the upcoming -- 'GI.GObject.Interfaces.TypePlugin.typePluginCompleteTypeInfo' call. Later, maybe after -- succeeding use\/unuse calls, once use_count drops to zero, you can -- unload the implementation again. The type system makes sure to call -- 'GI.GObject.Interfaces.TypePlugin.typePluginUse' and 'GI.GObject.Interfaces.TypePlugin.typePluginCompleteTypeInfo' again -- when the type is needed again. -- -- t'GI.GObject.Objects.TypeModule.TypeModule' is an implementation of t'GI.GObject.Interfaces.TypePlugin.TypePlugin' that already -- implements most of this except for the actual module loading and -- unloading. It even handles multiple registered types per module. #if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__)) #define ENABLE_OVERLOADING #endif module GI.GObject.Interfaces.TypePlugin ( -- * Exported types TypePlugin(..) , IsTypePlugin , -- * Methods -- ** Overloaded methods #method:Overloaded methods# #if defined(ENABLE_OVERLOADING) ResolveTypePluginMethod , #endif -- ** completeInterfaceInfo #method:completeInterfaceInfo# #if defined(ENABLE_OVERLOADING) TypePluginCompleteInterfaceInfoMethodInfo, #endif typePluginCompleteInterfaceInfo , -- ** completeTypeInfo #method:completeTypeInfo# #if defined(ENABLE_OVERLOADING) TypePluginCompleteTypeInfoMethodInfo , #endif typePluginCompleteTypeInfo , -- ** unuse #method:unuse# #if defined(ENABLE_OVERLOADING) TypePluginUnuseMethodInfo , #endif typePluginUnuse , -- ** use #method:use# #if defined(ENABLE_OVERLOADING) TypePluginUseMethodInfo , #endif typePluginUse , ) 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.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.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 {-# SOURCE #-} qualified GI.GObject.Structs.InterfaceInfo as GObject.InterfaceInfo import {-# SOURCE #-} qualified GI.GObject.Structs.TypeInfo as GObject.TypeInfo import {-# SOURCE #-} qualified GI.GObject.Structs.TypeValueTable as GObject.TypeValueTable -- interface TypePlugin -- | Memory-managed wrapper type. newtype TypePlugin = TypePlugin (SP.ManagedPtr TypePlugin) deriving (TypePlugin -> TypePlugin -> Bool (TypePlugin -> TypePlugin -> Bool) -> (TypePlugin -> TypePlugin -> Bool) -> Eq TypePlugin forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: TypePlugin -> TypePlugin -> Bool $c/= :: TypePlugin -> TypePlugin -> Bool == :: TypePlugin -> TypePlugin -> Bool $c== :: TypePlugin -> TypePlugin -> Bool Eq) instance SP.ManagedPtrNewtype TypePlugin where toManagedPtr :: TypePlugin -> ManagedPtr TypePlugin toManagedPtr (TypePlugin ManagedPtr TypePlugin p) = ManagedPtr TypePlugin p -- | Type class for types which implement `TypePlugin`. class (ManagedPtrNewtype o, O.IsDescendantOf TypePlugin o) => IsTypePlugin o instance (ManagedPtrNewtype o, O.IsDescendantOf TypePlugin o) => IsTypePlugin o -- XXX Wrapping a foreign struct/union with no known destructor or size, leak? instance BoxedPtr TypePlugin where boxedPtrCopy :: TypePlugin -> IO TypePlugin boxedPtrCopy = TypePlugin -> IO TypePlugin forall (m :: * -> *) a. Monad m => a -> m a return boxedPtrFree :: TypePlugin -> IO () boxedPtrFree = \TypePlugin _x -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) type family ResolveTypePluginMethod (t :: Symbol) (o :: *) :: * where ResolveTypePluginMethod "completeInterfaceInfo" o = TypePluginCompleteInterfaceInfoMethodInfo ResolveTypePluginMethod "completeTypeInfo" o = TypePluginCompleteTypeInfoMethodInfo ResolveTypePluginMethod "unuse" o = TypePluginUnuseMethodInfo ResolveTypePluginMethod "use" o = TypePluginUseMethodInfo ResolveTypePluginMethod l o = O.MethodResolutionFailed l o instance (info ~ ResolveTypePluginMethod t TypePlugin, O.MethodInfo info TypePlugin p) => OL.IsLabel t (TypePlugin -> p) where #if MIN_VERSION_base(4,10,0) fromLabel = O.overloadedMethod @info #else fromLabel _ = O.overloadedMethod @info #endif #endif -- method TypePlugin::complete_interface_info -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "plugin" -- , argType = -- TInterface Name { namespace = "GObject" , name = "TypePlugin" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the #GTypePlugin" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "instance_type" -- , argType = TBasicType TGType -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = -- Just -- "the #GType of an instantiable type to which the interface\n is added" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "interface_type" -- , argType = TBasicType TGType -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = -- Just "the #GType of the interface whose info is completed" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "info" -- , argType = -- TInterface Name { namespace = "GObject" , name = "InterfaceInfo" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the #GInterfaceInfo to fill in" -- , 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_plugin_complete_interface_info" g_type_plugin_complete_interface_info :: Ptr TypePlugin -> -- plugin : TInterface (Name {namespace = "GObject", name = "TypePlugin"}) CGType -> -- instance_type : TBasicType TGType CGType -> -- interface_type : TBasicType TGType Ptr GObject.InterfaceInfo.InterfaceInfo -> -- info : TInterface (Name {namespace = "GObject", name = "InterfaceInfo"}) IO () -- | Calls the /@completeInterfaceInfo@/ function from the -- @/GTypePluginClass/@ of /@plugin@/. There should be no need to use this -- function outside of the GObject type system itself. typePluginCompleteInterfaceInfo :: (B.CallStack.HasCallStack, MonadIO m, IsTypePlugin a) => a -- ^ /@plugin@/: the t'GI.GObject.Interfaces.TypePlugin.TypePlugin' -> GType -- ^ /@instanceType@/: the t'GType' of an instantiable type to which the interface -- is added -> GType -- ^ /@interfaceType@/: the t'GType' of the interface whose info is completed -> GObject.InterfaceInfo.InterfaceInfo -- ^ /@info@/: the t'GI.GObject.Structs.InterfaceInfo.InterfaceInfo' to fill in -> m () typePluginCompleteInterfaceInfo :: a -> GType -> GType -> InterfaceInfo -> m () typePluginCompleteInterfaceInfo a plugin GType instanceType GType interfaceType InterfaceInfo info = 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 TypePlugin plugin' <- a -> IO (Ptr TypePlugin) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) unsafeManagedPtrCastPtr a plugin let instanceType' :: CGType instanceType' = GType -> CGType gtypeToCGType GType instanceType let interfaceType' :: CGType interfaceType' = GType -> CGType gtypeToCGType GType interfaceType Ptr InterfaceInfo info' <- InterfaceInfo -> IO (Ptr InterfaceInfo) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr InterfaceInfo info Ptr TypePlugin -> CGType -> CGType -> Ptr InterfaceInfo -> IO () g_type_plugin_complete_interface_info Ptr TypePlugin plugin' CGType instanceType' CGType interfaceType' Ptr InterfaceInfo info' a -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr a plugin InterfaceInfo -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr InterfaceInfo info () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data TypePluginCompleteInterfaceInfoMethodInfo instance (signature ~ (GType -> GType -> GObject.InterfaceInfo.InterfaceInfo -> m ()), MonadIO m, IsTypePlugin a) => O.MethodInfo TypePluginCompleteInterfaceInfoMethodInfo a signature where overloadedMethod = typePluginCompleteInterfaceInfo #endif -- method TypePlugin::complete_type_info -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "plugin" -- , argType = -- TInterface Name { namespace = "GObject" , name = "TypePlugin" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a #GTypePlugin" , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "g_type" -- , argType = TBasicType TGType -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the #GType whose info is completed" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "info" -- , argType = -- TInterface Name { namespace = "GObject" , name = "TypeInfo" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the #GTypeInfo struct to fill in" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "value_table" -- , argType = -- TInterface Name { namespace = "GObject" , name = "TypeValueTable" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "the #GTypeValueTable to fill in" -- , 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_plugin_complete_type_info" g_type_plugin_complete_type_info :: Ptr TypePlugin -> -- plugin : TInterface (Name {namespace = "GObject", name = "TypePlugin"}) CGType -> -- g_type : TBasicType TGType Ptr GObject.TypeInfo.TypeInfo -> -- info : TInterface (Name {namespace = "GObject", name = "TypeInfo"}) Ptr GObject.TypeValueTable.TypeValueTable -> -- value_table : TInterface (Name {namespace = "GObject", name = "TypeValueTable"}) IO () -- | Calls the /@completeTypeInfo@/ function from the @/GTypePluginClass/@ of /@plugin@/. -- There should be no need to use this function outside of the GObject -- type system itself. typePluginCompleteTypeInfo :: (B.CallStack.HasCallStack, MonadIO m, IsTypePlugin a) => a -- ^ /@plugin@/: a t'GI.GObject.Interfaces.TypePlugin.TypePlugin' -> GType -- ^ /@gType@/: the t'GType' whose info is completed -> GObject.TypeInfo.TypeInfo -- ^ /@info@/: the t'GI.GObject.Structs.TypeInfo.TypeInfo' struct to fill in -> GObject.TypeValueTable.TypeValueTable -- ^ /@valueTable@/: the t'GI.GObject.Structs.TypeValueTable.TypeValueTable' to fill in -> m () typePluginCompleteTypeInfo :: a -> GType -> TypeInfo -> TypeValueTable -> m () typePluginCompleteTypeInfo a plugin GType gType TypeInfo info TypeValueTable valueTable = 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 TypePlugin plugin' <- a -> IO (Ptr TypePlugin) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) unsafeManagedPtrCastPtr a plugin let gType' :: CGType gType' = GType -> CGType gtypeToCGType GType gType Ptr TypeInfo info' <- TypeInfo -> IO (Ptr TypeInfo) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr TypeInfo info Ptr TypeValueTable valueTable' <- TypeValueTable -> IO (Ptr TypeValueTable) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr TypeValueTable valueTable Ptr TypePlugin -> CGType -> Ptr TypeInfo -> Ptr TypeValueTable -> IO () g_type_plugin_complete_type_info Ptr TypePlugin plugin' CGType gType' Ptr TypeInfo info' Ptr TypeValueTable valueTable' a -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr a plugin TypeInfo -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr TypeInfo info TypeValueTable -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr TypeValueTable valueTable () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data TypePluginCompleteTypeInfoMethodInfo instance (signature ~ (GType -> GObject.TypeInfo.TypeInfo -> GObject.TypeValueTable.TypeValueTable -> m ()), MonadIO m, IsTypePlugin a) => O.MethodInfo TypePluginCompleteTypeInfoMethodInfo a signature where overloadedMethod = typePluginCompleteTypeInfo #endif -- method TypePlugin::unuse -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "plugin" -- , argType = -- TInterface Name { namespace = "GObject" , name = "TypePlugin" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a #GTypePlugin" , 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_plugin_unuse" g_type_plugin_unuse :: Ptr TypePlugin -> -- plugin : TInterface (Name {namespace = "GObject", name = "TypePlugin"}) IO () -- | Calls the /@unusePlugin@/ function from the @/GTypePluginClass/@ of -- /@plugin@/. There should be no need to use this function outside of -- the GObject type system itself. typePluginUnuse :: (B.CallStack.HasCallStack, MonadIO m, IsTypePlugin a) => a -- ^ /@plugin@/: a t'GI.GObject.Interfaces.TypePlugin.TypePlugin' -> m () typePluginUnuse :: a -> m () typePluginUnuse a plugin = 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 TypePlugin plugin' <- a -> IO (Ptr TypePlugin) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) unsafeManagedPtrCastPtr a plugin Ptr TypePlugin -> IO () g_type_plugin_unuse Ptr TypePlugin plugin' a -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr a plugin () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data TypePluginUnuseMethodInfo instance (signature ~ (m ()), MonadIO m, IsTypePlugin a) => O.MethodInfo TypePluginUnuseMethodInfo a signature where overloadedMethod = typePluginUnuse #endif -- method TypePlugin::use -- method type : OrdinaryMethod -- Args: [ Arg -- { argCName = "plugin" -- , argType = -- TInterface Name { namespace = "GObject" , name = "TypePlugin" } -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "a #GTypePlugin" , 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_plugin_use" g_type_plugin_use :: Ptr TypePlugin -> -- plugin : TInterface (Name {namespace = "GObject", name = "TypePlugin"}) IO () -- | Calls the /@usePlugin@/ function from the @/GTypePluginClass/@ of -- /@plugin@/. There should be no need to use this function outside of -- the GObject type system itself. typePluginUse :: (B.CallStack.HasCallStack, MonadIO m, IsTypePlugin a) => a -- ^ /@plugin@/: a t'GI.GObject.Interfaces.TypePlugin.TypePlugin' -> m () typePluginUse :: a -> m () typePluginUse a plugin = 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 TypePlugin plugin' <- a -> IO (Ptr TypePlugin) forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b) unsafeManagedPtrCastPtr a plugin Ptr TypePlugin -> IO () g_type_plugin_use Ptr TypePlugin plugin' a -> IO () forall a. ManagedPtrNewtype a => a -> IO () touchManagedPtr a plugin () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () #if defined(ENABLE_OVERLOADING) data TypePluginUseMethodInfo instance (signature ~ (m ()), MonadIO m, IsTypePlugin a) => O.MethodInfo TypePluginUseMethodInfo a signature where overloadedMethod = typePluginUse #endif #if defined(ENABLE_OVERLOADING) type instance O.SignalList TypePlugin = TypePluginSignalList type TypePluginSignalList = ('[ ] :: [(Symbol, *)]) #endif