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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.Suggestion
    ( 

-- * Exported types
    Suggestion(..)                          ,
    IsSuggestion                            ,
    toSuggestion                            ,


 -- * 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"), [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"), [replaceTypedText]("GI.Dazzle.Objects.Suggestion#g:method:replaceTypedText"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestSuffix]("GI.Dazzle.Objects.Suggestion#g:method:suggestSuffix"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIcon]("GI.Dazzle.Objects.Suggestion#g:method:getIcon"), [getIconName]("GI.Dazzle.Objects.Suggestion#g:method:getIconName"), [getIconSurface]("GI.Dazzle.Objects.Suggestion#g:method:getIconSurface"), [getId]("GI.Dazzle.Objects.Suggestion#g:method:getId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSecondaryIcon]("GI.Dazzle.Objects.Suggestion#g:method:getSecondaryIcon"), [getSecondaryIconName]("GI.Dazzle.Objects.Suggestion#g:method:getSecondaryIconName"), [getSecondaryIconSurface]("GI.Dazzle.Objects.Suggestion#g:method:getSecondaryIconSurface"), [getSubtitle]("GI.Dazzle.Objects.Suggestion#g:method:getSubtitle"), [getTitle]("GI.Dazzle.Objects.Suggestion#g:method:getTitle").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIconName]("GI.Dazzle.Objects.Suggestion#g:method:setIconName"), [setId]("GI.Dazzle.Objects.Suggestion#g:method:setId"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSecondaryIconName]("GI.Dazzle.Objects.Suggestion#g:method:setSecondaryIconName"), [setSubtitle]("GI.Dazzle.Objects.Suggestion#g:method:setSubtitle"), [setTitle]("GI.Dazzle.Objects.Suggestion#g:method:setTitle").

#if defined(ENABLE_OVERLOADING)
    ResolveSuggestionMethod                 ,
#endif

-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetIconMethodInfo             ,
#endif
    suggestionGetIcon                       ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetIconNameMethodInfo         ,
#endif
    suggestionGetIconName                   ,


-- ** getIconSurface #method:getIconSurface#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetIconSurfaceMethodInfo      ,
#endif
    suggestionGetIconSurface                ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetIdMethodInfo               ,
#endif
    suggestionGetId                         ,


-- ** getSecondaryIcon #method:getSecondaryIcon#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetSecondaryIconMethodInfo    ,
#endif
    suggestionGetSecondaryIcon              ,


-- ** getSecondaryIconName #method:getSecondaryIconName#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetSecondaryIconNameMethodInfo,
#endif
    suggestionGetSecondaryIconName          ,


-- ** getSecondaryIconSurface #method:getSecondaryIconSurface#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetSecondaryIconSurfaceMethodInfo,
#endif
    suggestionGetSecondaryIconSurface       ,


-- ** getSubtitle #method:getSubtitle#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetSubtitleMethodInfo         ,
#endif
    suggestionGetSubtitle                   ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    SuggestionGetTitleMethodInfo            ,
#endif
    suggestionGetTitle                      ,


-- ** new #method:new#

    suggestionNew                           ,


-- ** replaceTypedText #method:replaceTypedText#

#if defined(ENABLE_OVERLOADING)
    SuggestionReplaceTypedTextMethodInfo    ,
#endif
    suggestionReplaceTypedText              ,


-- ** setIconName #method:setIconName#

#if defined(ENABLE_OVERLOADING)
    SuggestionSetIconNameMethodInfo         ,
#endif
    suggestionSetIconName                   ,


-- ** setId #method:setId#

#if defined(ENABLE_OVERLOADING)
    SuggestionSetIdMethodInfo               ,
#endif
    suggestionSetId                         ,


-- ** setSecondaryIconName #method:setSecondaryIconName#

#if defined(ENABLE_OVERLOADING)
    SuggestionSetSecondaryIconNameMethodInfo,
#endif
    suggestionSetSecondaryIconName          ,


-- ** setSubtitle #method:setSubtitle#

#if defined(ENABLE_OVERLOADING)
    SuggestionSetSubtitleMethodInfo         ,
#endif
    suggestionSetSubtitle                   ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    SuggestionSetTitleMethodInfo            ,
#endif
    suggestionSetTitle                      ,


-- ** suggestSuffix #method:suggestSuffix#

#if defined(ENABLE_OVERLOADING)
    SuggestionSuggestSuffixMethodInfo       ,
#endif
    suggestionSuggestSuffix                 ,




 -- * Properties


-- ** icon #attr:icon#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionIconPropertyInfo              ,
#endif
    getSuggestionIcon                       ,
#if defined(ENABLE_OVERLOADING)
    suggestionIcon                          ,
#endif


-- ** iconName #attr:iconName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionIconNamePropertyInfo          ,
#endif
    constructSuggestionIconName             ,
    getSuggestionIconName                   ,
    setSuggestionIconName                   ,
#if defined(ENABLE_OVERLOADING)
    suggestionIconName                      ,
#endif


-- ** id #attr:id#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionIdPropertyInfo                ,
#endif
    constructSuggestionId                   ,
    getSuggestionId                         ,
    setSuggestionId                         ,
#if defined(ENABLE_OVERLOADING)
    suggestionId                            ,
#endif


-- ** secondaryIcon #attr:secondaryIcon#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionSecondaryIconPropertyInfo     ,
#endif
    getSuggestionSecondaryIcon              ,
#if defined(ENABLE_OVERLOADING)
    suggestionSecondaryIcon                 ,
#endif


-- ** secondaryIconName #attr:secondaryIconName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionSecondaryIconNamePropertyInfo ,
#endif
    constructSuggestionSecondaryIconName    ,
    getSuggestionSecondaryIconName          ,
    setSuggestionSecondaryIconName          ,
#if defined(ENABLE_OVERLOADING)
    suggestionSecondaryIconName             ,
#endif


-- ** subtitle #attr:subtitle#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionSubtitlePropertyInfo          ,
#endif
    constructSuggestionSubtitle             ,
    getSuggestionSubtitle                   ,
    setSuggestionSubtitle                   ,
#if defined(ENABLE_OVERLOADING)
    suggestionSubtitle                      ,
#endif


-- ** title #attr:title#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SuggestionTitlePropertyInfo             ,
#endif
    constructSuggestionTitle                ,
    getSuggestionTitle                      ,
    setSuggestionTitle                      ,
#if defined(ENABLE_OVERLOADING)
    suggestionTitle                         ,
#endif




 -- * Signals


-- ** replaceTypedText #signal:replaceTypedText#

    SuggestionReplaceTypedTextCallback      ,
#if defined(ENABLE_OVERLOADING)
    SuggestionReplaceTypedTextSignalInfo    ,
#endif
    afterSuggestionReplaceTypedText         ,
    onSuggestionReplaceTypedText            ,


-- ** suggestSuffix #signal:suggestSuffix#

    SuggestionSuggestSuffixCallback         ,
#if defined(ENABLE_OVERLOADING)
    SuggestionSuggestSuffixSignalInfo       ,
#endif
    afterSuggestionSuggestSuffix            ,
    onSuggestionSuggestSuffix               ,




    ) 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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_suggestion_get_type"
    c_dzl_suggestion_get_type :: IO B.Types.GType

