{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An t'GI.IBus.Objects.Registry.Registry' loads IBus component files and generates the cache files.
-- 
-- see_also: t'GI.IBus.Objects.Component.Component'

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

module GI.IBus.Objects.Registry
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [checkModification]("GI.IBus.Objects.Registry#g:method:checkModification"), [copy]("GI.IBus.Objects.Serializable#g:method:copy"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [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"), [load]("GI.IBus.Objects.Registry#g:method:load"), [loadCache]("GI.IBus.Objects.Registry#g:method:loadCache"), [loadCacheFile]("GI.IBus.Objects.Registry#g:method:loadCacheFile"), [loadInDir]("GI.IBus.Objects.Registry#g:method:loadInDir"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [output]("GI.IBus.Objects.Registry#g:method:output"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeQattachment]("GI.IBus.Objects.Serializable#g:method:removeQattachment"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [saveCache]("GI.IBus.Objects.Registry#g:method:saveCache"), [saveCacheFile]("GI.IBus.Objects.Registry#g:method:saveCacheFile"), [serializeObject]("GI.IBus.Objects.Serializable#g:method:serializeObject"), [startMonitorChanges]("GI.IBus.Objects.Registry#g:method:startMonitorChanges"), [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"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getComponents]("GI.IBus.Objects.Registry#g:method:getComponents"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getObservedPaths]("GI.IBus.Objects.Registry#g:method:getObservedPaths"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [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"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment").

#if defined(ENABLE_OVERLOADING)
    ResolveRegistryMethod                   ,
#endif

-- ** checkModification #method:checkModification#

#if defined(ENABLE_OVERLOADING)
    RegistryCheckModificationMethodInfo     ,
#endif
    registryCheckModification               ,


-- ** getComponents #method:getComponents#

#if defined(ENABLE_OVERLOADING)
    RegistryGetComponentsMethodInfo         ,
#endif
    registryGetComponents                   ,


-- ** getObservedPaths #method:getObservedPaths#

#if defined(ENABLE_OVERLOADING)
    RegistryGetObservedPathsMethodInfo      ,
#endif
    registryGetObservedPaths                ,


-- ** load #method:load#

#if defined(ENABLE_OVERLOADING)
    RegistryLoadMethodInfo                  ,
#endif
    registryLoad                            ,


-- ** loadCache #method:loadCache#

#if defined(ENABLE_OVERLOADING)
    RegistryLoadCacheMethodInfo             ,
#endif
    registryLoadCache                       ,


-- ** loadCacheFile #method:loadCacheFile#

#if defined(ENABLE_OVERLOADING)
    RegistryLoadCacheFileMethodInfo         ,
#endif
    registryLoadCacheFile                   ,


-- ** loadInDir #method:loadInDir#

#if defined(ENABLE_OVERLOADING)
    RegistryLoadInDirMethodInfo             ,
#endif
    registryLoadInDir                       ,


-- ** new #method:new#

    registryNew                             ,


-- ** output #method:output#

#if defined(ENABLE_OVERLOADING)
    RegistryOutputMethodInfo                ,
#endif
    registryOutput                          ,


-- ** saveCache #method:saveCache#

#if defined(ENABLE_OVERLOADING)
    RegistrySaveCacheMethodInfo             ,
#endif
    registrySaveCache                       ,


-- ** saveCacheFile #method:saveCacheFile#

#if defined(ENABLE_OVERLOADING)
    RegistrySaveCacheFileMethodInfo         ,
#endif
    registrySaveCacheFile                   ,


-- ** startMonitorChanges #method:startMonitorChanges#

#if defined(ENABLE_OVERLOADING)
    RegistryStartMonitorChangesMethodInfo   ,
#endif
    registryStartMonitorChanges             ,




 -- * Signals


-- ** changed #signal:changed#

    RegistryChangedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    RegistryChangedSignalInfo               ,
#endif
    afterRegistryChanged                    ,
    onRegistryChanged                       ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
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.GLib.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Component as IBus.Component
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.ObservedPath as IBus.ObservedPath
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

-- | 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
$c== :: Registry -> Registry -> Bool
== :: Registry -> Registry -> Bool
$c/= :: Registry -> Registry -> Bool
/= :: Registry -> Registry -> Bool
Eq)

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

foreign import ccall "ibus_registry_get_type"
    c_ibus_registry_get_type :: IO B.Types.GType

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

instance B.Types.GObject Registry

-- | 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 = '[IBus.Serializable.Serializable, IBus.Object.Object, 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 :: (MIO.MonadIO m, IsRegistry o) => o -> m Registry
toRegistry :: forall (m :: * -> *) o.
(MonadIO m, IsRegistry o) =>
o -> m Registry
toRegistry = IO Registry -> m Registry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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'
B.ManagedPtr.unsafeCastTo ManagedPtr Registry -> Registry
Registry

-- | Convert 'Registry' 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 Registry) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ibus_registry_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Registry -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Registry
P.Nothing = Ptr GValue -> Ptr Registry -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Registry
forall a. Ptr a
FP.nullPtr :: FP.Ptr Registry)
    gvalueSet_ Ptr GValue
gv (P.Just Registry
obj) = Registry -> (Ptr Registry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Registry
obj (Ptr GValue -> Ptr Registry -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Registry)
gvalueGet_ Ptr GValue
gv = do
        Ptr Registry
ptr <- Ptr GValue -> IO (Ptr Registry)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Registry)
        if Ptr Registry
ptr Ptr Registry -> Ptr Registry -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Registry
forall a. Ptr a
FP.nullPtr
        then Registry -> Maybe Registry
forall a. a -> Maybe a
P.Just (Registry -> Maybe Registry) -> IO Registry -> IO (Maybe Registry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe Registry -> IO (Maybe Registry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Registry
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveRegistryMethod (t :: Symbol) (o :: *) :: * where
    ResolveRegistryMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRegistryMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRegistryMethod "checkModification" o = RegistryCheckModificationMethodInfo
    ResolveRegistryMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveRegistryMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    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 "load" o = RegistryLoadMethodInfo
    ResolveRegistryMethod "loadCache" o = RegistryLoadCacheMethodInfo
    ResolveRegistryMethod "loadCacheFile" o = RegistryLoadCacheFileMethodInfo
    ResolveRegistryMethod "loadInDir" o = RegistryLoadInDirMethodInfo
    ResolveRegistryMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRegistryMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRegistryMethod "output" o = RegistryOutputMethodInfo
    ResolveRegistryMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRegistryMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRegistryMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveRegistryMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRegistryMethod "saveCache" o = RegistrySaveCacheMethodInfo
    ResolveRegistryMethod "saveCacheFile" o = RegistrySaveCacheFileMethodInfo
    ResolveRegistryMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveRegistryMethod "startMonitorChanges" o = RegistryStartMonitorChangesMethodInfo
    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 "getComponents" o = RegistryGetComponentsMethodInfo
    ResolveRegistryMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRegistryMethod "getObservedPaths" o = RegistryGetObservedPathsMethodInfo
    ResolveRegistryMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRegistryMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveRegistryMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRegistryMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRegistryMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRegistryMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRegistryMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveRegistryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveRegistryMethod t Registry, O.OverloadedMethod 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

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

#endif

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

#endif

-- signal Registry::changed
-- | Emitted when any observed paths are changed.
-- A method is not associated in this class. the \"changed\"
-- signal would be handled in other classes.
-- 
-- See also: 'GI.IBus.Objects.Registry.registryStartMonitorChanges'.
type RegistryChangedCallback =
    IO ()

type C_RegistryChangedCallback =
    Ptr Registry ->                         -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_RegistryChangedCallback :: 
    GObject a => (a -> RegistryChangedCallback) ->
    C_RegistryChangedCallback
wrap_RegistryChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_RegistryChangedCallback
wrap_RegistryChangedCallback a -> IO ()
gi'cb Ptr Registry
gi'selfPtr Ptr ()
_ = do
    Ptr Registry -> (Registry -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Registry
gi'selfPtr ((Registry -> IO ()) -> IO ()) -> (Registry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Registry
gi'self -> a -> IO ()
gi'cb (Registry -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Registry
gi'self) 


-- | Connect a signal handler for the [changed](#signal:changed) 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' registry #changed callback
-- @
-- 
-- 
onRegistryChanged :: (IsRegistry a, MonadIO m) => a -> ((?self :: a) => RegistryChangedCallback) -> m SignalHandlerId
onRegistryChanged :: forall a (m :: * -> *).
(IsRegistry a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onRegistryChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_RegistryChangedCallback
wrapped' = (a -> IO ()) -> C_RegistryChangedCallback
forall a. GObject a => (a -> IO ()) -> C_RegistryChangedCallback
wrap_RegistryChangedCallback a -> IO ()
wrapped
    FunPtr C_RegistryChangedCallback
wrapped'' <- C_RegistryChangedCallback -> IO (FunPtr C_RegistryChangedCallback)
mk_RegistryChangedCallback C_RegistryChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_RegistryChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_RegistryChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) 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' registry #changed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterRegistryChanged :: (IsRegistry a, MonadIO m) => a -> ((?self :: a) => RegistryChangedCallback) -> m SignalHandlerId
afterRegistryChanged :: forall a (m :: * -> *).
(IsRegistry a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterRegistryChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_RegistryChangedCallback
wrapped' = (a -> IO ()) -> C_RegistryChangedCallback
forall a. GObject a => (a -> IO ()) -> C_RegistryChangedCallback
wrap_RegistryChangedCallback a -> IO ()
wrapped
    FunPtr C_RegistryChangedCallback
wrapped'' <- C_RegistryChangedCallback -> IO (FunPtr C_RegistryChangedCallback)
mk_RegistryChangedCallback C_RegistryChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_RegistryChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_RegistryChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data RegistryChangedSignalInfo
instance SignalInfo RegistryChangedSignalInfo where
    type HaskellCallbackType RegistryChangedSignalInfo = RegistryChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_RegistryChangedCallback cb
        cb'' <- mk_RegistryChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry::changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#g:signal:changed"})

#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 = ('[ '("changed", RegistryChangedSignalInfo), '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Registry::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Registry" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_new" ibus_registry_new :: 
    IO (Ptr Registry)

-- | Creates a new t'GI.IBus.Objects.Registry.Registry'
registryNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Registry
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Registry.Registry'.
registryNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Registry
registryNew  = IO Registry -> m Registry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Registry -> m Registry) -> IO Registry -> m Registry
forall a b. (a -> b) -> a -> b
$ do
    Ptr Registry
result <- IO (Ptr Registry)
ibus_registry_new
    Text -> Ptr Registry -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"registryNew" Ptr Registry
result
    Registry
result' <- ((ManagedPtr Registry -> Registry) -> Ptr Registry -> IO Registry
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Registry -> Registry
Registry) Ptr Registry
result
    Registry -> IO Registry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Registry
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Registry::check_modification
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_check_modification" ibus_registry_check_modification :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    IO CInt

-- | Check if the registry is updated.
registryCheckModification ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if mtime is changed; 'P.False' otherwise.
registryCheckModification :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> m Bool
registryCheckModification a
registry = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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
    CInt
result <- Ptr Registry -> IO CInt
ibus_registry_check_modification Ptr Registry
registry'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RegistryCheckModificationMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryCheckModificationMethodInfo a signature where
    overloadedMethod = registryCheckModification

instance O.OverloadedMethodInfo RegistryCheckModificationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryCheckModification",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryCheckModification"
        })


#endif

-- method Registry::get_components
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "IBus" , name = "Component" }))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_get_components" ibus_registry_get_components :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    IO (Ptr (GList (Ptr IBus.Component.Component)))

-- | List components.
registryGetComponents ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> m [IBus.Component.Component]
    -- ^ __Returns:__ 
    -- a list of t'GI.IBus.Objects.Component.Component' objects.
    -- The caller has to call @/g_list_free()/@ for the returned list.
registryGetComponents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> m [Component]
registryGetComponents a
registry = IO [Component] -> m [Component]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Component] -> m [Component])
-> IO [Component] -> m [Component]
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
    Ptr (GList (Ptr Component))
result <- Ptr Registry -> IO (Ptr (GList (Ptr Component)))
ibus_registry_get_components Ptr Registry
registry'
    [Ptr Component]
result' <- Ptr (GList (Ptr Component)) -> IO [Ptr Component]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Component))
result
    [Component]
result'' <- (Ptr Component -> IO Component)
-> [Ptr Component] -> IO [Component]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Component -> Component)
-> Ptr Component -> IO Component
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Component -> Component
IBus.Component.Component) [Ptr Component]
result'
    Ptr (GList (Ptr Component)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Component))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    [Component] -> IO [Component]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Component]
result''

#if defined(ENABLE_OVERLOADING)
data RegistryGetComponentsMethodInfo
instance (signature ~ (m [IBus.Component.Component]), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryGetComponentsMethodInfo a signature where
    overloadedMethod = registryGetComponents

instance O.OverloadedMethodInfo RegistryGetComponentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryGetComponents",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryGetComponents"
        })


