{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusFactory is an t'GI.IBus.Objects.Service.Service' that creates input method engine (IME) instance.
-- It provides CreateEngine remote method, which creates an IME instance by name,
-- and returns the D-Bus object path to IBus daemon.
-- 
-- see_also: t'GI.IBus.Objects.Engine.Engine'

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

module GI.IBus.Objects.Factory
    ( 

-- * Exported types
    Factory(..)                             ,
    IsFactory                               ,
    toFactory                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addEngine]("GI.IBus.Objects.Factory#g:method:addEngine"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [createEngine]("GI.IBus.Objects.Factory#g:method:createEngine"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [emitSignal]("GI.IBus.Objects.Service#g:method:emitSignal"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [register]("GI.IBus.Objects.Service#g:method:register"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unregister]("GI.IBus.Objects.Service#g:method:unregister"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getConnection]("GI.IBus.Objects.Service#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getObjectPath]("GI.IBus.Objects.Service#g:method:getObjectPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFactoryMethod                    ,
#endif

-- ** addEngine #method:addEngine#

#if defined(ENABLE_OVERLOADING)
    FactoryAddEngineMethodInfo              ,
#endif
    factoryAddEngine                        ,


-- ** createEngine #method:createEngine#

#if defined(ENABLE_OVERLOADING)
    FactoryCreateEngineMethodInfo           ,
#endif
    factoryCreateEngine                     ,


-- ** new #method:new#

    factoryNew                              ,




 -- * Signals


-- ** createEngine #signal:createEngine#

    C_FactoryCreateEngineCallback           ,
    FactoryCreateEngineCallback             ,
#if defined(ENABLE_OVERLOADING)
    FactoryCreateEngineSignalInfo           ,
#endif
    afterFactoryCreateEngine                ,
    genClosure_FactoryCreateEngine          ,
    mk_FactoryCreateEngineCallback          ,
    noFactoryCreateEngineCallback           ,
    onFactoryCreateEngine                   ,
    wrap_FactoryCreateEngineCallback        ,




    ) 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 qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.IBus.Objects.Engine as IBus.Engine
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Service as IBus.Service

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

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

foreign import ccall "ibus_factory_get_type"
    c_ibus_factory_get_type :: IO B.Types.GType

instance B.Types.TypedObject Factory where
    glibType :: IO GType
glibType = IO GType
c_ibus_factory_get_type

instance B.Types.GObject Factory

-- | Type class for types which can be safely cast to `Factory`, for instance with `toFactory`.
class (SP.GObject o, O.IsDescendantOf Factory o) => IsFactory o
instance (SP.GObject o, O.IsDescendantOf Factory o) => IsFactory o

instance O.HasParentTypes Factory
type instance O.ParentTypes Factory = '[IBus.Service.Service, IBus.Object.Object, GObject.Object.Object]

-- | Cast to `Factory`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toFactory :: (MIO.MonadIO m, IsFactory o) => o -> m Factory
toFactory :: forall (m :: * -> *) o. (MonadIO m, IsFactory o) => o -> m Factory
toFactory = IO Factory -> m Factory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Factory -> m Factory) -> (o -> IO Factory) -> o -> m Factory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Factory -> Factory) -> o -> IO Factory
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Factory -> Factory
Factory

-- | Convert 'Factory' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Factory) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ibus_factory_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Factory -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Factory
P.Nothing = Ptr GValue -> Ptr Factory -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Factory
forall a. Ptr a
FP.nullPtr :: FP.Ptr Factory)
    gvalueSet_ Ptr GValue
gv (P.Just Factory
obj) = Factory -> (Ptr Factory -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Factory
obj (Ptr GValue -> Ptr Factory -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Factory)
gvalueGet_ Ptr GValue
gv = do
        Ptr Factory
ptr <- Ptr GValue -> IO (Ptr Factory)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Factory)
        if Ptr Factory
ptr Ptr Factory -> Ptr Factory -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Factory
forall a. Ptr a
FP.nullPtr
        then Factory -> Maybe Factory
forall a. a -> Maybe a
P.Just (Factory -> Maybe Factory) -> IO Factory -> IO (Maybe Factory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Factory -> Factory) -> Ptr Factory -> IO Factory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Factory -> Factory
Factory Ptr Factory
ptr
        else Maybe Factory -> IO (Maybe Factory)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Factory
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveFactoryMethod (t :: Symbol) (o :: *) :: * where
    ResolveFactoryMethod "addEngine" o = FactoryAddEngineMethodInfo
    ResolveFactoryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFactoryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFactoryMethod "createEngine" o = FactoryCreateEngineMethodInfo
    ResolveFactoryMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveFactoryMethod "emitSignal" o = IBus.Service.ServiceEmitSignalMethodInfo
    ResolveFactoryMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFactoryMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFactoryMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFactoryMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFactoryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFactoryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFactoryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFactoryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFactoryMethod "register" o = IBus.Service.ServiceRegisterMethodInfo
    ResolveFactoryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFactoryMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFactoryMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFactoryMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFactoryMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFactoryMethod "unregister" o = IBus.Service.ServiceUnregisterMethodInfo
    ResolveFactoryMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFactoryMethod "getConnection" o = IBus.Service.ServiceGetConnectionMethodInfo
    ResolveFactoryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFactoryMethod "getObjectPath" o = IBus.Service.ServiceGetObjectPathMethodInfo
    ResolveFactoryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFactoryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFactoryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFactoryMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFactoryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFactoryMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveFactoryMethod t Factory, O.OverloadedMethod info Factory p, R.HasField t Factory p) => R.HasField t Factory p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveFactoryMethod t Factory, O.OverloadedMethodInfo info Factory) => OL.IsLabel t (O.MethodProxy info Factory) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal Factory::create-engine