instance B.Types.TypedObject Suggestion where
    glibType :: IO GType
glibType = IO GType
c_dzl_suggestion_get_type

instance B.Types.GObject Suggestion

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

instance O.HasParentTypes Suggestion
type instance O.ParentTypes Suggestion = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSuggestionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSuggestionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSuggestionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSuggestionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSuggestionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSuggestionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSuggestionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSuggestionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSuggestionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSuggestionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSuggestionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSuggestionMethod "replaceTypedText" o = SuggestionReplaceTypedTextMethodInfo
    ResolveSuggestionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSuggestionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSuggestionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSuggestionMethod "suggestSuffix" o = SuggestionSuggestSuffixMethodInfo
    ResolveSuggestionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSuggestionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSuggestionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSuggestionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSuggestionMethod "getIcon" o = SuggestionGetIconMethodInfo
    ResolveSuggestionMethod "getIconName" o = SuggestionGetIconNameMethodInfo
    ResolveSuggestionMethod "getIconSurface" o = SuggestionGetIconSurfaceMethodInfo
    ResolveSuggestionMethod "getId" o = SuggestionGetIdMethodInfo
    ResolveSuggestionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSuggestionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSuggestionMethod "getSecondaryIcon" o = SuggestionGetSecondaryIconMethodInfo
    ResolveSuggestionMethod "getSecondaryIconName" o = SuggestionGetSecondaryIconNameMethodInfo
    ResolveSuggestionMethod "getSecondaryIconSurface" o = SuggestionGetSecondaryIconSurfaceMethodInfo
    ResolveSuggestionMethod "getSubtitle" o = SuggestionGetSubtitleMethodInfo
    ResolveSuggestionMethod "getTitle" o = SuggestionGetTitleMethodInfo
    ResolveSuggestionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSuggestionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSuggestionMethod "setIconName" o = SuggestionSetIconNameMethodInfo
    ResolveSuggestionMethod "setId" o = SuggestionSetIdMethodInfo
    ResolveSuggestionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSuggestionMethod "setSecondaryIconName" o = SuggestionSetSecondaryIconNameMethodInfo
    ResolveSuggestionMethod "setSubtitle" o = SuggestionSetSubtitleMethodInfo
    ResolveSuggestionMethod "setTitle" o = SuggestionSetTitleMethodInfo
    ResolveSuggestionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Suggestion::replace-typed-text
-- | /No description available in the introspection data./
type SuggestionReplaceTypedTextCallback =
    T.Text
    -> IO T.Text

type C_SuggestionReplaceTypedTextCallback =
    Ptr Suggestion ->                       -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CString

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

wrap_SuggestionReplaceTypedTextCallback :: 
    GObject a => (a -> SuggestionReplaceTypedTextCallback) ->
    C_SuggestionReplaceTypedTextCallback
wrap_SuggestionReplaceTypedTextCallback :: forall a.
GObject a =>
(a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
wrap_SuggestionReplaceTypedTextCallback a -> SuggestionReplaceTypedTextCallback
gi'cb Ptr Suggestion
gi'selfPtr CString
object Ptr ()
_ = do
    Text
object' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
object
    Text
result <- Ptr Suggestion -> (Suggestion -> IO Text) -> IO Text
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Suggestion
gi'selfPtr ((Suggestion -> IO Text) -> IO Text)
-> (Suggestion -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Suggestion
gi'self -> a -> SuggestionReplaceTypedTextCallback
gi'cb (Suggestion -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Suggestion
gi'self)  Text
object'
    CString
result' <- Text -> IO CString
textToCString Text
result
    CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result'


-- | Connect a signal handler for the [replaceTypedText](#signal:replaceTypedText) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' suggestion #replaceTypedText callback
-- @
-- 
-- 
onSuggestionReplaceTypedText :: (IsSuggestion a, MonadIO m) => a -> ((?self :: a) => SuggestionReplaceTypedTextCallback) -> m SignalHandlerId
onSuggestionReplaceTypedText :: forall a (m :: * -> *).
(IsSuggestion a, MonadIO m) =>
a
-> ((?self::a) => SuggestionReplaceTypedTextCallback)
-> m SignalHandlerId
onSuggestionReplaceTypedText a
obj (?self::a) => SuggestionReplaceTypedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SuggestionReplaceTypedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SuggestionReplaceTypedTextCallback
SuggestionReplaceTypedTextCallback
cb
    let wrapped' :: C_SuggestionReplaceTypedTextCallback
wrapped' = (a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
forall a.
GObject a =>
(a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
wrap_SuggestionReplaceTypedTextCallback a -> SuggestionReplaceTypedTextCallback
wrapped
    FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' <- C_SuggestionReplaceTypedTextCallback
-> IO (FunPtr C_SuggestionReplaceTypedTextCallback)
mk_SuggestionReplaceTypedTextCallback C_SuggestionReplaceTypedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_SuggestionReplaceTypedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"replace-typed-text" FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [replaceTypedText](#signal:replaceTypedText) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' suggestion #replaceTypedText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSuggestionReplaceTypedText :: (IsSuggestion a, MonadIO m) => a -> ((?self :: a) => SuggestionReplaceTypedTextCallback) -> m SignalHandlerId
afterSuggestionReplaceTypedText :: forall a (m :: * -> *).
(IsSuggestion a, MonadIO m) =>
a
-> ((?self::a) => SuggestionReplaceTypedTextCallback)
-> m SignalHandlerId
afterSuggestionReplaceTypedText a
obj (?self::a) => SuggestionReplaceTypedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SuggestionReplaceTypedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SuggestionReplaceTypedTextCallback
SuggestionReplaceTypedTextCallback
cb
    let wrapped' :: C_SuggestionReplaceTypedTextCallback
wrapped' = (a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
forall a.
GObject a =>
(a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
wrap_SuggestionReplaceTypedTextCallback a -> SuggestionReplaceTypedTextCallback
wrapped
    FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' <- C_SuggestionReplaceTypedTextCallback
-> IO (FunPtr C_SuggestionReplaceTypedTextCallback)
mk_SuggestionReplaceTypedTextCallback C_SuggestionReplaceTypedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_SuggestionReplaceTypedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"replace-typed-text" FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SuggestionReplaceTypedTextSignalInfo
instance SignalInfo SuggestionReplaceTypedTextSignalInfo where
    type HaskellCallbackType SuggestionReplaceTypedTextSignalInfo = SuggestionReplaceTypedTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SuggestionReplaceTypedTextCallback cb
        cb'' <- mk_SuggestionReplaceTypedTextCallback cb'
        connectSignalFunPtr obj "replace-typed-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion::replace-typed-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:signal:replaceTypedText"})

#endif

-- signal Suggestion::suggest-suffix
-- | /No description available in the introspection data./
type SuggestionSuggestSuffixCallback =
    T.Text
    -> IO T.Text

type C_SuggestionSuggestSuffixCallback =
    Ptr Suggestion ->                       -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CString

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

wrap_SuggestionSuggestSuffixCallback :: 
    GObject a => (a -> SuggestionSuggestSuffixCallback) ->
    C_SuggestionSuggestSuffixCallback
wrap_SuggestionSuggestSuffixCallback :: forall a.
GObject a =>
(a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
wrap_SuggestionSuggestSuffixCallback a -> SuggestionReplaceTypedTextCallback
gi'cb Ptr Suggestion
gi'selfPtr CString
object Ptr ()
_ = do
    Text
object' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
object
    Text
result <- Ptr Suggestion -> (Suggestion -> IO Text) -> IO Text
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Suggestion
gi'selfPtr ((Suggestion -> IO Text) -> IO Text)
-> (Suggestion -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Suggestion
gi'self -> a -> SuggestionReplaceTypedTextCallback
gi'cb (Suggestion -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Suggestion
gi'self)  Text
object'
    CString
result' <- Text -> IO CString
textToCString Text
result
    CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result'


-- | Connect a signal handler for the [suggestSuffix](#signal:suggestSuffix) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' suggestion #suggestSuffix callback
-- @
-- 
-- 
onSuggestionSuggestSuffix :: (IsSuggestion a, MonadIO m) => a -> ((?self :: a) => SuggestionSuggestSuffixCallback) -> m SignalHandlerId
onSuggestionSuggestSuffix :: forall a (m :: * -> *).
(IsSuggestion a, MonadIO m) =>
a
-> ((?self::a) => SuggestionReplaceTypedTextCallback)
-> m SignalHandlerId
onSuggestionSuggestSuffix a
obj (?self::a) => SuggestionReplaceTypedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SuggestionReplaceTypedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SuggestionReplaceTypedTextCallback
SuggestionReplaceTypedTextCallback
cb
    let wrapped' :: C_SuggestionReplaceTypedTextCallback
wrapped' = (a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
forall a.
GObject a =>
(a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
wrap_SuggestionSuggestSuffixCallback a -> SuggestionReplaceTypedTextCallback
wrapped
    FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' <- C_SuggestionReplaceTypedTextCallback
-> IO (FunPtr C_SuggestionReplaceTypedTextCallback)
mk_SuggestionSuggestSuffixCallback C_SuggestionReplaceTypedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_SuggestionReplaceTypedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"suggest-suffix" FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [suggestSuffix](#signal:suggestSuffix) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' suggestion #suggestSuffix callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSuggestionSuggestSuffix :: (IsSuggestion a, MonadIO m) => a -> ((?self :: a) => SuggestionSuggestSuffixCallback) -> m SignalHandlerId
afterSuggestionSuggestSuffix :: forall a (m :: * -> *).
(IsSuggestion a, MonadIO m) =>
a
-> ((?self::a) => SuggestionReplaceTypedTextCallback)
-> m SignalHandlerId
afterSuggestionSuggestSuffix a
obj (?self::a) => SuggestionReplaceTypedTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SuggestionReplaceTypedTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SuggestionReplaceTypedTextCallback
SuggestionReplaceTypedTextCallback
cb
    let wrapped' :: C_SuggestionReplaceTypedTextCallback
wrapped' = (a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
forall a.
GObject a =>
(a -> SuggestionReplaceTypedTextCallback)
-> C_SuggestionReplaceTypedTextCallback
wrap_SuggestionSuggestSuffixCallback a -> SuggestionReplaceTypedTextCallback
wrapped
    FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' <- C_SuggestionReplaceTypedTextCallback
-> IO (FunPtr C_SuggestionReplaceTypedTextCallback)
mk_SuggestionSuggestSuffixCallback C_SuggestionReplaceTypedTextCallback
wrapped'
    a
-> Text
-> FunPtr C_SuggestionReplaceTypedTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"suggest-suffix" FunPtr C_SuggestionReplaceTypedTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SuggestionSuggestSuffixSignalInfo
instance SignalInfo SuggestionSuggestSuffixSignalInfo where
    type HaskellCallbackType SuggestionSuggestSuffixSignalInfo = SuggestionSuggestSuffixCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SuggestionSuggestSuffixCallback cb
        cb'' <- mk_SuggestionSuggestSuffixCallback cb'
        connectSignalFunPtr obj "suggest-suffix" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion::suggest-suffix"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:signal:suggestSuffix"})

#endif

-- VVV Prop "icon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #icon
-- @
getSuggestionIcon :: (MonadIO m, IsSuggestion o) => o -> m (Maybe Gio.Icon.Icon)
getSuggestionIcon :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> m (Maybe Icon)
getSuggestionIcon o
obj = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Icon -> Icon) -> IO (Maybe Icon)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"icon" ManagedPtr Icon -> Icon
Gio.Icon.Icon

#if defined(ENABLE_OVERLOADING)
data SuggestionIconPropertyInfo
instance AttrInfo SuggestionIconPropertyInfo where
    type AttrAllowedOps SuggestionIconPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SuggestionIconPropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionIconPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SuggestionIconPropertyInfo = (~) ()
    type AttrTransferType SuggestionIconPropertyInfo = ()
    type AttrGetType SuggestionIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel SuggestionIconPropertyInfo = "icon"
    type AttrOrigin SuggestionIconPropertyInfo = Suggestion
    attrGet = getSuggestionIcon
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.icon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:icon"
        })
#endif

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

-- | Get the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #iconName
-- @
getSuggestionIconName :: (MonadIO m, IsSuggestion o) => o -> m T.Text
getSuggestionIconName :: forall (m :: * -> *) o. (MonadIO m, IsSuggestion o) => o -> m Text
getSuggestionIconName o
obj = 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) -> 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
"getSuggestionIconName" (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
"icon-name"

-- | Set the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' suggestion [ #iconName 'Data.GI.Base.Attributes.:=' value ]
-- @
setSuggestionIconName :: (MonadIO m, IsSuggestion o) => o -> T.Text -> m ()
setSuggestionIconName :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> Text -> m ()
setSuggestionIconName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
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
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSuggestionIconName :: (IsSuggestion o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSuggestionIconName :: forall o (m :: * -> *).
(IsSuggestion o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSuggestionIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SuggestionIconNamePropertyInfo
instance AttrInfo SuggestionIconNamePropertyInfo where
    type AttrAllowedOps SuggestionIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SuggestionIconNamePropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SuggestionIconNamePropertyInfo = (~) T.Text
    type AttrTransferType SuggestionIconNamePropertyInfo = T.Text
    type AttrGetType SuggestionIconNamePropertyInfo = T.Text
    type AttrLabel SuggestionIconNamePropertyInfo = "icon-name"
    type AttrOrigin SuggestionIconNamePropertyInfo = Suggestion
    attrGet = getSuggestionIconName
    attrSet = setSuggestionIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructSuggestionIconName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.iconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:iconName"
        })
#endif

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

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #id
-- @
getSuggestionId :: (MonadIO m, IsSuggestion o) => o -> m T.Text
getSuggestionId :: forall (m :: * -> *) o. (MonadIO m, IsSuggestion o) => o -> m Text
getSuggestionId o
obj = 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) -> 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
"getSuggestionId" (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
"id"

-- | Set the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' suggestion [ #id 'Data.GI.Base.Attributes.:=' value ]
-- @
setSuggestionId :: (MonadIO m, IsSuggestion o) => o -> T.Text -> m ()
setSuggestionId :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> Text -> m ()
setSuggestionId o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
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
"id" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSuggestionId :: (IsSuggestion o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSuggestionId :: forall o (m :: * -> *).
(IsSuggestion o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSuggestionId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SuggestionIdPropertyInfo
instance AttrInfo SuggestionIdPropertyInfo where
    type AttrAllowedOps SuggestionIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SuggestionIdPropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SuggestionIdPropertyInfo = (~) T.Text
    type AttrTransferType SuggestionIdPropertyInfo = T.Text
    type AttrGetType SuggestionIdPropertyInfo = T.Text
    type AttrLabel SuggestionIdPropertyInfo = "id"
    type AttrOrigin SuggestionIdPropertyInfo = Suggestion
    attrGet = getSuggestionId
    attrSet = setSuggestionId
    attrTransfer _ v = do
        return v
    attrConstruct = constructSuggestionId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:id"
        })
#endif

-- VVV Prop "secondary-icon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@secondary-icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #secondaryIcon
-- @
getSuggestionSecondaryIcon :: (MonadIO m, IsSuggestion o) => o -> m (Maybe Gio.Icon.Icon)
getSuggestionSecondaryIcon :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> m (Maybe Icon)
getSuggestionSecondaryIcon o
obj = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Icon -> Icon) -> IO (Maybe Icon)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"secondary-icon" ManagedPtr Icon -> Icon
Gio.Icon.Icon

#if defined(ENABLE_OVERLOADING)
data SuggestionSecondaryIconPropertyInfo
instance AttrInfo SuggestionSecondaryIconPropertyInfo where
    type AttrAllowedOps SuggestionSecondaryIconPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SuggestionSecondaryIconPropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionSecondaryIconPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SuggestionSecondaryIconPropertyInfo = (~) ()
    type AttrTransferType SuggestionSecondaryIconPropertyInfo = ()
    type AttrGetType SuggestionSecondaryIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel SuggestionSecondaryIconPropertyInfo = "secondary-icon"
    type AttrOrigin SuggestionSecondaryIconPropertyInfo = Suggestion
    attrGet = getSuggestionSecondaryIcon
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.secondaryIcon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:secondaryIcon"
        })
#endif

-- VVV Prop "secondary-icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@secondary-icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #secondaryIconName
-- @
getSuggestionSecondaryIconName :: (MonadIO m, IsSuggestion o) => o -> m T.Text
getSuggestionSecondaryIconName :: forall (m :: * -> *) o. (MonadIO m, IsSuggestion o) => o -> m Text
getSuggestionSecondaryIconName o
obj = 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) -> 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
"getSuggestionSecondaryIconName" (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
"secondary-icon-name"

-- | Set the value of the “@secondary-icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' suggestion [ #secondaryIconName 'Data.GI.Base.Attributes.:=' value ]
-- @
setSuggestionSecondaryIconName :: (MonadIO m, IsSuggestion o) => o -> T.Text -> m ()
setSuggestionSecondaryIconName :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> Text -> m ()
setSuggestionSecondaryIconName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
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
"secondary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@secondary-icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSuggestionSecondaryIconName :: (IsSuggestion o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSuggestionSecondaryIconName :: forall o (m :: * -> *).
(IsSuggestion o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSuggestionSecondaryIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"secondary-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SuggestionSecondaryIconNamePropertyInfo
instance AttrInfo SuggestionSecondaryIconNamePropertyInfo where
    type AttrAllowedOps SuggestionSecondaryIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SuggestionSecondaryIconNamePropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionSecondaryIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SuggestionSecondaryIconNamePropertyInfo = (~) T.Text
    type AttrTransferType SuggestionSecondaryIconNamePropertyInfo = T.Text
    type AttrGetType SuggestionSecondaryIconNamePropertyInfo = T.Text
    type AttrLabel SuggestionSecondaryIconNamePropertyInfo = "secondary-icon-name"
    type AttrOrigin SuggestionSecondaryIconNamePropertyInfo = Suggestion
    attrGet = getSuggestionSecondaryIconName
    attrSet = setSuggestionSecondaryIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructSuggestionSecondaryIconName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.secondaryIconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:secondaryIconName"
        })
#endif

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

-- | Get the value of the “@subtitle@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #subtitle
-- @
getSuggestionSubtitle :: (MonadIO m, IsSuggestion o) => o -> m T.Text
getSuggestionSubtitle :: forall (m :: * -> *) o. (MonadIO m, IsSuggestion o) => o -> m Text
getSuggestionSubtitle o
obj = 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) -> 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
"getSuggestionSubtitle" (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
"subtitle"

-- | Set the value of the “@subtitle@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' suggestion [ #subtitle 'Data.GI.Base.Attributes.:=' value ]
-- @
setSuggestionSubtitle :: (MonadIO m, IsSuggestion o) => o -> T.Text -> m ()
setSuggestionSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> Text -> m ()
setSuggestionSubtitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
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
"subtitle" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@subtitle@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSuggestionSubtitle :: (IsSuggestion o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSuggestionSubtitle :: forall o (m :: * -> *).
(IsSuggestion o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSuggestionSubtitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"subtitle" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SuggestionSubtitlePropertyInfo
instance AttrInfo SuggestionSubtitlePropertyInfo where
    type AttrAllowedOps SuggestionSubtitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SuggestionSubtitlePropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionSubtitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SuggestionSubtitlePropertyInfo = (~) T.Text
    type AttrTransferType SuggestionSubtitlePropertyInfo = T.Text
    type AttrGetType SuggestionSubtitlePropertyInfo = T.Text
    type AttrLabel SuggestionSubtitlePropertyInfo = "subtitle"
    type AttrOrigin SuggestionSubtitlePropertyInfo = Suggestion
    attrGet = getSuggestionSubtitle
    attrSet = setSuggestionSubtitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructSuggestionSubtitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.subtitle"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:subtitle"
        })
#endif

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

-- | Get the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' suggestion #title
-- @
getSuggestionTitle :: (MonadIO m, IsSuggestion o) => o -> m T.Text
getSuggestionTitle :: forall (m :: * -> *) o. (MonadIO m, IsSuggestion o) => o -> m Text
getSuggestionTitle o
obj = 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) -> 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
"getSuggestionTitle" (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
"title"

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' suggestion [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setSuggestionTitle :: (MonadIO m, IsSuggestion o) => o -> T.Text -> m ()
setSuggestionTitle :: forall (m :: * -> *) o.
(MonadIO m, IsSuggestion o) =>
o -> Text -> m ()
setSuggestionTitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
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
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@title@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSuggestionTitle :: (IsSuggestion o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSuggestionTitle :: forall o (m :: * -> *).
(IsSuggestion o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSuggestionTitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SuggestionTitlePropertyInfo
instance AttrInfo SuggestionTitlePropertyInfo where
    type AttrAllowedOps SuggestionTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SuggestionTitlePropertyInfo = IsSuggestion
    type AttrSetTypeConstraint SuggestionTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SuggestionTitlePropertyInfo = (~) T.Text
    type AttrTransferType SuggestionTitlePropertyInfo = T.Text
    type AttrGetType SuggestionTitlePropertyInfo = T.Text
    type AttrLabel SuggestionTitlePropertyInfo = "title"
    type AttrOrigin SuggestionTitlePropertyInfo = Suggestion
    attrGet = getSuggestionTitle
    attrSet = setSuggestionTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructSuggestionTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Suggestion
type instance O.AttributeList Suggestion = SuggestionAttributeList
type SuggestionAttributeList = ('[ '("icon", SuggestionIconPropertyInfo), '("iconName", SuggestionIconNamePropertyInfo), '("id", SuggestionIdPropertyInfo), '("secondaryIcon", SuggestionSecondaryIconPropertyInfo), '("secondaryIconName", SuggestionSecondaryIconNamePropertyInfo), '("subtitle", SuggestionSubtitlePropertyInfo), '("title", SuggestionTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
suggestionIcon :: AttrLabelProxy "icon"
suggestionIcon = AttrLabelProxy

suggestionIconName :: AttrLabelProxy "iconName"
suggestionIconName = AttrLabelProxy

suggestionId :: AttrLabelProxy "id"
suggestionId = AttrLabelProxy

suggestionSecondaryIcon :: AttrLabelProxy "secondaryIcon"
suggestionSecondaryIcon = AttrLabelProxy

suggestionSecondaryIconName :: AttrLabelProxy "secondaryIconName"
suggestionSecondaryIconName = AttrLabelProxy

suggestionSubtitle :: AttrLabelProxy "subtitle"
suggestionSubtitle = AttrLabelProxy

suggestionTitle :: AttrLabelProxy "title"
suggestionTitle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Suggestion = SuggestionSignalList
type SuggestionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("replaceTypedText", SuggestionReplaceTypedTextSignalInfo), '("suggestSuffix", SuggestionSuggestSuffixSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "dzl_suggestion_new" dzl_suggestion_new :: 
    IO (Ptr Suggestion)

-- | /No description available in the introspection data./
suggestionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Suggestion
suggestionNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Suggestion
suggestionNew  = IO Suggestion -> m Suggestion
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Suggestion -> m Suggestion) -> IO Suggestion -> m Suggestion
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
result <- IO (Ptr Suggestion)
dzl_suggestion_new
    Text -> Ptr Suggestion -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"suggestionNew" Ptr Suggestion
result
    Suggestion
result' <- ((ManagedPtr Suggestion -> Suggestion)
-> Ptr Suggestion -> IO Suggestion
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Suggestion -> Suggestion
Suggestion) Ptr Suggestion
result
    Suggestion -> IO Suggestion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Suggestion
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Suggestion::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlSuggestion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Icon" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_icon" dzl_suggestion_get_icon :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the icon for the suggestion, if any.
-- 
-- /Since: 3.30/
suggestionGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.Suggestion.Suggestion'
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon' or 'P.Nothing'
suggestionGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m (Maybe Icon)
suggestionGetIcon a
self = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
result <- Ptr Suggestion -> IO (Ptr Icon)
dzl_suggestion_get_icon Ptr Suggestion
self'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \Ptr Icon
result' -> do
        Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Icon -> IO (Maybe Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data SuggestionGetIconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetIconMethodInfo a signature where
    overloadedMethod = suggestionGetIcon

instance O.OverloadedMethodInfo SuggestionGetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetIcon"
        })


#endif

-- method Suggestion::get_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_icon_name" dzl_suggestion_get_icon_name :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO CString

-- | /No description available in the introspection data./
suggestionGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> m T.Text
suggestionGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m Text
suggestionGetIconName a
self = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Suggestion -> IO CString
dzl_suggestion_get_icon_name Ptr Suggestion
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"suggestionGetIconName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SuggestionGetIconNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetIconNameMethodInfo a signature where
    overloadedMethod = suggestionGetIconName

instance O.OverloadedMethodInfo SuggestionGetIconNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetIconName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetIconName"
        })