#endif

-- method Registry::get_observed_paths
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "IBus" , name = "ObservedPath" }))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_get_observed_paths" ibus_registry_get_observed_paths :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    IO (Ptr (GList (Ptr IBus.ObservedPath.ObservedPath)))

-- | List observed paths.
registryGetObservedPaths ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> m [IBus.ObservedPath.ObservedPath]
    -- ^ __Returns:__ 
    -- a list of t'GI.IBus.Objects.ObservedPath.ObservedPath' objects.
    -- The caller has to call @/g_list_free()/@ for the returned list.
registryGetObservedPaths :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> m [ObservedPath]
registryGetObservedPaths a
registry = IO [ObservedPath] -> m [ObservedPath]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ObservedPath] -> m [ObservedPath])
-> IO [ObservedPath] -> m [ObservedPath]
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
    Ptr (GList (Ptr ObservedPath))
result <- Ptr Registry -> IO (Ptr (GList (Ptr ObservedPath)))
ibus_registry_get_observed_paths Ptr Registry
registry'
    [Ptr ObservedPath]
result' <- Ptr (GList (Ptr ObservedPath)) -> IO [Ptr ObservedPath]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ObservedPath))
result
    [ObservedPath]
result'' <- (Ptr ObservedPath -> IO ObservedPath)
-> [Ptr ObservedPath] -> IO [ObservedPath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr ObservedPath -> ObservedPath)
-> Ptr ObservedPath -> IO ObservedPath
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ObservedPath -> ObservedPath
IBus.ObservedPath.ObservedPath) [Ptr ObservedPath]
result'
    Ptr (GList (Ptr ObservedPath)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr ObservedPath))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    [ObservedPath] -> IO [ObservedPath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ObservedPath]
result''

#if defined(ENABLE_OVERLOADING)
data RegistryGetObservedPathsMethodInfo
instance (signature ~ (m [IBus.ObservedPath.ObservedPath]), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryGetObservedPathsMethodInfo a signature where
    overloadedMethod = registryGetObservedPaths

instance O.OverloadedMethodInfo RegistryGetObservedPathsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryGetObservedPaths",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryGetObservedPaths"
        })


#endif

-- method Registry::load
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_load" ibus_registry_load :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    IO ()

-- | Read all XML files in a IBus component directory (typically
-- \/usr\/share\/ibus\/component\/ *.xml) and update the registry object.
-- IBUS_COMPONENT_PATH environment valuable is also available for
-- the custom component directories, whose delimiter is \':\'.
registryLoad ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> m ()
registryLoad :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> m ()
registryLoad a
registry = IO () -> m ()
forall a. IO a -> m a
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
    Ptr Registry -> IO ()
