{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusText is the main text object in IBus.
-- The text is decorated according to associated IBusAttribute,
-- e.g. the foreground\/background color, underline, and
-- applied scope.
-- 
-- see_also: t'GI.IBus.Objects.Attribute.Attribute'

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

module GI.IBus.Objects.Text
    ( 

-- * Exported types
    Text(..)                                ,
    IsText                                  ,
    toText                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendAttribute]("GI.IBus.Objects.Text#g:method:appendAttribute"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [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"), [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"), [removeQattachment]("GI.IBus.Objects.Serializable#g:method:removeQattachment"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [serializeObject]("GI.IBus.Objects.Serializable#g:method:serializeObject"), [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
-- [getAttributes]("GI.IBus.Objects.Text#g:method:getAttributes"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLength]("GI.IBus.Objects.Text#g:method:getLength"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getText]("GI.IBus.Objects.Text#g:method:getText").
-- 
-- ==== Setters
-- [setAttributes]("GI.IBus.Objects.Text#g:method:setAttributes"), [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)
    ResolveTextMethod                       ,
#endif

-- ** appendAttribute #method:appendAttribute#

#if defined(ENABLE_OVERLOADING)
    TextAppendAttributeMethodInfo           ,
#endif
    textAppendAttribute                     ,


-- ** getAttributes #method:getAttributes#

#if defined(ENABLE_OVERLOADING)
    TextGetAttributesMethodInfo             ,
#endif
    textGetAttributes                       ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    TextGetLengthMethodInfo                 ,
#endif
    textGetLength                           ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    TextGetTextMethodInfo                   ,
#endif
    textGetText                             ,


-- ** newFromString #method:newFromString#

    textNewFromString                       ,


-- ** newFromUcs4 #method:newFromUcs4#

    textNewFromUcs4                         ,


-- ** newFromUnichar #method:newFromUnichar#

    textNewFromUnichar                      ,


-- ** setAttributes #method:setAttributes#

#if defined(ENABLE_OVERLOADING)
    TextSetAttributesMethodInfo             ,
#endif
    textSetAttributes                       ,




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.AttrList as IBus.AttrList
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

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

foreign import ccall "ibus_text_get_type"
    c_ibus_text_get_type :: IO B.Types.GType

instance B.Types.TypedObject Text where
    glibType :: IO GType
glibType = IO GType
c_ibus_text_get_type

instance B.Types.GObject Text

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

instance O.HasParentTypes Text
type instance O.ParentTypes Text = '[IBus.Serializable.Serializable, IBus.Object.Object, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTextMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextMethod "appendAttribute" o = TextAppendAttributeMethodInfo
    ResolveTextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTextMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveTextMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveTextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTextMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveTextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTextMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveTextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTextMethod "getAttributes" o = TextGetAttributesMethodInfo
    ResolveTextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTextMethod "getLength" o = TextGetLengthMethodInfo
    ResolveTextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTextMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveTextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTextMethod "getText" o = TextGetTextMethodInfo
    ResolveTextMethod "setAttributes" o = TextSetAttributesMethodInfo
    ResolveTextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTextMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveTextMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTextMethod t Text, O.OverloadedMethod info Text p) => OL.IsLabel t (Text -> 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 ~ ResolveTextMethod t Text, O.OverloadedMethod info Text p, R.HasField t Text p) => R.HasField t Text p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Text::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An text string to be set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Text" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_text_new_from_string" ibus_text_new_from_string :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr Text)

-- | Creates a new t'GI.IBus.Objects.Text.Text' from a string.
-- /@str@/ will be duplicated in t'GI.IBus.Objects.Text.Text', so feel free to free /@str@/ after this
-- function.
textNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: An text string to be set.
    -> m Text
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Text.Text'.
textNewFromString :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Text
textNewFromString Text
str = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    CString
str' <- Text -> IO CString
textToCString Text
str
    Ptr Text
result <- CString -> IO (Ptr Text)
ibus_text_new_from_string CString
str'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNewFromString" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
Text) Ptr Text
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Text::new_from_ucs4
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An text string to be set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Text" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_text_new_from_ucs4" ibus_text_new_from_ucs4 :: 
    CInt ->                                 -- str : TBasicType TUniChar
    IO (Ptr Text)

-- | Creates a new t'GI.IBus.Objects.Text.Text' from an UCS-4 encoded string.
-- /@str@/ will be duplicated in IBusText, so feel free to free /@str@/ after this
-- function.
textNewFromUcs4 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Char
    -- ^ /@str@/: An text string to be set.
    -> m Text
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Text.Text'.
textNewFromUcs4 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Char -> m Text
textNewFromUcs4 Char
str = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let str' :: CInt
str' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Char
str
    Ptr Text
result <- CInt -> IO (Ptr Text)
ibus_text_new_from_ucs4 CInt
str'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNewFromUcs4" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
Text) Ptr Text
result
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Text::new_from_unichar
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "c"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A single UCS4-encoded character."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Text" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_text_new_from_unichar" ibus_text_new_from_unichar :: 
    CInt ->                                 -- c : TBasicType TUniChar
    IO (Ptr Text)

-- | Creates a new t'GI.IBus.Objects.Text.Text' from a single UCS4-encoded character.
textNewFromUnichar ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Char
    -- ^ /@c@/: A single UCS4-encoded character.
    -> m Text
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.Text.Text'.
textNewFromUnichar :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Char -> m Text
textNewFromUnichar Char
c = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    let c' :: CInt
c' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Char
c
    Ptr Text
result <- CInt -> IO (Ptr Text)
ibus_text_new_from_unichar CInt
c'
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textNewFromUnichar" Ptr Text
result
    Text
result' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
Text) Ptr Text
result
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Text::append_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an IBusText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IBusAttributeType for @text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Value for the type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The starting index, inclusive."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "end_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The ending index, exclusive."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_text_append_attribute" ibus_text_append_attribute :: 
    Ptr Text ->                             -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    Word32 ->                               -- type : TBasicType TUInt
    Word32 ->                               -- value : TBasicType TUInt
    Word32 ->                               -- start_index : TBasicType TUInt
    Int32 ->                                -- end_index : TBasicType TInt
    IO ()

-- | Append an IBusAttribute for IBusText.
textAppendAttribute ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@text@/: an IBusText
    -> Word32
    -- ^ /@type@/: IBusAttributeType for /@text@/.
    -> Word32
    -- ^ /@value@/: Value for the type.
    -> Word32
    -- ^ /@startIndex@/: The starting index, inclusive.
    -> Int32
    -- ^ /@endIndex@/: The ending index, exclusive.
    -> m ()
textAppendAttribute :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> Word32 -> Word32 -> Word32 -> Int32 -> m ()
textAppendAttribute a
text Word32
type_ Word32
value Word32
startIndex Int32
endIndex = 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 Text
text' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
text
    Ptr Text -> Word32 -> Word32 -> Word32 -> Int32 -> IO ()
ibus_text_append_attribute Ptr Text
text' Word32
type_ Word32
value Word32
startIndex Int32
endIndex
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
text
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextAppendAttributeMethodInfo
instance (signature ~ (Word32 -> Word32 -> Word32 -> Int32 -> m ()), MonadIO m, IsText a) => O.OverloadedMethod TextAppendAttributeMethodInfo a signature where
    overloadedMethod = textAppendAttribute

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


#endif

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

foreign import ccall "ibus_text_get_attributes" ibus_text_get_attributes :: 
    Ptr Text ->                             -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO (Ptr IBus.AttrList.AttrList)

-- | Return the attributes in an t'GI.IBus.Objects.Text.Text'. Should not be freed.
textGetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@text@/: An t'GI.IBus.Objects.Text.Text'.
    -> m IBus.AttrList.AttrList
    -- ^ __Returns:__ the attrs in /@text@/.
textGetAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m AttrList
textGetAttributes a
text = IO AttrList -> m AttrList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AttrList -> m AttrList) -> IO AttrList -> m AttrList
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
text' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
text
    Ptr AttrList
result <- Ptr Text -> IO (Ptr AttrList)
ibus_text_get_attributes Ptr Text
text'
    Text -> Ptr AttrList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textGetAttributes" Ptr AttrList
result
    AttrList
result' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AttrList -> AttrList
IBus.AttrList.AttrList) Ptr AttrList
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
text
    AttrList -> IO AttrList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result'

#if defined(ENABLE_OVERLOADING)
data TextGetAttributesMethodInfo
instance (signature ~ (m IBus.AttrList.AttrList), MonadIO m, IsText a) => O.OverloadedMethod TextGetAttributesMethodInfo a signature where
    overloadedMethod = textGetAttributes

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


#endif

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

foreign import ccall "ibus_text_get_length" ibus_text_get_length :: 
    Ptr Text ->                             -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO Word32

-- | Return number of characters in an t'GI.IBus.Objects.Text.Text'.
-- This function is based on 'GI.GLib.Functions.utf8Strlen', so unlike @/strlen()/@,
-- it does not count by bytes but characters instead.
textGetLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@text@/: An t'GI.IBus.Objects.Text.Text'.
    -> m Word32
    -- ^ __Returns:__ Number of character in /@text@/, not counted by bytes.
textGetLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Word32
textGetLength a
text = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
text' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
text
    Word32
result <- Ptr Text -> IO Word32
ibus_text_get_length Ptr Text
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
text
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TextGetLengthMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsText a) => O.OverloadedMethod TextGetLengthMethodInfo a signature where
    overloadedMethod = textGetLength

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


#endif

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

foreign import ccall "ibus_text_get_text" ibus_text_get_text :: 
    Ptr Text ->                             -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO CString

-- | Return the text in an t'GI.IBus.Objects.Text.Text'. Should not be freed.
textGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a) =>
    a
    -- ^ /@text@/: An t'GI.IBus.Objects.Text.Text'.
    -> m T.Text
    -- ^ __Returns:__ the text in /@text@/.
textGetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsText a) =>
a -> m Text
textGetText a
text = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Text
text' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
text
    CString
result <- Ptr Text -> IO CString
ibus_text_get_text Ptr Text
text'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textGetText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
text
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TextGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsText a) => O.OverloadedMethod TextGetTextMethodInfo a signature where
    overloadedMethod = textGetText

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


#endif

-- method Text::set_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusText." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attrs"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_text_set_attributes" ibus_text_set_attributes :: 
    Ptr Text ->                             -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    Ptr IBus.AttrList.AttrList ->           -- attrs : TInterface (Name {namespace = "IBus", name = "AttrList"})
    IO ()

-- | /No description available in the introspection data./
textSetAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsText a, IBus.AttrList.IsAttrList b) =>
    a
    -- ^ /@text@/: An IBusText.
    -> b
    -- ^ /@attrs@/: An IBusAttrList
    -> m ()
textSetAttributes :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsText a, IsAttrList b) =>
a -> b -> m ()
textSetAttributes a
text b
attrs = 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 Text
text' <- a -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
text
    Ptr AttrList
attrs' <- b -> IO (Ptr AttrList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
attrs
    Ptr Text -> Ptr AttrList -> IO ()
ibus_text_set_attributes Ptr Text
text' Ptr AttrList
attrs'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
text
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
attrs
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSetAttributesMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsText a, IBus.AttrList.IsAttrList b) => O.OverloadedMethod TextSetAttributesMethodInfo a signature where
    overloadedMethod = textSetAttributes

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


#endif