#endif

-- method Suggestion::get_icon_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlSuggestion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a widget that may contain the surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_icon_surface" dzl_suggestion_get_icon_surface :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr Cairo.Surface.Surface)

-- | This function allows subclasses to dynamicly generate content for the
-- suggestion such as may be required when integrating with favicons or
-- similar.
-- 
-- /@widget@/ is provided so that the implementation may determine scale or
-- any other style-specific settings from the style context.
-- 
-- /Since: 3.30/
suggestionGetIconSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.Suggestion.Suggestion'
    -> b
    -- ^ /@widget@/: a widget that may contain the surface
    -> m (Maybe Cairo.Surface.Surface)
    -- ^ __Returns:__ a t'GI.Cairo.Structs.Surface.Surface' or 'P.Nothing'
suggestionGetIconSurface :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSuggestion a, IsWidget b) =>
a -> b -> m (Maybe Surface)
suggestionGetIconSurface a
self b
widget = IO (Maybe Surface) -> m (Maybe Surface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Surface) -> m (Maybe Surface))
-> IO (Maybe Surface) -> m (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr Surface
result <- Ptr Suggestion -> Ptr Widget -> IO (Ptr Surface)
dzl_suggestion_get_icon_surface Ptr Suggestion
self' Ptr Widget
widget'
    Maybe Surface
maybeResult <- Ptr Surface -> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Surface
result ((Ptr Surface -> IO Surface) -> IO (Maybe Surface))
-> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Surface
result' -> do
        Surface
result'' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Surface -> Surface
Cairo.Surface.Surface) Ptr Surface
result'
        Surface -> IO Surface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
maybeResult

#if defined(ENABLE_OVERLOADING)
data SuggestionGetIconSurfaceMethodInfo
instance (signature ~ (b -> m (Maybe Cairo.Surface.Surface)), MonadIO m, IsSuggestion a, Gtk.Widget.IsWidget b) => O.OverloadedMethod SuggestionGetIconSurfaceMethodInfo a signature where
    overloadedMethod = suggestionGetIconSurface

instance O.OverloadedMethodInfo SuggestionGetIconSurfaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetIconSurface",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetIconSurface"
        })


#endif

-- method Suggestion::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_id" dzl_suggestion_get_id :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO CString

-- | /No description available in the introspection data./
suggestionGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> m T.Text
suggestionGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m Text
suggestionGetId a
self = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Suggestion -> IO CString
dzl_suggestion_get_id Ptr Suggestion
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"suggestionGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SuggestionGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetIdMethodInfo a signature where
    overloadedMethod = suggestionGetId

instance O.OverloadedMethodInfo SuggestionGetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetId"
        })


#endif

-- method Suggestion::get_secondary_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlSuggestion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Icon" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_secondary_icon" dzl_suggestion_get_secondary_icon :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the secondary icon for the suggestion, if any.
-- 
-- /Since: 3.36/
suggestionGetSecondaryIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.Suggestion.Suggestion'
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon' or 'P.Nothing'
suggestionGetSecondaryIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m (Maybe Icon)
suggestionGetSecondaryIcon a
self = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
result <- Ptr Suggestion -> IO (Ptr Icon)
dzl_suggestion_get_secondary_icon Ptr Suggestion
self'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \Ptr Icon
result' -> do
        Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Icon -> IO (Maybe Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data SuggestionGetSecondaryIconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetSecondaryIconMethodInfo a signature where
    overloadedMethod = suggestionGetSecondaryIcon

instance O.OverloadedMethodInfo SuggestionGetSecondaryIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetSecondaryIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetSecondaryIcon"
        })


#endif

-- method Suggestion::get_secondary_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_secondary_icon_name" dzl_suggestion_get_secondary_icon_name :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO CString

-- | /No description available in the introspection data./
suggestionGetSecondaryIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> m T.Text
suggestionGetSecondaryIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m Text
suggestionGetSecondaryIconName a
self = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Suggestion -> IO CString
dzl_suggestion_get_secondary_icon_name Ptr Suggestion
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"suggestionGetSecondaryIconName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SuggestionGetSecondaryIconNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetSecondaryIconNameMethodInfo a signature where
    overloadedMethod = suggestionGetSecondaryIconName

instance O.OverloadedMethodInfo SuggestionGetSecondaryIconNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetSecondaryIconName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetSecondaryIconName"
        })


#endif

-- method Suggestion::get_secondary_icon_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlSuggestion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a widget that may contain the surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_secondary_icon_surface" dzl_suggestion_get_secondary_icon_surface :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr Cairo.Surface.Surface)

-- | This function allows subclasses to dynamicly generate content for the
-- suggestion such as may be required when integrating with favicons or
-- similar.
-- 
-- /@widget@/ is provided so that the implementation may determine scale or
-- any other style-specific settings from the style context.
-- 
-- /Since: 3.36/
suggestionGetSecondaryIconSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.Suggestion.Suggestion'
    -> b
    -- ^ /@widget@/: a widget that may contain the surface
    -> m (Maybe Cairo.Surface.Surface)
    -- ^ __Returns:__ a t'GI.Cairo.Structs.Surface.Surface' or 'P.Nothing'
suggestionGetSecondaryIconSurface :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSuggestion a, IsWidget b) =>
a -> b -> m (Maybe Surface)
suggestionGetSecondaryIconSurface a
self b
widget = IO (Maybe Surface) -> m (Maybe Surface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Surface) -> m (Maybe Surface))
-> IO (Maybe Surface) -> m (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr Surface
result <- Ptr Suggestion -> Ptr Widget -> IO (Ptr Surface)
dzl_suggestion_get_secondary_icon_surface Ptr Suggestion
self' Ptr Widget
widget'
    Maybe Surface
maybeResult <- Ptr Surface -> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Surface
result ((Ptr Surface -> IO Surface) -> IO (Maybe Surface))
-> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Surface
result' -> do
        Surface
result'' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Surface -> Surface
Cairo.Surface.Surface) Ptr Surface
result'
        Surface -> IO Surface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Maybe Surface -> IO (Maybe Surface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
maybeResult

#if defined(ENABLE_OVERLOADING)
data SuggestionGetSecondaryIconSurfaceMethodInfo
instance (signature ~ (b -> m (Maybe Cairo.Surface.Surface)), MonadIO m, IsSuggestion a, Gtk.Widget.IsWidget b) => O.OverloadedMethod SuggestionGetSecondaryIconSurfaceMethodInfo a signature where
    overloadedMethod = suggestionGetSecondaryIconSurface

instance O.OverloadedMethodInfo SuggestionGetSecondaryIconSurfaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetSecondaryIconSurface",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetSecondaryIconSurface"
        })


#endif

-- method Suggestion::get_subtitle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_subtitle" dzl_suggestion_get_subtitle :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO CString

-- | /No description available in the introspection data./
suggestionGetSubtitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> m T.Text
suggestionGetSubtitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m Text
suggestionGetSubtitle a
self = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Suggestion -> IO CString
dzl_suggestion_get_subtitle Ptr Suggestion
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"suggestionGetSubtitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SuggestionGetSubtitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetSubtitleMethodInfo a signature where
    overloadedMethod = suggestionGetSubtitle

instance O.OverloadedMethodInfo SuggestionGetSubtitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetSubtitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetSubtitle"
        })


#endif

-- method Suggestion::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_get_title" dzl_suggestion_get_title :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    IO CString

-- | /No description available in the introspection data./
suggestionGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> m T.Text
suggestionGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> m Text
suggestionGetTitle a
self = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Suggestion -> IO CString
dzl_suggestion_get_title Ptr Suggestion
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"suggestionGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SuggestionGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionGetTitleMethodInfo a signature where
    overloadedMethod = suggestionGetTitle

instance O.OverloadedMethodInfo SuggestionGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionGetTitle"
        })


#endif

-- method Suggestion::replace_typed_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlSuggestion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "typed_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text that was typed into the entry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_replace_typed_text" dzl_suggestion_replace_typed_text :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- typed_text : TBasicType TUTF8
    IO CString

-- | This function is meant to be used to replace the text in the entry with text
-- that represents the suggestion most accurately. This happens when the user
-- presses tab while typing a suggestion. For example, if typing \"gno\" in the
-- entry, you might have a suggest_suffix of \"me.org\" so that the user sees
-- \"gnome.org\". But the replace_typed_text might include more data such as
-- \"https:\/\/gnome.org\" as it more closely represents the suggestion.
suggestionReplaceTypedText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -- ^ /@self@/: An t'GI.Dazzle.Objects.Suggestion.Suggestion'
    -> T.Text
    -- ^ /@typedText@/: the text that was typed into the entry
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The replacement text to insert into
    --   the entry when \"tab\" is pressed to complete the insertion.
suggestionReplaceTypedText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m (Maybe Text)
suggestionReplaceTypedText a
self Text
typedText = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
typedText' <- Text -> IO CString
textToCString Text
typedText
    CString
result <- Ptr Suggestion -> CString -> IO CString
dzl_suggestion_replace_typed_text Ptr Suggestion
self' CString
typedText'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
typedText'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SuggestionReplaceTypedTextMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionReplaceTypedTextMethodInfo a signature where
    overloadedMethod = suggestionReplaceTypedText

instance O.OverloadedMethodInfo SuggestionReplaceTypedTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionReplaceTypedText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionReplaceTypedText"
        })


#endif

-- method Suggestion::set_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_set_icon_name" dzl_suggestion_set_icon_name :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
suggestionSetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> T.Text
    -> m ()
suggestionSetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m ()
suggestionSetIconName a
self Text
iconName = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr Suggestion -> CString -> IO ()
dzl_suggestion_set_icon_name Ptr Suggestion
self' CString
iconName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SuggestionSetIconNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionSetIconName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionSetIconName"
        })


#endif

-- method Suggestion::set_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_set_id" dzl_suggestion_set_id :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- id : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
suggestionSetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> T.Text
    -> m ()
suggestionSetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m ()
suggestionSetId a
self Text
id = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
id' <- Text -> IO CString
textToCString Text
id
    Ptr Suggestion -> CString -> IO ()
dzl_suggestion_set_id Ptr Suggestion
self' CString
id'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SuggestionSetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionSetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionSetId"
        })


#endif

-- method Suggestion::set_secondary_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_set_secondary_icon_name" dzl_suggestion_set_secondary_icon_name :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
suggestionSetSecondaryIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> T.Text
    -> m ()
suggestionSetSecondaryIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m ()
suggestionSetSecondaryIconName a
self Text
iconName = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr Suggestion -> CString -> IO ()
dzl_suggestion_set_secondary_icon_name Ptr Suggestion
self' CString
iconName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SuggestionSetSecondaryIconNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionSetSecondaryIconName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionSetSecondaryIconName"
        })


#endif

-- method Suggestion::set_subtitle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subtitle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_set_subtitle" dzl_suggestion_set_subtitle :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- subtitle : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
suggestionSetSubtitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> T.Text
    -> m ()
suggestionSetSubtitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m ()
suggestionSetSubtitle a
self Text
subtitle = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
subtitle' <- Text -> IO CString
textToCString Text
subtitle
    Ptr Suggestion -> CString -> IO ()
dzl_suggestion_set_subtitle Ptr Suggestion
self' CString
subtitle'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subtitle'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SuggestionSetSubtitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionSetSubtitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionSetSubtitle"
        })


#endif

-- method Suggestion::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_set_title" dzl_suggestion_set_title :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
suggestionSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -> T.Text
    -> m ()
suggestionSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m ()
suggestionSetTitle a
self Text
title = 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 Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Suggestion -> CString -> IO ()
dzl_suggestion_set_title Ptr Suggestion
self' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SuggestionSetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionSetTitle"
        })


#endif

-- method Suggestion::suggest_suffix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Suggestion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlSuggestion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "typed_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The user entered text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_suggestion_suggest_suffix" dzl_suggestion_suggest_suffix :: 
    Ptr Suggestion ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "Suggestion"})
    CString ->                              -- typed_text : TBasicType TUTF8
    IO CString

-- | This function requests potential text to append to /@typedText@/ to make it
-- more clear to the user what they will be activating by selecting this
-- suggestion. For example, if they start typing \"gno\", a potential suggested
-- suffix might be \"me.org\" to create \"gnome.org\".
suggestionSuggestSuffix ::
    (B.CallStack.HasCallStack, MonadIO m, IsSuggestion a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.Suggestion.Suggestion'
    -> T.Text
    -- ^ /@typedText@/: The user entered text
    -> m (Maybe T.Text)
    -- ^ __Returns:__ Suffix to append to /@typedText@/
    --   or 'P.Nothing' to leave it unchanged.
suggestionSuggestSuffix :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSuggestion a) =>
a -> Text -> m (Maybe Text)
suggestionSuggestSuffix a
self Text
typedText = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Suggestion
self' <- a -> IO (Ptr Suggestion)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
typedText' <- Text -> IO CString
textToCString Text
typedText
    CString
result <- Ptr Suggestion -> CString -> IO CString
dzl_suggestion_suggest_suffix Ptr Suggestion
self' CString
typedText'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        SuggestionReplaceTypedTextCallback
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
typedText'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SuggestionSuggestSuffixMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsSuggestion a) => O.OverloadedMethod SuggestionSuggestSuffixMethodInfo a signature where
    overloadedMethod = suggestionSuggestSuffix

instance O.OverloadedMethodInfo SuggestionSuggestSuffixMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.Suggestion.suggestionSuggestSuffix",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-Suggestion.html#v:suggestionSuggestSuffix"
        })


#endif