ibus_registry_load Ptr Registry
registry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegistryLoadMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryLoadMethodInfo a signature where
    overloadedMethod = registryLoad

instance O.OverloadedMethodInfo RegistryLoadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryLoad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryLoad"
        })


#endif

-- method Registry::load_cache
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_user"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the registry cache is loaded in the user directory."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_load_cache" ibus_registry_load_cache :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    CInt ->                                 -- is_user : TBasicType TBoolean
    IO CInt

-- | Load the user or system registry cache.
registryLoadCache ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> Bool
    -- ^ /@isUser@/: 'P.True' if the registry cache is loaded in the user directory.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the cache exists and is loaded successfully,
    --           'P.False' otherwise.
registryLoadCache :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> Bool -> m Bool
registryLoadCache a
registry Bool
isUser = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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 isUser' :: CInt
isUser' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isUser
    CInt
result <- Ptr Registry -> CInt -> IO CInt
ibus_registry_load_cache Ptr Registry
registry' CInt
isUser'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RegistryLoadCacheMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryLoadCacheMethodInfo a signature where
    overloadedMethod = registryLoadCache

instance O.OverloadedMethodInfo RegistryLoadCacheMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryLoadCache",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryLoadCache"
        })


#endif

-- method Registry::load_cache_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The file path of the registry cache"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_load_cache_file" ibus_registry_load_cache_file :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    CString ->                              -- filename : TBasicType TUTF8
    IO CInt

-- | Load the registry cache /@filename@/.
registryLoadCacheFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> T.Text
    -- ^ /@filename@/: The file path of the registry cache
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the cache exists and is loaded successfully,
    --           'P.False' otherwise.
registryLoadCacheFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> Text -> m Bool
registryLoadCacheFile a
registry Text
filename = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CInt
result <- Ptr Registry -> CString -> IO CInt
ibus_registry_load_cache_file Ptr Registry
registry' CString
filename'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RegistryLoadCacheFileMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryLoadCacheFileMethodInfo a signature where
    overloadedMethod = registryLoadCacheFile

instance O.OverloadedMethodInfo RegistryLoadCacheFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryLoadCacheFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryLoadCacheFile"
        })


#endif

-- method Registry::load_in_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dirname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "IBus component directory which includes XML files."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_load_in_dir" ibus_registry_load_in_dir :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    CString ->                              -- dirname : TBasicType TUTF8
    IO ()

-- | Read all XML files in /@dirname@/, create a t'GI.IBus.Objects.Component.Component' object for each file,
-- and add the component objects to the registry.
-- If /@dirname@/ is \"\/usr\/share\/ibus\/component\", this API and
-- 'GI.IBus.Objects.Registry.registryLoad' are same.
registryLoadInDir ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> T.Text
    -- ^ /@dirname@/: IBus component directory which includes XML files.
    -> m ()
registryLoadInDir :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> Text -> m ()
registryLoadInDir a
registry Text
dirname = IO () -> m ()
forall a. IO a -> m a
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
    CString
dirname' <- Text -> IO CString
textToCString Text
dirname
    Ptr Registry -> CString -> IO ()
ibus_registry_load_in_dir Ptr Registry
registry' CString
dirname'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dirname'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegistryLoadInDirMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryLoadInDirMethodInfo a signature where
    overloadedMethod = registryLoadInDir

instance O.OverloadedMethodInfo RegistryLoadInDirMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryLoadInDir",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryLoadInDir"
        })


#endif

-- method Registry::output
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "output"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GString that holds the result."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "indent"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "level of indent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_output" ibus_registry_output :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    Ptr GLib.String.String ->               -- output : TInterface (Name {namespace = "GLib", name = "String"})
    Int32 ->                                -- indent : TBasicType TInt
    IO ()

-- | Output t'GI.IBus.Objects.Registry.Registry' as an XML-formatted string.
-- The output string can be then shown on the screen or written to file.
registryOutput ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> GLib.String.String
    -- ^ /@output@/: GString that holds the result.
    -> Int32
    -- ^ /@indent@/: level of indent.
    -> m ()
