Registry.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)

The AtkRegistry is normally used to create appropriate ATK \"peers\"
for user interface components.  Application developers usually need
only interact with the AtkRegistry by associating appropriate ATK
implementation classes with GObject classes via the
atk_registry_set_factory_type call, passing the appropriate GType
for application custom widget classes.
-}

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

module GI.Atk.Objects.Registry
    ( 

-- * Exported types
    Registry(..)                            ,
    IsRegistry                              ,
    toRegistry                              ,
    noRegistry                              ,


 -- * Methods
-- ** getFactory #method:getFactory#

#if ENABLE_OVERLOADING
    RegistryGetFactoryMethodInfo            ,
#endif
    registryGetFactory                      ,


-- ** getFactoryType #method:getFactoryType#

#if ENABLE_OVERLOADING
    RegistryGetFactoryTypeMethodInfo        ,
#endif
    registryGetFactoryType                  ,


-- ** setFactoryType #method:setFactoryType#

#if ENABLE_OVERLOADING
    RegistrySetFactoryTypeMethodInfo        ,
#endif
    registrySetFactoryType                  ,




    ) 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

import {-# SOURCE #-} qualified GI.Atk.Objects.ObjectFactory as Atk.ObjectFactory
import qualified GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype Registry = Registry (ManagedPtr Registry)
foreign import ccall "atk_registry_get_type"
    c_atk_registry_get_type :: IO GType

instance GObject Registry where
    gobjectType = c_atk_registry_get_type
    

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

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

-- | Cast to `Registry`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toRegistry :: (MonadIO m, IsRegistry o) => o -> m Registry
toRegistry = liftIO . unsafeCastTo Registry

-- | A convenience alias for `Nothing` :: `Maybe` `Registry`.
noRegistry :: Maybe Registry
noRegistry = Nothing

#if ENABLE_OVERLOADING
type family ResolveRegistryMethod (t :: Symbol) (o :: *) :: * where
    ResolveRegistryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRegistryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRegistryMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRegistryMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRegistryMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRegistryMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRegistryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRegistryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRegistryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRegistryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRegistryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRegistryMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRegistryMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRegistryMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRegistryMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRegistryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRegistryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRegistryMethod "getFactory" o = RegistryGetFactoryMethodInfo
    ResolveRegistryMethod "getFactoryType" o = RegistryGetFactoryTypeMethodInfo
    ResolveRegistryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRegistryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRegistryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRegistryMethod "setFactoryType" o = RegistrySetFactoryTypeMethodInfo
    ResolveRegistryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRegistryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveRegistryMethod t Registry, O.MethodInfo info Registry p) => OL.IsLabel t (Registry -> 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

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

#if ENABLE_OVERLOADING
#endif

#if ENABLE_OVERLOADING
type instance O.SignalList Registry = RegistrySignalList
type RegistrySignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Registry::get_factory
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "registry", argType = TInterface (Name {namespace = "Atk", name = "Registry"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an #AtkRegistry", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GType with which to look up the associated #AtkObjectFactory", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Atk", name = "ObjectFactory"}))
-- throws : False
-- Skip return : False

foreign import ccall "atk_registry_get_factory" atk_registry_get_factory :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "Atk", name = "Registry"})
    CGType ->                               -- type : TBasicType TGType
    IO (Ptr Atk.ObjectFactory.ObjectFactory)

{- |
Gets an 'GI.Atk.Objects.ObjectFactory.ObjectFactory' appropriate for creating @/AtkObjects/@
appropriate for /@type@/.
-}
registryGetFactory ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    {- ^ /@registry@/: an 'GI.Atk.Objects.Registry.Registry' -}
    -> GType
    {- ^ /@type@/: a 'GType' with which to look up the associated 'GI.Atk.Objects.ObjectFactory.ObjectFactory' -}
    -> m Atk.ObjectFactory.ObjectFactory
    {- ^ __Returns:__ an 'GI.Atk.Objects.ObjectFactory.ObjectFactory' appropriate for creating
@/AtkObjects/@ appropriate for /@type@/. -}
registryGetFactory registry type_ = liftIO $ do
    registry' <- unsafeManagedPtrCastPtr registry
    let type_' = gtypeToCGType type_
    result <- atk_registry_get_factory registry' type_'
    checkUnexpectedReturnNULL "registryGetFactory" result
    result' <- (newObject Atk.ObjectFactory.ObjectFactory) result
    touchManagedPtr registry
    return result'

#if ENABLE_OVERLOADING
data RegistryGetFactoryMethodInfo
instance (signature ~ (GType -> m Atk.ObjectFactory.ObjectFactory), MonadIO m, IsRegistry a) => O.MethodInfo RegistryGetFactoryMethodInfo a signature where
    overloadedMethod _ = registryGetFactory

#endif

-- method Registry::get_factory_type
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "registry", argType = TInterface (Name {namespace = "Atk", name = "Registry"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an #AtkRegistry", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GType with which to look up the associated #AtkObjectFactory\nsubclass", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "atk_registry_get_factory_type" atk_registry_get_factory_type :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "Atk", name = "Registry"})
    CGType ->                               -- type : TBasicType TGType
    IO CGType

{- |
Provides a 'GType' indicating the 'GI.Atk.Objects.ObjectFactory.ObjectFactory' subclass
associated with /@type@/.
-}
registryGetFactoryType ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    {- ^ /@registry@/: an 'GI.Atk.Objects.Registry.Registry' -}
    -> GType
    {- ^ /@type@/: a 'GType' with which to look up the associated 'GI.Atk.Objects.ObjectFactory.ObjectFactory'
subclass -}
    -> m GType
    {- ^ __Returns:__ a 'GType' associated with type /@type@/ -}
registryGetFactoryType registry type_ = liftIO $ do
    registry' <- unsafeManagedPtrCastPtr registry
    let type_' = gtypeToCGType type_
    result <- atk_registry_get_factory_type registry' type_'
    let result' = GType result
    touchManagedPtr registry
    return result'

#if ENABLE_OVERLOADING
data RegistryGetFactoryTypeMethodInfo
instance (signature ~ (GType -> m GType), MonadIO m, IsRegistry a) => O.MethodInfo RegistryGetFactoryTypeMethodInfo a signature where
    overloadedMethod _ = registryGetFactoryType

#endif

-- method Registry::set_factory_type
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "registry", argType = TInterface (Name {namespace = "Atk", name = "Registry"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #AtkRegistry in which to register the type association", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an #AtkObject type", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "factory_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an #AtkObjectFactory type to associate with @type.  Must\nimplement AtkObject appropriate for @type.", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_registry_set_factory_type" atk_registry_set_factory_type :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "Atk", name = "Registry"})
    CGType ->                               -- type : TBasicType TGType
    CGType ->                               -- factory_type : TBasicType TGType
    IO ()

{- |
Associate an 'GI.Atk.Objects.ObjectFactory.ObjectFactory' subclass with a 'GType'. Note:
The associated /@factoryType@/ will thereafter be responsible for
the creation of new 'GI.Atk.Objects.Object.Object' implementations for instances
appropriate for /@type@/.
-}
registrySetFactoryType ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    {- ^ /@registry@/: the 'GI.Atk.Objects.Registry.Registry' in which to register the type association -}
    -> GType
    {- ^ /@type@/: an 'GI.Atk.Objects.Object.Object' type -}
    -> GType
    {- ^ /@factoryType@/: an 'GI.Atk.Objects.ObjectFactory.ObjectFactory' type to associate with /@type@/.  Must
implement AtkObject appropriate for /@type@/. -}
    -> m ()
registrySetFactoryType registry type_ factoryType = liftIO $ do
    registry' <- unsafeManagedPtrCastPtr registry
    let type_' = gtypeToCGType type_
    let factoryType' = gtypeToCGType factoryType
    atk_registry_set_factory_type registry' type_' factoryType'
    touchManagedPtr registry
    return ()

#if ENABLE_OVERLOADING
data RegistrySetFactoryTypeMethodInfo
instance (signature ~ (GType -> GType -> m ()), MonadIO m, IsRegistry a) => O.MethodInfo RegistrySetFactoryTypeMethodInfo a signature where
    overloadedMethod _ = registrySetFactoryType

#endif