{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusEngineSimple provides table-based input method logic.
-- 
-- 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.EngineSimple
    ( 

-- * Exported types
    EngineSimple(..)                        ,
    IsEngineSimple                          ,
    toEngineSimple                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveEngineSimpleMethod               ,
#endif


-- ** addComposeFile #method:addComposeFile#

#if defined(ENABLE_OVERLOADING)
    EngineSimpleAddComposeFileMethodInfo    ,
#endif
    engineSimpleAddComposeFile              ,


-- ** addTable #method:addTable#

#if defined(ENABLE_OVERLOADING)
    EngineSimpleAddTableMethodInfo          ,
#endif
    engineSimpleAddTable                    ,


-- ** addTableByLocale #method:addTableByLocale#

#if defined(ENABLE_OVERLOADING)
    EngineSimpleAddTableByLocaleMethodInfo  ,
#endif
    engineSimpleAddTableByLocale            ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
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 EngineSimple = EngineSimple (SP.ManagedPtr EngineSimple)
    deriving (EngineSimple -> EngineSimple -> Bool
(EngineSimple -> EngineSimple -> Bool)
-> (EngineSimple -> EngineSimple -> Bool) -> Eq EngineSimple
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EngineSimple -> EngineSimple -> Bool
$c/= :: EngineSimple -> EngineSimple -> Bool
== :: EngineSimple -> EngineSimple -> Bool
$c== :: EngineSimple -> EngineSimple -> Bool
Eq)

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

foreign import ccall "ibus_engine_simple_get_type"
    c_ibus_engine_simple_get_type :: IO B.Types.GType

instance B.Types.TypedObject EngineSimple where
    glibType :: IO GType
glibType = IO GType
c_ibus_engine_simple_get_type

instance B.Types.GObject EngineSimple

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveEngineSimpleMethod (t :: Symbol) (o :: *) :: * where
    ResolveEngineSimpleMethod "addComposeFile" o = EngineSimpleAddComposeFileMethodInfo
    ResolveEngineSimpleMethod "addTable" o = EngineSimpleAddTableMethodInfo
    ResolveEngineSimpleMethod "addTableByLocale" o = EngineSimpleAddTableByLocaleMethodInfo
    ResolveEngineSimpleMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEngineSimpleMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEngineSimpleMethod "commitText" o = IBus.Engine.EngineCommitTextMethodInfo
    ResolveEngineSimpleMethod "deleteSurroundingText" o = IBus.Engine.EngineDeleteSurroundingTextMethodInfo
    ResolveEngineSimpleMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveEngineSimpleMethod "emitSignal" o = IBus.Service.ServiceEmitSignalMethodInfo
    ResolveEngineSimpleMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEngineSimpleMethod "forwardKeyEvent" o = IBus.Engine.EngineForwardKeyEventMethodInfo
    ResolveEngineSimpleMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEngineSimpleMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEngineSimpleMethod "hideAuxiliaryText" o = IBus.Engine.EngineHideAuxiliaryTextMethodInfo
    ResolveEngineSimpleMethod "hideLookupTable" o = IBus.Engine.EngineHideLookupTableMethodInfo
    ResolveEngineSimpleMethod "hidePreeditText" o = IBus.Engine.EngineHidePreeditTextMethodInfo
    ResolveEngineSimpleMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEngineSimpleMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEngineSimpleMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEngineSimpleMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEngineSimpleMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEngineSimpleMethod "register" o = IBus.Service.ServiceRegisterMethodInfo
    ResolveEngineSimpleMethod "registerProperties" o = IBus.Engine.EngineRegisterPropertiesMethodInfo
    ResolveEngineSimpleMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEngineSimpleMethod "showAuxiliaryText" o = IBus.Engine.EngineShowAuxiliaryTextMethodInfo
    ResolveEngineSimpleMethod "showLookupTable" o = IBus.Engine.EngineShowLookupTableMethodInfo
    ResolveEngineSimpleMethod "showPreeditText" o = IBus.Engine.EngineShowPreeditTextMethodInfo
    ResolveEngineSimpleMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEngineSimpleMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEngineSimpleMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEngineSimpleMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEngineSimpleMethod "unregister" o = IBus.Service.ServiceUnregisterMethodInfo
    ResolveEngineSimpleMethod "updateAuxiliaryText" o = IBus.Engine.EngineUpdateAuxiliaryTextMethodInfo
    ResolveEngineSimpleMethod "updateLookupTable" o = IBus.Engine.EngineUpdateLookupTableMethodInfo
    ResolveEngineSimpleMethod "updateLookupTableFast" o = IBus.Engine.EngineUpdateLookupTableFastMethodInfo
    ResolveEngineSimpleMethod "updatePreeditText" o = IBus.Engine.EngineUpdatePreeditTextMethodInfo
    ResolveEngineSimpleMethod "updatePreeditTextWithMode" o = IBus.Engine.EngineUpdatePreeditTextWithModeMethodInfo
    ResolveEngineSimpleMethod "updateProperty" o = IBus.Engine.EngineUpdatePropertyMethodInfo
    ResolveEngineSimpleMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEngineSimpleMethod "getConnection" o = IBus.Service.ServiceGetConnectionMethodInfo
    ResolveEngineSimpleMethod "getContentType" o = IBus.Engine.EngineGetContentTypeMethodInfo
    ResolveEngineSimpleMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEngineSimpleMethod "getName" o = IBus.Engine.EngineGetNameMethodInfo
    ResolveEngineSimpleMethod "getObjectPath" o = IBus.Service.ServiceGetObjectPathMethodInfo
    ResolveEngineSimpleMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEngineSimpleMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEngineSimpleMethod "getSurroundingText" o = IBus.Engine.EngineGetSurroundingTextMethodInfo
    ResolveEngineSimpleMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEngineSimpleMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEngineSimpleMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEngineSimpleMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList EngineSimple = EngineSimpleSignalList
type EngineSimpleSignalList = ('[ '("cancelHandWriting", IBus.Engine.EngineCancelHandWritingSignalInfo), '("candidateClicked", IBus.Engine.EngineCandidateClickedSignalInfo), '("cursorDown", IBus.Engine.EngineCursorDownSignalInfo), '("cursorUp", IBus.Engine.EngineCursorUpSignalInfo), '("destroy", IBus.Object.ObjectDestroySignalInfo), '("disable", IBus.Engine.EngineDisableSignalInfo), '("enable", IBus.Engine.EngineEnableSignalInfo), '("focusIn", IBus.Engine.EngineFocusInSignalInfo), '("focusOut", IBus.Engine.EngineFocusOutSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("pageDown", IBus.Engine.EnginePageDownSignalInfo), '("pageUp", IBus.Engine.EnginePageUpSignalInfo), '("processHandWritingEvent", IBus.Engine.EngineProcessHandWritingEventSignalInfo), '("processKeyEvent", IBus.Engine.EngineProcessKeyEventSignalInfo), '("propertyActivate", IBus.Engine.EnginePropertyActivateSignalInfo), '("propertyHide", IBus.Engine.EnginePropertyHideSignalInfo), '("propertyShow", IBus.Engine.EnginePropertyShowSignalInfo), '("reset", IBus.Engine.EngineResetSignalInfo), '("setCapabilities", IBus.Engine.EngineSetCapabilitiesSignalInfo), '("setContentType", IBus.Engine.EngineSetContentTypeSignalInfo), '("setCursorLocation", IBus.Engine.EngineSetCursorLocationSignalInfo), '("setSurroundingText", IBus.Engine.EngineSetSurroundingTextSignalInfo)] :: [(Symbol, *)])

#endif

-- method EngineSimple::add_compose_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "simple"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EngineSimple" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusEngineSimple."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The compose file." , 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_engine_simple_add_compose_file" ibus_engine_simple_add_compose_file :: 
    Ptr EngineSimple ->                     -- simple : TInterface (Name {namespace = "IBus", name = "EngineSimple"})
    CString ->                              -- file : TBasicType TUTF8
    IO CInt

-- | Call 'GI.IBus.Objects.EngineSimple.engineSimpleAddTable' internally by locale.
engineSimpleAddComposeFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsEngineSimple a) =>
    a
    -- ^ /@simple@/: An IBusEngineSimple.
    -> T.Text
    -- ^ /@file@/: The compose file.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@file@/ is loaded.
engineSimpleAddComposeFile :: a -> Text -> m Bool
engineSimpleAddComposeFile a
simple Text
file = IO Bool -> m Bool
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 EngineSimple
simple' <- a -> IO (Ptr EngineSimple)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
simple
    CString
file' <- Text -> IO CString
textToCString Text
file
    CInt
result <- Ptr EngineSimple -> CString -> IO CInt
ibus_engine_simple_add_compose_file Ptr EngineSimple
simple' CString
file'
    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
simple
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
file'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EngineSimpleAddComposeFileMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsEngineSimple a) => O.MethodInfo EngineSimpleAddComposeFileMethodInfo a signature where
    overloadedMethod = engineSimpleAddComposeFile

#endif

-- method EngineSimple::add_table
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "simple"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EngineSimple" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusEngineSimple."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt16)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The table which must be available\n     during the whole life of the simple engine."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_seq_len"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Maximum length of a swquence in the table (cannot be greater\n     than %IBUS_MAX_COMPOSE_LEN)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_seqs"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of sequences in the table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_engine_simple_add_table" ibus_engine_simple_add_table :: 
    Ptr EngineSimple ->                     -- simple : TInterface (Name {namespace = "IBus", name = "EngineSimple"})
    Ptr Word16 ->                           -- data : TCArray False (-1) (-1) (TBasicType TUInt16)
    Int32 ->                                -- max_seq_len : TBasicType TInt
    Int32 ->                                -- n_seqs : TBasicType TInt
    IO ()

-- | Adds an additional table to search to the engine. Each row of the table
-- consists of max_seq_len key symbols followed by two guint16 interpreted as
-- the high and low words of a gunicode value. Tables are searched starting from
-- the last added.
-- 
-- The table must be sorted in dictionary order on the numeric value of the key
-- symbol fields. (Values beyond the length of the sequence should be zero.)
engineSimpleAddTable ::
    (B.CallStack.HasCallStack, MonadIO m, IsEngineSimple a) =>
    a
    -- ^ /@simple@/: An IBusEngineSimple.
    -> [Word16]
    -- ^ /@data@/: The table which must be available
    --      during the whole life of the simple engine.
    -> Int32
    -- ^ /@maxSeqLen@/: Maximum length of a swquence in the table (cannot be greater
    --      than 'GI.IBus.Constants.MAX_COMPOSE_LEN')
    -> Int32
    -- ^ /@nSeqs@/: number of sequences in the table
    -> m ()
engineSimpleAddTable :: a -> [Word16] -> Int32 -> Int32 -> m ()
engineSimpleAddTable a
simple [Word16]
data_ Int32
maxSeqLen Int32
nSeqs = 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 EngineSimple
simple' <- a -> IO (Ptr EngineSimple)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
simple
    Ptr Word16
data_' <- [Word16] -> IO (Ptr Word16)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [Word16]
data_
    Ptr EngineSimple -> Ptr Word16 -> Int32 -> Int32 -> IO ()
ibus_engine_simple_add_table Ptr EngineSimple
simple' Ptr Word16
data_' Int32
maxSeqLen Int32
nSeqs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
simple
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
data_'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EngineSimpleAddTableMethodInfo
instance (signature ~ ([Word16] -> Int32 -> Int32 -> m ()), MonadIO m, IsEngineSimple a) => O.MethodInfo EngineSimpleAddTableMethodInfo a signature where
    overloadedMethod = engineSimpleAddTable

#endif

-- method EngineSimple::add_table_by_locale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "simple"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EngineSimple" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusEngineSimple."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locale"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The locale name. If the locale is %NULL,\n                       the current locale is used."
--                 , 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_engine_simple_add_table_by_locale" ibus_engine_simple_add_table_by_locale :: 
    Ptr EngineSimple ->                     -- simple : TInterface (Name {namespace = "IBus", name = "EngineSimple"})
    CString ->                              -- locale : TBasicType TUTF8
    IO CInt

-- | Call 'GI.IBus.Objects.EngineSimple.engineSimpleAddTable' internally by locale.
engineSimpleAddTableByLocale ::
    (B.CallStack.HasCallStack, MonadIO m, IsEngineSimple a) =>
    a
    -- ^ /@simple@/: An IBusEngineSimple.
    -> Maybe (T.Text)
    -- ^ /@locale@/: The locale name. If the locale is 'P.Nothing',
    --                        the current locale is used.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@locale@/ is matched to the table.
engineSimpleAddTableByLocale :: a -> Maybe Text -> m Bool
engineSimpleAddTableByLocale a
simple Maybe Text
locale = IO Bool -> m Bool
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 EngineSimple
simple' <- a -> IO (Ptr EngineSimple)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
simple
    CString
maybeLocale <- case Maybe Text
locale of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLocale -> do
            CString
jLocale' <- Text -> IO CString
textToCString Text
jLocale
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLocale'
    CInt
result <- Ptr EngineSimple -> CString -> IO CInt
ibus_engine_simple_add_table_by_locale Ptr EngineSimple
simple' CString
maybeLocale
    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
simple
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLocale
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data EngineSimpleAddTableByLocaleMethodInfo
instance (signature ~ (Maybe (T.Text) -> m Bool), MonadIO m, IsEngineSimple a) => O.MethodInfo EngineSimpleAddTableByLocaleMethodInfo a signature where
    overloadedMethod = engineSimpleAddTableByLocale

#endif