registryOutput :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> String -> Int32 -> m ()
registryOutput a
registry String
output Int32
indent = IO () -> m ()
forall a. IO a -> m a
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
    Ptr String
output' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
output
    Ptr Registry -> Ptr String -> Int32 -> IO ()
ibus_registry_output Ptr Registry
registry' Ptr String
output' Int32
indent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
output
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegistryOutputMethodInfo
instance (signature ~ (GLib.String.String -> Int32 -> m ()), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryOutputMethodInfo a signature where
    overloadedMethod = registryOutput

instance O.OverloadedMethodInfo RegistryOutputMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryOutput",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryOutput"
        })


#endif

-- method Registry::save_cache
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_user"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE if the registry cache is saved in the user directory."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_save_cache" ibus_registry_save_cache :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    CInt ->                                 -- is_user : TBasicType TBoolean
    IO CInt

-- | Save the registry in a user directory or system directory.
registrySaveCache ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> Bool
    -- ^ /@isUser@/: 'P.True' if the registry cache is saved in the user directory.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the cache is saved successfully, 'P.False' otherwise.
registrySaveCache :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> Bool -> m Bool
registrySaveCache a
registry Bool
isUser = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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 isUser' :: CInt
isUser' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isUser
    CInt
result <- Ptr Registry -> CInt -> IO CInt
ibus_registry_save_cache Ptr Registry
registry' CInt
isUser'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RegistrySaveCacheMethodInfo
instance (signature ~ (Bool -> m Bool), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistrySaveCacheMethodInfo a signature where
    overloadedMethod = registrySaveCache

instance O.OverloadedMethodInfo RegistrySaveCacheMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registrySaveCache",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registrySaveCache"
        })


#endif

-- method Registry::save_cache_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The file path of the registry cache"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_save_cache_file" ibus_registry_save_cache_file :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    CString ->                              -- filename : TBasicType TUTF8
    IO CInt

-- | Save the registry cache /@filename@/.
registrySaveCacheFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> T.Text
    -- ^ /@filename@/: The file path of the registry cache
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the cache is saved successfully, 'P.False' otherwise.
registrySaveCacheFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> Text -> m Bool
registrySaveCacheFile a
registry Text
filename = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CInt
result <- Ptr Registry -> CString -> IO CInt
ibus_registry_save_cache_file Ptr Registry
registry' CString
filename'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RegistrySaveCacheFileMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistrySaveCacheFileMethodInfo a signature where
    overloadedMethod = registrySaveCacheFile

instance O.OverloadedMethodInfo RegistrySaveCacheFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registrySaveCacheFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registrySaveCacheFile"
        })


#endif

-- method Registry::start_monitor_changes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "registry"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Registry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusRegistry." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_registry_start_monitor_changes" ibus_registry_start_monitor_changes :: 
    Ptr Registry ->                         -- registry : TInterface (Name {namespace = "IBus", name = "Registry"})
    IO ()

-- | Start to monitor observed paths.
registryStartMonitorChanges ::
    (B.CallStack.HasCallStack, MonadIO m, IsRegistry a) =>
    a
    -- ^ /@registry@/: An t'GI.IBus.Objects.Registry.Registry'.
    -> m ()
registryStartMonitorChanges :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRegistry a) =>
a -> m ()
registryStartMonitorChanges a
registry = IO () -> m ()
forall a. IO a -> m a
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
    Ptr Registry -> IO ()
ibus_registry_start_monitor_changes Ptr Registry
registry'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
registry
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RegistryStartMonitorChangesMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRegistry a) => O.OverloadedMethod RegistryStartMonitorChangesMethodInfo a signature where
    overloadedMethod = registryStartMonitorChanges

instance O.OverloadedMethodInfo RegistryStartMonitorChangesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.Registry.registryStartMonitorChanges",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-Registry.html#v:registryStartMonitorChanges"
        })


#endif