-- | The [createEngine](#g:signal:createEngine) signal is a signal to create IBusEngine
-- with /@engineName@/, which gets emitted when IBusFactory
-- received CreateEngine dbus method. The callback functions
-- will be called until a callback returns a non-null object
-- of IBusEngine.
type FactoryCreateEngineCallback =
    T.Text
    -- ^ /@engineName@/: the engine_name which received the signal
    -> IO (Maybe IBus.Engine.Engine)
    -- ^ __Returns:__ An IBusEngine

-- | A convenience synonym for @`Nothing` :: `Maybe` `FactoryCreateEngineCallback`@.
noFactoryCreateEngineCallback :: Maybe FactoryCreateEngineCallback
noFactoryCreateEngineCallback :: Maybe FactoryCreateEngineCallback
noFactoryCreateEngineCallback = Maybe FactoryCreateEngineCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_FactoryCreateEngineCallback =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO (Ptr IBus.Engine.Engine)

-- | Generate a function pointer callable from C code, from a `C_FactoryCreateEngineCallback`.
foreign import ccall "wrapper"
    mk_FactoryCreateEngineCallback :: C_FactoryCreateEngineCallback -> IO (FunPtr C_FactoryCreateEngineCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_FactoryCreateEngine :: MonadIO m => FactoryCreateEngineCallback -> m (GClosure C_FactoryCreateEngineCallback)
genClosure_FactoryCreateEngine :: forall (m :: * -> *).
MonadIO m =>
FactoryCreateEngineCallback
-> m (GClosure C_FactoryCreateEngineCallback)
genClosure_FactoryCreateEngine FactoryCreateEngineCallback
cb = IO (GClosure C_FactoryCreateEngineCallback)
-> m (GClosure C_FactoryCreateEngineCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_FactoryCreateEngineCallback)
 -> m (GClosure C_FactoryCreateEngineCallback))
-> IO (GClosure C_FactoryCreateEngineCallback)
-> m (GClosure C_FactoryCreateEngineCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_FactoryCreateEngineCallback
cb' = FactoryCreateEngineCallback -> C_FactoryCreateEngineCallback
wrap_FactoryCreateEngineCallback FactoryCreateEngineCallback
cb
    C_FactoryCreateEngineCallback
-> IO (FunPtr C_FactoryCreateEngineCallback)
mk_FactoryCreateEngineCallback C_FactoryCreateEngineCallback
cb' IO (FunPtr C_FactoryCreateEngineCallback)
-> (FunPtr C_FactoryCreateEngineCallback
    -> IO (GClosure C_FactoryCreateEngineCallback))
-> IO (GClosure C_FactoryCreateEngineCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_FactoryCreateEngineCallback
-> IO (GClosure C_FactoryCreateEngineCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `FactoryCreateEngineCallback` into a `C_FactoryCreateEngineCallback`.
wrap_FactoryCreateEngineCallback ::
    FactoryCreateEngineCallback ->
    C_FactoryCreateEngineCallback
wrap_FactoryCreateEngineCallback :: FactoryCreateEngineCallback -> C_FactoryCreateEngineCallback
wrap_FactoryCreateEngineCallback FactoryCreateEngineCallback
_cb Ptr ()
_ CString
engineName Ptr ()
_ = do
    Text
engineName' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
engineName
    Maybe Engine
result <- FactoryCreateEngineCallback
_cb  Text
engineName'
    Ptr Engine
-> Maybe Engine -> (Engine -> IO (Ptr Engine)) -> IO (Ptr Engine)
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM Ptr Engine
forall a. Ptr a
nullPtr Maybe Engine
result ((Engine -> IO (Ptr Engine)) -> IO (Ptr Engine))
-> (Engine -> IO (Ptr Engine)) -> IO (Ptr Engine)
forall a b. (a -> b) -> a -> b
$ \Engine
result' -> do
        Ptr Engine
result'' <- Engine -> IO (Ptr Engine)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject Engine
result'
        Ptr Engine -> IO (Ptr Engine)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Engine
result''


-- | Connect a signal handler for the [createEngine](#signal:createEngine) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' factory #createEngine callback
-- @
-- 
-- 
onFactoryCreateEngine :: (IsFactory a, MonadIO m) => a -> FactoryCreateEngineCallback -> m SignalHandlerId
onFactoryCreateEngine :: forall a (m :: * -> *).
(IsFactory a, MonadIO m) =>
a -> FactoryCreateEngineCallback -> m SignalHandlerId
onFactoryCreateEngine a
obj FactoryCreateEngineCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_FactoryCreateEngineCallback
cb' = FactoryCreateEngineCallback -> C_FactoryCreateEngineCallback
wrap_FactoryCreateEngineCallback FactoryCreateEngineCallback
cb
    FunPtr C_FactoryCreateEngineCallback
cb'' <- C_FactoryCreateEngineCallback
-> IO (FunPtr C_FactoryCreateEngineCallback)
mk_FactoryCreateEngineCallback C_FactoryCreateEngineCallback
cb'
    a
-> Text
-> FunPtr C_FactoryCreateEngineCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"create-engine" FunPtr C_FactoryCreateEngineCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [createEngine](#signal:createEngine) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' factory #createEngine callback
-- @
-- 
-- 
afterFactoryCreateEngine :: (IsFactory a, MonadIO m) => a -> FactoryCreateEngineCallback -> m SignalHandlerId
afterFactoryCreateEngine :: forall a (m :: * -> *).
(IsFactory a, MonadIO m) =>
a -> FactoryCreateEngineCallback -> m SignalHandlerId
afterFactoryCreateEngine a
obj FactoryCreateEngineCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_FactoryCreateEngineCallback
cb' = FactoryCreateEngineCallback -> C_FactoryCreateEngineCallback
wrap_FactoryCreateEngineCallback FactoryCreateEngineCallback
cb
    FunPtr C_FactoryCreateEngineCallback
cb'' <- C_FactoryCreateEngineCallback
-> IO (FunPtr C_FactoryCreateEngineCallback)
mk_FactoryCreateEngineCallback C_FactoryCreateEngineCallback
cb'
    a
-> Text
-> FunPtr C_FactoryCreateEngineCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"create-engine" FunPtr C_FactoryCreateEngineCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data FactoryCreateEngineSignalInfo
instance SignalInfo FactoryCreateEngineSignalInfo where
    type HaskellCallbackType FactoryCreateEngineSignalInfo = FactoryCreateEngineCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_FactoryCreateEngineCallback cb
        cb'' <- mk_FactoryCreateEngineCallback cb'
        connectSignalFunPtr obj "create-engine" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Factory
type instance O.AttributeList Factory = FactoryAttributeList
type FactoryAttributeList = ('[ '("connection", IBus.Service.ServiceConnectionPropertyInfo), '("objectPath", IBus.Service.ServiceObjectPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Factory = FactorySignalList
type FactorySignalList = ('[ '("createEngine", FactoryCreateEngineSignalInfo), '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Factory::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Factory" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_factory_new" ibus_factory_new :: 
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    IO (Ptr Factory)

-- | Creates a new t'GI.IBus.Objects.Factory.Factory'.
factoryNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusConnection.IsDBusConnection a) =>
    a
    -- ^ /@connection@/: An GDBusConnection.
    -> m Factory
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Factory.Factory'.
factoryNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusConnection a) =>
a -> m Factory
factoryNew a
connection = IO Factory -> m Factory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Factory -> m Factory) -> IO Factory -> m Factory
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusConnection
connection' <- a -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr Factory
result <- Ptr DBusConnection -> IO (Ptr Factory)
ibus_factory_new Ptr DBusConnection
connection'
    Text -> Ptr Factory -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"factoryNew" Ptr Factory
result
    Factory
result' <- ((ManagedPtr Factory -> Factory) -> Ptr Factory -> IO Factory
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Factory -> Factory
Factory) Ptr Factory
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    Factory -> IO Factory
forall (m :: * -> *) a. Monad m => a -> m a
return Factory
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Factory::add_engine
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Factory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusFactory." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "engine_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of an engine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "engine_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GType of an engine."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_factory_add_engine" ibus_factory_add_engine :: 
    Ptr Factory ->                          -- factory : TInterface (Name {namespace = "IBus", name = "Factory"})
    CString ->                              -- engine_name : TBasicType TUTF8
    CGType ->                               -- engine_type : TBasicType TGType
    IO ()

-- | Add an engine to the factory.
factoryAddEngine ::
    (B.CallStack.HasCallStack, MonadIO m, IsFactory a) =>
    a
    -- ^ /@factory@/: An IBusFactory.
    -> T.Text
    -- ^ /@engineName@/: Name of an engine.
    -> GType
    -- ^ /@engineType@/: GType of an engine.
    -> m ()
factoryAddEngine :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFactory a) =>
a -> Text -> GType -> m ()
factoryAddEngine a
factory Text
engineName GType
engineType = 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 Factory
factory' <- a -> IO (Ptr Factory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    CString
engineName' <- Text -> IO CString
textToCString Text
engineName
    let engineType' :: CGType
engineType' = GType -> CGType
gtypeToCGType GType
engineType
    Ptr Factory -> CString -> CGType -> IO ()
ibus_factory_add_engine Ptr Factory
factory' CString
engineName' CGType
engineType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
engineName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FactoryAddEngineMethodInfo
instance (signature ~ (T.Text -> GType -> m ()), MonadIO m, IsFactory a) => O.OverloadedMethod FactoryAddEngineMethodInfo a signature where
    overloadedMethod = factoryAddEngine

instance O.OverloadedMethodInfo FactoryAddEngineMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.IBus.Objects.Factory.factoryAddEngine",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-ibus-1.5.3/docs/GI-IBus-Objects-Factory.html#v:factoryAddEngine"
        }


#endif

-- method Factory::create_engine
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "factory"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Factory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusFactory." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "engine_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of an engine." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Engine" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_factory_create_engine" ibus_factory_create_engine :: 
    Ptr Factory ->                          -- factory : TInterface (Name {namespace = "IBus", name = "Factory"})
    CString ->                              -- engine_name : TBasicType TUTF8
    IO (Ptr IBus.Engine.Engine)

-- | Creates an t'GI.IBus.Objects.Engine.Engine' with /@engineName@/.
factoryCreateEngine ::
    (B.CallStack.HasCallStack, MonadIO m, IsFactory a) =>
    a
    -- ^ /@factory@/: An t'GI.IBus.Objects.Factory.Factory'.
    -> T.Text
    -- ^ /@engineName@/: Name of an engine.
    -> m IBus.Engine.Engine
    -- ^ __Returns:__ t'GI.IBus.Objects.Engine.Engine' with /@engineName@/.
factoryCreateEngine :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFactory a) =>
a -> Text -> m Engine
factoryCreateEngine a
factory Text
engineName = IO Engine -> m Engine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Engine -> m Engine) -> IO Engine -> m Engine
forall a b. (a -> b) -> a -> b
$ do
    Ptr Factory
factory' <- a -> IO (Ptr Factory)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
factory
    CString
engineName' <- Text -> IO CString
textToCString Text
engineName
    Ptr Engine
result <- Ptr Factory -> CString -> IO (Ptr Engine)
ibus_factory_create_engine Ptr Factory
factory' CString
engineName'
    Text -> Ptr Engine -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"factoryCreateEngine" Ptr Engine
result
    Engine
result' <- ((ManagedPtr Engine -> Engine) -> Ptr Engine -> IO Engine
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Engine -> Engine
IBus.Engine.Engine) Ptr Engine
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
factory
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
engineName'
    Engine -> IO Engine
forall (m :: * -> *) a. Monad m => a -> m a
return Engine
result'

#if defined(ENABLE_OVERLOADING)
data FactoryCreateEngineMethodInfo
instance (signature ~ (T.Text -> m IBus.Engine.Engine), MonadIO m, IsFactory a) => O.OverloadedMethod FactoryCreateEngineMethodInfo a signature where
    overloadedMethod = factoryCreateEngine

instance O.OverloadedMethodInfo FactoryCreateEngineMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.IBus.Objects.Factory.factoryCreateEngine",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-ibus-1.5.3/docs/GI-IBus-Objects-Factory.html#v:factoryCreateEngine"
        }


#endif