{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- 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.

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

module GI.Atk.Objects.Registry
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveRegistryMethod                   ,
#endif


-- ** getFactory #method:getFactory#

#if defined(ENABLE_OVERLOADING)
    RegistryGetFactoryMethodInfo            ,
#endif
    registryGetFactory                      ,


-- ** getFactoryType #method:getFactoryType#

#if defined(ENABLE_OVERLOADING)
    RegistryGetFactoryTypeMethodInfo        ,
#endif
    registryGetFactoryType                  ,


-- ** setFactoryType #method:setFactoryType#

#if defined(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.BasicTypes as B.Types
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 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.Atk.Objects.ObjectFactory as Atk.ObjectFactory
import qualified GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype Registry = Registry (SP.ManagedPtr Registry)
    deriving (Registry -> Registry -> Bool
(Registry -> Registry -> Bool)
-> (Registry -> Registry -> Bool) -> Eq Registry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Registry -> Registry -> Bool
$c/= :: Registry -> Registry -> Bool
== :: Registry -> Registry -> Bool
$c== :: Registry -> Registry -> Bool
Eq)

instance SP.ManagedPtrNewtype Registry where
    toManagedPtr :: Registry -> ManagedPtr Registry
toManagedPtr (Registry ManagedPtr Registry
p) = ManagedPtr Registry
p

foreign import ccall "atk_registry_get_type"
    c_atk_registry_get_type :: IO B.Types.GType

instance B.Types.TypedObject Registry where
    glibType :: IO GType
glibType = IO GType
c_atk_registry_get_type

instance B.Types.GObject Registry

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

-- | Type class for types which can be safely cast to `Registry`, for instance with `toRegistry`.
class (SP.GObject o, O.IsDescendantOf Registry o) => IsRegistry o
instance (SP.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 :: o -> m Registry
toRegistry = IO Registry -> m Registry
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Registry -> m Registry)
-> (o -> IO Registry) -> o -> m Registry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Registry -> Registry) -> o -> IO Registry
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Registry -> Registry
Registry

#if defined(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 "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    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 @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(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 t'GI.Atk.Objects.ObjectFactory.ObjectFactory' appropriate for creating @/AtkObjects/@
-- appropriate for /@type@/.
registryGetFactory ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: an t'GI.Atk.Objects.Registry.Registry'
    -> GType
    -- ^ /@type@/: a t'GType' with which to look up the associated t'GI.Atk.Objects.ObjectFactory.ObjectFactory'
    -> m Atk.ObjectFactory.ObjectFactory
    -- ^ __Returns:__ an t'GI.Atk.Objects.ObjectFactory.ObjectFactory' appropriate for creating
    -- @/AtkObjects/@ appropriate for /@type@/.
registryGetFactory :: a -> GType -> m ObjectFactory
registryGetFactory a
registry GType
type_ = IO ObjectFactory -> m ObjectFactory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ObjectFactory -> m ObjectFactory)
-> IO ObjectFactory -> m ObjectFactory
forall a b. (a -> b) -> a -> b
$ do
    Ptr Registry
registry' <- a -> IO (Ptr Registry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
registry
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    Ptr ObjectFactory
result <- Ptr Registry -> CGType -> IO (Ptr ObjectFactory)
atk_registry_get_factory Ptr Registry
registry' CGType
type_'
    Text -> Ptr ObjectFactory -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"registryGetFactory" Ptr ObjectFactory
result
    ObjectFactory
result' <- ((ManagedPtr ObjectFactory -> ObjectFactory)
-> Ptr ObjectFactory -> IO ObjectFactory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ObjectFactory -> ObjectFactory
Atk.ObjectFactory.ObjectFactory) Ptr ObjectFactory
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    ObjectFactory -> IO ObjectFactory
forall (m :: * -> *) a. Monad m => a -> m a
return ObjectFactory
result'

#if defined(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 t'GType' indicating the t'GI.Atk.Objects.ObjectFactory.ObjectFactory' subclass
-- associated with /@type@/.
registryGetFactoryType ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: an t'GI.Atk.Objects.Registry.Registry'
    -> GType
    -- ^ /@type@/: a t'GType' with which to look up the associated t'GI.Atk.Objects.ObjectFactory.ObjectFactory'
    -- subclass
    -> m GType
    -- ^ __Returns:__ a t'GType' associated with type /@type@/
registryGetFactoryType :: a -> GType -> m GType
registryGetFactoryType a
registry GType
type_ = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Registry
registry' <- a -> IO (Ptr Registry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
registry
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CGType
result <- Ptr Registry -> CGType -> IO CGType
atk_registry_get_factory_type Ptr Registry
registry' CGType
type_'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(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 t'GI.Atk.Objects.ObjectFactory.ObjectFactory' subclass with a t'GType'. Note:
-- The associated /@factoryType@/ will thereafter be responsible for
-- the creation of new t'GI.Atk.Objects.Object.Object' implementations for instances
-- appropriate for /@type@/.
registrySetFactoryType ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: the t'GI.Atk.Objects.Registry.Registry' in which to register the type association
    -> GType
    -- ^ /@type@/: an t'GI.Atk.Objects.Object.Object' type
    -> GType
    -- ^ /@factoryType@/: an t'GI.Atk.Objects.ObjectFactory.ObjectFactory' type to associate with /@type@/.  Must
    -- implement AtkObject appropriate for /@type@/.
    -> m ()
registrySetFactoryType :: a -> GType -> GType -> m ()
registrySetFactoryType a
registry GType
type_ GType
factoryType = 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 Registry
registry' <- a -> IO (Ptr Registry)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
registry
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    let factoryType' :: CGType
factoryType' = GType -> CGType
gtypeToCGType GType
factoryType
    Ptr Registry -> CGType -> CGType -> IO ()
atk_registry_set_factory_type Ptr Registry
registry' CGType
type_' CGType
factoryType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif