{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Emoji data likes emoji unicode, annotations, description, category.
-- You can get extended values with g_object_get_properties.

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

module GI.IBus.Objects.EmojiData
    ( 

-- * Exported types
    EmojiData(..)                           ,
    IsEmojiData                             ,
    toEmojiData                             ,


 -- * 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"), [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
-- [getAnnotations]("GI.IBus.Objects.EmojiData#g:method:getAnnotations"), [getCategory]("GI.IBus.Objects.EmojiData#g:method:getCategory"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.IBus.Objects.EmojiData#g:method:getDescription"), [getEmoji]("GI.IBus.Objects.EmojiData#g:method:getEmoji"), [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
-- [setAnnotations]("GI.IBus.Objects.EmojiData#g:method:setAnnotations"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDescription]("GI.IBus.Objects.EmojiData#g:method:setDescription"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment").

#if defined(ENABLE_OVERLOADING)
    ResolveEmojiDataMethod                  ,
#endif

-- ** getAnnotations #method:getAnnotations#

#if defined(ENABLE_OVERLOADING)
    EmojiDataGetAnnotationsMethodInfo       ,
#endif
    emojiDataGetAnnotations                 ,


-- ** getCategory #method:getCategory#

#if defined(ENABLE_OVERLOADING)
    EmojiDataGetCategoryMethodInfo          ,
#endif
    emojiDataGetCategory                    ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    EmojiDataGetDescriptionMethodInfo       ,
#endif
    emojiDataGetDescription                 ,


-- ** getEmoji #method:getEmoji#

#if defined(ENABLE_OVERLOADING)
    EmojiDataGetEmojiMethodInfo             ,
#endif
    emojiDataGetEmoji                       ,


-- ** load #method:load#

    emojiDataLoad                           ,


-- ** save #method:save#

    emojiDataSave                           ,


-- ** setAnnotations #method:setAnnotations#

#if defined(ENABLE_OVERLOADING)
    EmojiDataSetAnnotationsMethodInfo       ,
#endif
    emojiDataSetAnnotations                 ,


-- ** setDescription #method:setDescription#

#if defined(ENABLE_OVERLOADING)
    EmojiDataSetDescriptionMethodInfo       ,
#endif
    emojiDataSetDescription                 ,




 -- * Properties


-- ** annotations #attr:annotations#

#if defined(ENABLE_OVERLOADING)
    EmojiDataAnnotationsPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    emojiDataAnnotations                    ,
#endif


-- ** category #attr:category#
-- | The emoji category

#if defined(ENABLE_OVERLOADING)
    EmojiDataCategoryPropertyInfo           ,
#endif
    constructEmojiDataCategory              ,
#if defined(ENABLE_OVERLOADING)
    emojiDataCategory                       ,
#endif
    getEmojiDataCategory                    ,


-- ** description #attr:description#
-- | The emoji description

#if defined(ENABLE_OVERLOADING)
    EmojiDataDescriptionPropertyInfo        ,
#endif
    constructEmojiDataDescription           ,
#if defined(ENABLE_OVERLOADING)
    emojiDataDescription                    ,
#endif
    getEmojiDataDescription                 ,
    setEmojiDataDescription                 ,


-- ** emoji #attr:emoji#
-- | The emoji character

#if defined(ENABLE_OVERLOADING)
    EmojiDataEmojiPropertyInfo              ,
#endif
    constructEmojiDataEmoji                 ,
#if defined(ENABLE_OVERLOADING)
    emojiDataEmoji                          ,
#endif
    getEmojiDataEmoji                       ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

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

foreign import ccall "ibus_emoji_data_get_type"
    c_ibus_emoji_data_get_type :: IO B.Types.GType

instance B.Types.TypedObject EmojiData where
    glibType :: IO GType
glibType = IO GType
c_ibus_emoji_data_get_type

instance B.Types.GObject EmojiData

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveEmojiDataMethod (t :: Symbol) (o :: *) :: * where
    ResolveEmojiDataMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveEmojiDataMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveEmojiDataMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveEmojiDataMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveEmojiDataMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveEmojiDataMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveEmojiDataMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveEmojiDataMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveEmojiDataMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveEmojiDataMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveEmojiDataMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveEmojiDataMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveEmojiDataMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveEmojiDataMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveEmojiDataMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveEmojiDataMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveEmojiDataMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveEmojiDataMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveEmojiDataMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveEmojiDataMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveEmojiDataMethod "getAnnotations" o = EmojiDataGetAnnotationsMethodInfo
    ResolveEmojiDataMethod "getCategory" o = EmojiDataGetCategoryMethodInfo
    ResolveEmojiDataMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveEmojiDataMethod "getDescription" o = EmojiDataGetDescriptionMethodInfo
    ResolveEmojiDataMethod "getEmoji" o = EmojiDataGetEmojiMethodInfo
    ResolveEmojiDataMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveEmojiDataMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveEmojiDataMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveEmojiDataMethod "setAnnotations" o = EmojiDataSetAnnotationsMethodInfo
    ResolveEmojiDataMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveEmojiDataMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveEmojiDataMethod "setDescription" o = EmojiDataSetDescriptionMethodInfo
    ResolveEmojiDataMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveEmojiDataMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveEmojiDataMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- XXX Generation of property "annotations" of object "EmojiData" failed.
-- Not implemented: Property EmojiDataAnnotations has unsupported transfer type TransferContainer
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data EmojiDataAnnotationsPropertyInfo
instance AttrInfo EmojiDataAnnotationsPropertyInfo where
    type AttrAllowedOps EmojiDataAnnotationsPropertyInfo = '[]
    type AttrSetTypeConstraint EmojiDataAnnotationsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint EmojiDataAnnotationsPropertyInfo = (~) ()
    type AttrTransferType EmojiDataAnnotationsPropertyInfo = ()
    type AttrBaseTypeConstraint EmojiDataAnnotationsPropertyInfo = (~) ()
    type AttrGetType EmojiDataAnnotationsPropertyInfo = ()
    type AttrLabel EmojiDataAnnotationsPropertyInfo = ""
    type AttrOrigin EmojiDataAnnotationsPropertyInfo = EmojiData
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- VVV Prop "category"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@category@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' emojiData #category
-- @
getEmojiDataCategory :: (MonadIO m, IsEmojiData o) => o -> m T.Text
getEmojiDataCategory :: forall (m :: * -> *) o. (MonadIO m, IsEmojiData o) => o -> m Text
getEmojiDataCategory o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getEmojiDataCategory" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"category"

-- | Construct a `GValueConstruct` with valid value for the “@category@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEmojiDataCategory :: (IsEmojiData o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEmojiDataCategory :: forall o (m :: * -> *).
(IsEmojiData o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEmojiDataCategory Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"category" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data EmojiDataCategoryPropertyInfo
instance AttrInfo EmojiDataCategoryPropertyInfo where
    type AttrAllowedOps EmojiDataCategoryPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EmojiDataCategoryPropertyInfo = IsEmojiData
    type AttrSetTypeConstraint EmojiDataCategoryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EmojiDataCategoryPropertyInfo = (~) T.Text
    type AttrTransferType EmojiDataCategoryPropertyInfo = T.Text
    type AttrGetType EmojiDataCategoryPropertyInfo = T.Text
    type AttrLabel EmojiDataCategoryPropertyInfo = "category"
    type AttrOrigin EmojiDataCategoryPropertyInfo = EmojiData
    attrGet = getEmojiDataCategory
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructEmojiDataCategory
    attrClear = undefined
#endif

-- VVV Prop "description"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' emojiData #description
-- @
getEmojiDataDescription :: (MonadIO m, IsEmojiData o) => o -> m T.Text
getEmojiDataDescription :: forall (m :: * -> *) o. (MonadIO m, IsEmojiData o) => o -> m Text
getEmojiDataDescription o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getEmojiDataDescription" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"description"

-- | Set the value of the “@description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' emojiData [ #description 'Data.GI.Base.Attributes.:=' value ]
-- @
setEmojiDataDescription :: (MonadIO m, IsEmojiData o) => o -> T.Text -> m ()
setEmojiDataDescription :: forall (m :: * -> *) o.
(MonadIO m, IsEmojiData o) =>
o -> Text -> m ()
setEmojiDataDescription o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"description" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@description@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEmojiDataDescription :: (IsEmojiData o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEmojiDataDescription :: forall o (m :: * -> *).
(IsEmojiData o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEmojiDataDescription Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"description" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data EmojiDataDescriptionPropertyInfo
instance AttrInfo EmojiDataDescriptionPropertyInfo where
    type AttrAllowedOps EmojiDataDescriptionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint EmojiDataDescriptionPropertyInfo = IsEmojiData
    type AttrSetTypeConstraint EmojiDataDescriptionPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EmojiDataDescriptionPropertyInfo = (~) T.Text
    type AttrTransferType EmojiDataDescriptionPropertyInfo = T.Text
    type AttrGetType EmojiDataDescriptionPropertyInfo = T.Text
    type AttrLabel EmojiDataDescriptionPropertyInfo = "description"
    type AttrOrigin EmojiDataDescriptionPropertyInfo = EmojiData
    attrGet = getEmojiDataDescription
    attrSet = setEmojiDataDescription
    attrTransfer _ v = do
        return v
    attrConstruct = constructEmojiDataDescription
    attrClear = undefined
#endif

-- VVV Prop "emoji"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@emoji@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' emojiData #emoji
-- @
getEmojiDataEmoji :: (MonadIO m, IsEmojiData o) => o -> m T.Text
getEmojiDataEmoji :: forall (m :: * -> *) o. (MonadIO m, IsEmojiData o) => o -> m Text
getEmojiDataEmoji o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getEmojiDataEmoji" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"emoji"

-- | Construct a `GValueConstruct` with valid value for the “@emoji@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructEmojiDataEmoji :: (IsEmojiData o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructEmojiDataEmoji :: forall o (m :: * -> *).
(IsEmojiData o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructEmojiDataEmoji Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"emoji" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data EmojiDataEmojiPropertyInfo
instance AttrInfo EmojiDataEmojiPropertyInfo where
    type AttrAllowedOps EmojiDataEmojiPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint EmojiDataEmojiPropertyInfo = IsEmojiData
    type AttrSetTypeConstraint EmojiDataEmojiPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint EmojiDataEmojiPropertyInfo = (~) T.Text
    type AttrTransferType EmojiDataEmojiPropertyInfo = T.Text
    type AttrGetType EmojiDataEmojiPropertyInfo = T.Text
    type AttrLabel EmojiDataEmojiPropertyInfo = "emoji"
    type AttrOrigin EmojiDataEmojiPropertyInfo = EmojiData
    attrGet = getEmojiDataEmoji
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructEmojiDataEmoji
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList EmojiData
type instance O.AttributeList EmojiData = EmojiDataAttributeList
type EmojiDataAttributeList = ('[ '("annotations", EmojiDataAnnotationsPropertyInfo), '("category", EmojiDataCategoryPropertyInfo), '("description", EmojiDataDescriptionPropertyInfo), '("emoji", EmojiDataEmojiPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
emojiDataAnnotations :: AttrLabelProxy "annotations"
emojiDataAnnotations = AttrLabelProxy

emojiDataCategory :: AttrLabelProxy "category"
emojiDataCategory = AttrLabelProxy

emojiDataDescription :: AttrLabelProxy "description"
emojiDataDescription = AttrLabelProxy

emojiDataEmoji :: AttrLabelProxy "emoji"
emojiDataEmoji = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "ibus_emoji_data_get_annotations" ibus_emoji_data_get_annotations :: 
    Ptr EmojiData ->                        -- emoji : TInterface (Name {namespace = "IBus", name = "EmojiData"})
    IO (Ptr (GSList CString))

-- | Gets the annotation list in t'GI.IBus.Objects.EmojiData.EmojiData'. It should not be freed.
emojiDataGetAnnotations ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    a
    -- ^ /@emoji@/: An t'GI.IBus.Objects.EmojiData.EmojiData'
    -> m [T.Text]
    -- ^ __Returns:__ 
    --          annotation list property in t'GI.IBus.Objects.EmojiData.EmojiData'
emojiDataGetAnnotations :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
a -> m [Text]
emojiDataGetAnnotations a
emoji = IO [Text] -> m [Text]
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 EmojiData
emoji' <- a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
emoji
    Ptr (GSList CString)
result <- Ptr EmojiData -> IO (Ptr (GSList CString))
ibus_emoji_data_get_annotations Ptr EmojiData
emoji'
    [CString]
result' <- Ptr (GSList CString) -> IO [CString]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
emoji
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data EmojiDataGetAnnotationsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsEmojiData a) => O.OverloadedMethod EmojiDataGetAnnotationsMethodInfo a signature where
    overloadedMethod = emojiDataGetAnnotations

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


#endif

-- method EmojiData::get_category
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "emoji"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EmojiData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusEmojiData" , 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_emoji_data_get_category" ibus_emoji_data_get_category :: 
    Ptr EmojiData ->                        -- emoji : TInterface (Name {namespace = "IBus", name = "EmojiData"})
    IO CString

-- | Gets the emoji category in t'GI.IBus.Objects.EmojiData.EmojiData'. It should not be freed.
emojiDataGetCategory ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    a
    -- ^ /@emoji@/: An t'GI.IBus.Objects.EmojiData.EmojiData'
    -> m T.Text
    -- ^ __Returns:__ category property in t'GI.IBus.Objects.EmojiData.EmojiData'
emojiDataGetCategory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
a -> m Text
emojiDataGetCategory a
emoji = IO Text -> m Text
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 EmojiData
emoji' <- a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
emoji
    CString
result <- Ptr EmojiData -> IO CString
ibus_emoji_data_get_category Ptr EmojiData
emoji'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"emojiDataGetCategory" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
emoji
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EmojiDataGetCategoryMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEmojiData a) => O.OverloadedMethod EmojiDataGetCategoryMethodInfo a signature where
    overloadedMethod = emojiDataGetCategory

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


#endif

-- method EmojiData::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "emoji"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EmojiData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusEmojiData" , 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_emoji_data_get_description" ibus_emoji_data_get_description :: 
    Ptr EmojiData ->                        -- emoji : TInterface (Name {namespace = "IBus", name = "EmojiData"})
    IO CString

-- | Gets the emoji description in t'GI.IBus.Objects.EmojiData.EmojiData'. It should not be freed.
emojiDataGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    a
    -- ^ /@emoji@/: An t'GI.IBus.Objects.EmojiData.EmojiData'
    -> m T.Text
    -- ^ __Returns:__ description property in t'GI.IBus.Objects.EmojiData.EmojiData'
emojiDataGetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
a -> m Text
emojiDataGetDescription a
emoji = IO Text -> m Text
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 EmojiData
emoji' <- a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
emoji
    CString
result <- Ptr EmojiData -> IO CString
ibus_emoji_data_get_description Ptr EmojiData
emoji'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"emojiDataGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
emoji
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EmojiDataGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEmojiData a) => O.OverloadedMethod EmojiDataGetDescriptionMethodInfo a signature where
    overloadedMethod = emojiDataGetDescription

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


#endif

-- method EmojiData::get_emoji
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "emoji"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EmojiData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusEmojiData" , 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_emoji_data_get_emoji" ibus_emoji_data_get_emoji :: 
    Ptr EmojiData ->                        -- emoji : TInterface (Name {namespace = "IBus", name = "EmojiData"})
    IO CString

-- | Gets the emoji character in t'GI.IBus.Objects.EmojiData.EmojiData'. It should not be freed.
emojiDataGetEmoji ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    a
    -- ^ /@emoji@/: An t'GI.IBus.Objects.EmojiData.EmojiData'
    -> m T.Text
    -- ^ __Returns:__ emoji property in t'GI.IBus.Objects.EmojiData.EmojiData'
emojiDataGetEmoji :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
a -> m Text
emojiDataGetEmoji a
emoji = IO Text -> m Text
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 EmojiData
emoji' <- a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
emoji
    CString
result <- Ptr EmojiData -> IO CString
ibus_emoji_data_get_emoji Ptr EmojiData
emoji'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"emojiDataGetEmoji" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
emoji
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data EmojiDataGetEmojiMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsEmojiData a) => O.OverloadedMethod EmojiDataGetEmojiMethodInfo a signature where
    overloadedMethod = emojiDataGetEmoji

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


#endif

-- method EmojiData::set_annotations
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "emoji"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "EmojiData" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusEmojiData" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "annotations"
--           , argType = TGSList (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "List of emoji annotations"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_emoji_data_set_annotations" ibus_emoji_data_set_annotations :: 
    Ptr EmojiData ->                        -- emoji : TInterface (Name {namespace = "IBus", name = "EmojiData"})
    Ptr (GSList CString) ->                 -- annotations : TGSList (TBasicType TUTF8)
    IO ()

-- | Sets the annotation list in t'GI.IBus.Objects.EmojiData.EmojiData'.
emojiDataSetAnnotations ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    a
    -- ^ /@emoji@/: An t'GI.IBus.Objects.EmojiData.EmojiData'
    -> [T.Text]
    -- ^ /@annotations@/: List of emoji annotations
    -> m ()
emojiDataSetAnnotations :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
a -> [Text] -> m ()
emojiDataSetAnnotations a
emoji [Text]
annotations = 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 EmojiData
emoji' <- a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
emoji
    [CString]
annotations' <- (Text -> IO CString) -> [Text] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO CString
textToCString [Text]
annotations
    Ptr (GSList CString)
annotations'' <- [CString] -> IO (Ptr (GSList CString))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [CString]
annotations'
    Ptr EmojiData -> Ptr (GSList CString) -> IO ()
ibus_emoji_data_set_annotations Ptr EmojiData
emoji' Ptr (GSList CString)
annotations''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
emoji
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data EmojiDataSetAnnotationsMethodInfo
instance (signature ~ ([T.Text] -> m ()), MonadIO m, IsEmojiData a) => O.OverloadedMethod EmojiDataSetAnnotationsMethodInfo a signature where
    overloadedMethod = emojiDataSetAnnotations

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


#endif

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

foreign import ccall "ibus_emoji_data_set_description" ibus_emoji_data_set_description :: 
    Ptr EmojiData ->                        -- emoji : TInterface (Name {namespace = "IBus", name = "EmojiData"})
    CString ->                              -- description : TBasicType TUTF8
    IO ()

-- | Sets the description in t'GI.IBus.Objects.EmojiData.EmojiData'.
emojiDataSetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    a
    -- ^ /@emoji@/: An t'GI.IBus.Objects.EmojiData.EmojiData'
    -> T.Text
    -- ^ /@description@/: An emoji description
    -> m ()
emojiDataSetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
a -> Text -> m ()
emojiDataSetDescription a
emoji Text
description = 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 EmojiData
emoji' <- a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
emoji
    CString
description' <- Text -> IO CString
textToCString Text
description
    Ptr EmojiData -> CString -> IO ()
ibus_emoji_data_set_description Ptr EmojiData
emoji' CString
description'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
emoji
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method EmojiData::load
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A path of the saved dictionary file."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "IBus" , name = "EmojiData" }))
-- throws : False
-- Skip return : False

foreign import ccall "ibus_emoji_data_load" ibus_emoji_data_load :: 
    CString ->                              -- path : TBasicType TUTF8
    IO (Ptr (GSList (Ptr EmojiData)))

-- | /No description available in the introspection data./
emojiDataLoad ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@path@/: A path of the saved dictionary file.
    -> m [EmojiData]
    -- ^ __Returns:__ 
    -- An t'GI.IBus.Objects.EmojiData.EmojiData' list loaded from the saved cache file.
emojiDataLoad :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m [EmojiData]
emojiDataLoad Text
path = IO [EmojiData] -> m [EmojiData]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [EmojiData] -> m [EmojiData])
-> IO [EmojiData] -> m [EmojiData]
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr (GSList (Ptr EmojiData))
result <- CString -> IO (Ptr (GSList (Ptr EmojiData)))
ibus_emoji_data_load CString
path'
    [Ptr EmojiData]
result' <- Ptr (GSList (Ptr EmojiData)) -> IO [Ptr EmojiData]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr EmojiData))
result
    [EmojiData]
result'' <- (Ptr EmojiData -> IO EmojiData)
-> [Ptr EmojiData] -> IO [EmojiData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr EmojiData -> EmojiData)
-> Ptr EmojiData -> IO EmojiData
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr EmojiData -> EmojiData
EmojiData) [Ptr EmojiData]
result'
    Ptr (GSList (Ptr EmojiData)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr EmojiData))
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    [EmojiData] -> IO [EmojiData]
forall (m :: * -> *) a. Monad m => a -> m a
return [EmojiData]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method EmojiData::save
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A path of the saved emoji data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "IBus" , name = "EmojiData" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A list of emoji data."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_emoji_data_save" ibus_emoji_data_save :: 
    CString ->                              -- path : TBasicType TUTF8
    Ptr (GSList (Ptr EmojiData)) ->         -- list : TGSList (TInterface (Name {namespace = "IBus", name = "EmojiData"}))
    IO ()

-- | Save the list of t'GI.IBus.Objects.EmojiData.EmojiData' to the cache file.
emojiDataSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsEmojiData a) =>
    T.Text
    -- ^ /@path@/: A path of the saved emoji data.
    -> [a]
    -- ^ /@list@/: A list of emoji data.
    -> m ()
emojiDataSave :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsEmojiData a) =>
Text -> [a] -> m ()
emojiDataSave Text
path [a]
list = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    [Ptr EmojiData]
list' <- (a -> IO (Ptr EmojiData)) -> [a] -> IO [Ptr EmojiData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO (Ptr EmojiData)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr EmojiData))
list'' <- [Ptr EmojiData] -> IO (Ptr (GSList (Ptr EmojiData)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr EmojiData]
list'
    CString -> Ptr (GSList (Ptr EmojiData)) -> IO ()
ibus_emoji_data_save CString
path' Ptr (GSList (Ptr EmojiData))
list''
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    Ptr (GSList (Ptr EmojiData)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr EmojiData))
list''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif