{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A [iface/@completionProvider@/] for the completion of words.
-- 
-- The @GtkSourceCompletionWords@ is an example of an implementation of
-- the [iface/@completionProvider@/] interface. The proposals are words
-- appearing in the registered t'GI.Gtk.Objects.TextBuffer.TextBuffer's.

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

module GI.GtkSource.Objects.CompletionWords
    ( 

-- * Exported types
    CompletionWords(..)                     ,
    IsCompletionWords                       ,
    toCompletionWords                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activate]("GI.GtkSource.Interfaces.CompletionProvider#g:method:activate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [display]("GI.GtkSource.Interfaces.CompletionProvider#g:method:display"), [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"), [isTrigger]("GI.GtkSource.Interfaces.CompletionProvider#g:method:isTrigger"), [keyActivates]("GI.GtkSource.Interfaces.CompletionProvider#g:method:keyActivates"), [listAlternates]("GI.GtkSource.Interfaces.CompletionProvider#g:method:listAlternates"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [populateAsync]("GI.GtkSource.Interfaces.CompletionProvider#g:method:populateAsync"), [populateFinish]("GI.GtkSource.Interfaces.CompletionProvider#g:method:populateFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [refilter]("GI.GtkSource.Interfaces.CompletionProvider#g:method:refilter"), [register]("GI.GtkSource.Objects.CompletionWords#g:method:register"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unregister]("GI.GtkSource.Objects.CompletionWords#g:method:unregister"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPriority]("GI.GtkSource.Interfaces.CompletionProvider#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.GtkSource.Interfaces.CompletionProvider#g:method:getTitle").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveCompletionWordsMethod            ,
#endif

-- ** new #method:new#

    completionWordsNew                      ,


-- ** register #method:register#

#if defined(ENABLE_OVERLOADING)
    CompletionWordsRegisterMethodInfo       ,
#endif
    completionWordsRegister                 ,


-- ** unregister #method:unregister#

#if defined(ENABLE_OVERLOADING)
    CompletionWordsUnregisterMethodInfo     ,
#endif
    completionWordsUnregister               ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsMinimumWordSizePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsMinimumWordSize          ,
#endif
    constructCompletionWordsMinimumWordSize ,
    getCompletionWordsMinimumWordSize       ,
    setCompletionWordsMinimumWordSize       ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsPriorityPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsPriority                 ,
#endif
    constructCompletionWordsPriority        ,
    getCompletionWordsPriority              ,
    setCompletionWordsPriority              ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsProposalsBatchSizePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsProposalsBatchSize       ,
#endif
    constructCompletionWordsProposalsBatchSize,
    getCompletionWordsProposalsBatchSize    ,
    setCompletionWordsProposalsBatchSize    ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsScanBatchSizePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsScanBatchSize            ,
#endif
    constructCompletionWordsScanBatchSize   ,
    getCompletionWordsScanBatchSize         ,
    setCompletionWordsScanBatchSize         ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsTitlePropertyInfo        ,
#endif
    clearCompletionWordsTitle               ,
#if defined(ENABLE_OVERLOADING)
    completionWordsTitle                    ,
#endif
    constructCompletionWordsTitle           ,
    getCompletionWordsTitle                 ,
    setCompletionWordsTitle                 ,




    ) 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.Settings as Gio.Settings
import qualified GI.Gtk.Enums as Gtk.Enums
import qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.AccessibleText as Gtk.AccessibleText
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Interfaces.Scrollable as Gtk.Scrollable
import qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import qualified GI.Gtk.Objects.TextMark as Gtk.TextMark
import qualified GI.Gtk.Objects.TextTag as Gtk.TextTag
import qualified GI.Gtk.Objects.TextTagTable as Gtk.TextTagTable
import qualified GI.Gtk.Objects.TextView as Gtk.TextView
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Enums as GtkSource.Enums
import {-# SOURCE #-} qualified GI.GtkSource.Flags as GtkSource.Flags
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProposal as GtkSource.CompletionProposal
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProvider as GtkSource.CompletionProvider
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.HoverProvider as GtkSource.HoverProvider
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.Indenter as GtkSource.Indenter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Buffer as GtkSource.Buffer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Completion as GtkSource.Completion
import {-# SOURCE #-} qualified GI.GtkSource.Objects.CompletionCell as GtkSource.CompletionCell
import {-# SOURCE #-} qualified GI.GtkSource.Objects.CompletionContext as GtkSource.CompletionContext
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Gutter as GtkSource.Gutter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.GutterLines as GtkSource.GutterLines
import {-# SOURCE #-} qualified GI.GtkSource.Objects.GutterRenderer as GtkSource.GutterRenderer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Hover as GtkSource.Hover
import {-# SOURCE #-} qualified GI.GtkSource.Objects.HoverContext as GtkSource.HoverContext
import {-# SOURCE #-} qualified GI.GtkSource.Objects.HoverDisplay as GtkSource.HoverDisplay
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Language as GtkSource.Language
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Mark as GtkSource.Mark
import {-# SOURCE #-} qualified GI.GtkSource.Objects.MarkAttributes as GtkSource.MarkAttributes
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Snippet as GtkSource.Snippet
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetChunk as GtkSource.SnippetChunk
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetContext as GtkSource.SnippetContext
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SpaceDrawer as GtkSource.SpaceDrawer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Style as GtkSource.Style
import {-# SOURCE #-} qualified GI.GtkSource.Objects.StyleScheme as GtkSource.StyleScheme
import {-# SOURCE #-} qualified GI.GtkSource.Objects.View as GtkSource.View
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Structs.AttrList as Pango.AttrList

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProvider as GtkSource.CompletionProvider

#endif

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

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

foreign import ccall "gtk_source_completion_words_get_type"
    c_gtk_source_completion_words_get_type :: IO B.Types.GType

instance B.Types.TypedObject CompletionWords where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_completion_words_get_type

instance B.Types.GObject CompletionWords

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

instance O.HasParentTypes CompletionWords
type instance O.ParentTypes CompletionWords = '[GObject.Object.Object, GtkSource.CompletionProvider.CompletionProvider]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCompletionWordsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCompletionWordsMethod "activate" o = GtkSource.CompletionProvider.CompletionProviderActivateMethodInfo
    ResolveCompletionWordsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCompletionWordsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCompletionWordsMethod "display" o = GtkSource.CompletionProvider.CompletionProviderDisplayMethodInfo
    ResolveCompletionWordsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCompletionWordsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCompletionWordsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCompletionWordsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCompletionWordsMethod "isTrigger" o = GtkSource.CompletionProvider.CompletionProviderIsTriggerMethodInfo
    ResolveCompletionWordsMethod "keyActivates" o = GtkSource.CompletionProvider.CompletionProviderKeyActivatesMethodInfo
    ResolveCompletionWordsMethod "listAlternates" o = GtkSource.CompletionProvider.CompletionProviderListAlternatesMethodInfo
    ResolveCompletionWordsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCompletionWordsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCompletionWordsMethod "populateAsync" o = GtkSource.CompletionProvider.CompletionProviderPopulateAsyncMethodInfo
    ResolveCompletionWordsMethod "populateFinish" o = GtkSource.CompletionProvider.CompletionProviderPopulateFinishMethodInfo
    ResolveCompletionWordsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCompletionWordsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCompletionWordsMethod "refilter" o = GtkSource.CompletionProvider.CompletionProviderRefilterMethodInfo
    ResolveCompletionWordsMethod "register" o = CompletionWordsRegisterMethodInfo
    ResolveCompletionWordsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCompletionWordsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCompletionWordsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCompletionWordsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCompletionWordsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCompletionWordsMethod "unregister" o = CompletionWordsUnregisterMethodInfo
    ResolveCompletionWordsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCompletionWordsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCompletionWordsMethod "getPriority" o = GtkSource.CompletionProvider.CompletionProviderGetPriorityMethodInfo
    ResolveCompletionWordsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCompletionWordsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCompletionWordsMethod "getTitle" o = GtkSource.CompletionProvider.CompletionProviderGetTitleMethodInfo
    ResolveCompletionWordsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCompletionWordsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCompletionWordsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCompletionWordsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "minimum-word-size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@minimum-word-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #minimumWordSize
-- @
getCompletionWordsMinimumWordSize :: (MonadIO m, IsCompletionWords o) => o -> m Word32
getCompletionWordsMinimumWordSize :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> m Word32
getCompletionWordsMinimumWordSize o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"minimum-word-size"

-- | Set the value of the “@minimum-word-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #minimumWordSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsMinimumWordSize :: (MonadIO m, IsCompletionWords o) => o -> Word32 -> m ()
setCompletionWordsMinimumWordSize :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> Word32 -> m ()
setCompletionWordsMinimumWordSize o
obj Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"minimum-word-size" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@minimum-word-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsMinimumWordSize :: (IsCompletionWords o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructCompletionWordsMinimumWordSize :: forall o (m :: * -> *).
(IsCompletionWords o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructCompletionWordsMinimumWordSize Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"minimum-word-size" Word32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsMinimumWordSizePropertyInfo
instance AttrInfo CompletionWordsMinimumWordSizePropertyInfo where
    type AttrAllowedOps CompletionWordsMinimumWordSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsMinimumWordSizePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsMinimumWordSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint CompletionWordsMinimumWordSizePropertyInfo = (~) Word32
    type AttrTransferType CompletionWordsMinimumWordSizePropertyInfo = Word32
    type AttrGetType CompletionWordsMinimumWordSizePropertyInfo = Word32
    type AttrLabel CompletionWordsMinimumWordSizePropertyInfo = "minimum-word-size"
    type AttrOrigin CompletionWordsMinimumWordSizePropertyInfo = CompletionWords
    attrGet = getCompletionWordsMinimumWordSize
    attrSet = setCompletionWordsMinimumWordSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsMinimumWordSize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.minimumWordSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#g:attr:minimumWordSize"
        })
#endif

-- VVV Prop "priority"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #priority
-- @
getCompletionWordsPriority :: (MonadIO m, IsCompletionWords o) => o -> m Int32
getCompletionWordsPriority :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> m Int32
getCompletionWordsPriority o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"priority"

-- | Set the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsPriority :: (MonadIO m, IsCompletionWords o) => o -> Int32 -> m ()
setCompletionWordsPriority :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> Int32 -> m ()
setCompletionWordsPriority o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"priority" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsPriority :: (IsCompletionWords o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructCompletionWordsPriority :: forall o (m :: * -> *).
(IsCompletionWords o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructCompletionWordsPriority Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"priority" Int32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsPriorityPropertyInfo
instance AttrInfo CompletionWordsPriorityPropertyInfo where
    type AttrAllowedOps CompletionWordsPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsPriorityPropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsPriorityPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint CompletionWordsPriorityPropertyInfo = (~) Int32
    type AttrTransferType CompletionWordsPriorityPropertyInfo = Int32
    type AttrGetType CompletionWordsPriorityPropertyInfo = Int32
    type AttrLabel CompletionWordsPriorityPropertyInfo = "priority"
    type AttrOrigin CompletionWordsPriorityPropertyInfo = CompletionWords
    attrGet = getCompletionWordsPriority
    attrSet = setCompletionWordsPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#g:attr:priority"
        })
#endif

-- VVV Prop "proposals-batch-size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@proposals-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #proposalsBatchSize
-- @
getCompletionWordsProposalsBatchSize :: (MonadIO m, IsCompletionWords o) => o -> m Word32
getCompletionWordsProposalsBatchSize :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> m Word32
getCompletionWordsProposalsBatchSize o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"proposals-batch-size"

-- | Set the value of the “@proposals-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #proposalsBatchSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsProposalsBatchSize :: (MonadIO m, IsCompletionWords o) => o -> Word32 -> m ()
setCompletionWordsProposalsBatchSize :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> Word32 -> m ()
setCompletionWordsProposalsBatchSize o
obj Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"proposals-batch-size" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@proposals-batch-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsProposalsBatchSize :: (IsCompletionWords o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructCompletionWordsProposalsBatchSize :: forall o (m :: * -> *).
(IsCompletionWords o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructCompletionWordsProposalsBatchSize Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"proposals-batch-size" Word32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsProposalsBatchSizePropertyInfo
instance AttrInfo CompletionWordsProposalsBatchSizePropertyInfo where
    type AttrAllowedOps CompletionWordsProposalsBatchSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsProposalsBatchSizePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsProposalsBatchSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint CompletionWordsProposalsBatchSizePropertyInfo = (~) Word32
    type AttrTransferType CompletionWordsProposalsBatchSizePropertyInfo = Word32
    type AttrGetType CompletionWordsProposalsBatchSizePropertyInfo = Word32
    type AttrLabel CompletionWordsProposalsBatchSizePropertyInfo = "proposals-batch-size"
    type AttrOrigin CompletionWordsProposalsBatchSizePropertyInfo = CompletionWords
    attrGet = getCompletionWordsProposalsBatchSize
    attrSet = setCompletionWordsProposalsBatchSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsProposalsBatchSize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.proposalsBatchSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#g:attr:proposalsBatchSize"
        })
#endif

-- VVV Prop "scan-batch-size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@scan-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #scanBatchSize
-- @
getCompletionWordsScanBatchSize :: (MonadIO m, IsCompletionWords o) => o -> m Word32
getCompletionWordsScanBatchSize :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> m Word32
getCompletionWordsScanBatchSize o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"scan-batch-size"

-- | Set the value of the “@scan-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #scanBatchSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsScanBatchSize :: (MonadIO m, IsCompletionWords o) => o -> Word32 -> m ()
setCompletionWordsScanBatchSize :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> Word32 -> m ()
setCompletionWordsScanBatchSize o
obj Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"scan-batch-size" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@scan-batch-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsScanBatchSize :: (IsCompletionWords o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructCompletionWordsScanBatchSize :: forall o (m :: * -> *).
(IsCompletionWords o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructCompletionWordsScanBatchSize Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"scan-batch-size" Word32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsScanBatchSizePropertyInfo
instance AttrInfo CompletionWordsScanBatchSizePropertyInfo where
    type AttrAllowedOps CompletionWordsScanBatchSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsScanBatchSizePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsScanBatchSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint CompletionWordsScanBatchSizePropertyInfo = (~) Word32
    type AttrTransferType CompletionWordsScanBatchSizePropertyInfo = Word32
    type AttrGetType CompletionWordsScanBatchSizePropertyInfo = Word32
    type AttrLabel CompletionWordsScanBatchSizePropertyInfo = "scan-batch-size"
    type AttrOrigin CompletionWordsScanBatchSizePropertyInfo = CompletionWords
    attrGet = getCompletionWordsScanBatchSize
    attrSet = setCompletionWordsScanBatchSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsScanBatchSize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.scanBatchSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#g:attr:scanBatchSize"
        })
#endif

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

-- | 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' completionWords #title
-- @
getCompletionWordsTitle :: (MonadIO m, IsCompletionWords o) => o -> m (Maybe T.Text)
getCompletionWordsTitle :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> m (Maybe Text)
getCompletionWordsTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe 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' completionWords [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsTitle :: (MonadIO m, IsCompletionWords o) => o -> T.Text -> m ()
setCompletionWordsTitle :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> Text -> m ()
setCompletionWordsTitle 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`.
constructCompletionWordsTitle :: (IsCompletionWords o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructCompletionWordsTitle :: forall o (m :: * -> *).
(IsCompletionWords o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructCompletionWordsTitle 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)

-- | Set the value of the “@title@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearCompletionWordsTitle :: (MonadIO m, IsCompletionWords o) => o -> m ()
clearCompletionWordsTitle :: forall (m :: * -> *) o.
(MonadIO m, IsCompletionWords o) =>
o -> m ()
clearCompletionWordsTitle o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data CompletionWordsTitlePropertyInfo
instance AttrInfo CompletionWordsTitlePropertyInfo where
    type AttrAllowedOps CompletionWordsTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CompletionWordsTitlePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint CompletionWordsTitlePropertyInfo = (~) T.Text
    type AttrTransferType CompletionWordsTitlePropertyInfo = T.Text
    type AttrGetType CompletionWordsTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel CompletionWordsTitlePropertyInfo = "title"
    type AttrOrigin CompletionWordsTitlePropertyInfo = CompletionWords
    attrGet = getCompletionWordsTitle
    attrSet = setCompletionWordsTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsTitle
    attrClear = clearCompletionWordsTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CompletionWords
type instance O.AttributeList CompletionWords = CompletionWordsAttributeList
type CompletionWordsAttributeList = ('[ '("minimumWordSize", CompletionWordsMinimumWordSizePropertyInfo), '("priority", CompletionWordsPriorityPropertyInfo), '("proposalsBatchSize", CompletionWordsProposalsBatchSizePropertyInfo), '("scanBatchSize", CompletionWordsScanBatchSizePropertyInfo), '("title", CompletionWordsTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
completionWordsMinimumWordSize :: AttrLabelProxy "minimumWordSize"
completionWordsMinimumWordSize = AttrLabelProxy

completionWordsPriority :: AttrLabelProxy "priority"
completionWordsPriority = AttrLabelProxy

completionWordsProposalsBatchSize :: AttrLabelProxy "proposalsBatchSize"
completionWordsProposalsBatchSize = AttrLabelProxy

completionWordsScanBatchSize :: AttrLabelProxy "scanBatchSize"
completionWordsScanBatchSize = AttrLabelProxy

completionWordsTitle :: AttrLabelProxy "title"
completionWordsTitle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList CompletionWords = CompletionWordsSignalList
type CompletionWordsSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method CompletionWords::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The title for the provider, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "CompletionWords" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_words_new" gtk_source_completion_words_new :: 
    CString ->                              -- title : TBasicType TUTF8
    IO (Ptr CompletionWords)

-- | /No description available in the introspection data./
completionWordsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@title@/: The title for the provider, or 'P.Nothing'.
    -> m CompletionWords
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.CompletionWords.CompletionWords' provider
completionWordsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m CompletionWords
completionWordsNew Maybe Text
title = IO CompletionWords -> m CompletionWords
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompletionWords -> m CompletionWords)
-> IO CompletionWords -> m CompletionWords
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            Ptr CChar
jTitle' <- Text -> IO (Ptr CChar)
textToCString Text
jTitle
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jTitle'
    Ptr CompletionWords
result <- Ptr CChar -> IO (Ptr CompletionWords)
gtk_source_completion_words_new Ptr CChar
maybeTitle
    Text -> Ptr CompletionWords -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"completionWordsNew" Ptr CompletionWords
result
    CompletionWords
result' <- ((ManagedPtr CompletionWords -> CompletionWords)
-> Ptr CompletionWords -> IO CompletionWords
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CompletionWords -> CompletionWords
CompletionWords) Ptr CompletionWords
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeTitle
    CompletionWords -> IO CompletionWords
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionWords
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CompletionWords::register
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "words"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionWords" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionWords"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , 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 "gtk_source_completion_words_register" gtk_source_completion_words_register :: 
    Ptr CompletionWords ->                  -- words : TInterface (Name {namespace = "GtkSource", name = "CompletionWords"})
    Ptr Gtk.TextBuffer.TextBuffer ->        -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO ()

-- | Registers /@buffer@/ in the /@words@/ provider.
completionWordsRegister ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) =>
    a
    -- ^ /@words@/: a t'GI.GtkSource.Objects.CompletionWords.CompletionWords'
    -> b
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> m ()
completionWordsRegister :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCompletionWords a, IsTextBuffer b) =>
a -> b -> m ()
completionWordsRegister a
words b
buffer = 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 CompletionWords
words' <- a -> IO (Ptr CompletionWords)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
words
    Ptr TextBuffer
buffer' <- b -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
buffer
    Ptr CompletionWords -> Ptr TextBuffer -> IO ()
gtk_source_completion_words_register Ptr CompletionWords
words' Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
words
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionWordsRegisterMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) => O.OverloadedMethod CompletionWordsRegisterMethodInfo a signature where
    overloadedMethod = completionWordsRegister

instance O.OverloadedMethodInfo CompletionWordsRegisterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.completionWordsRegister",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#v:completionWordsRegister"
        })


#endif

-- method CompletionWords::unregister
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "words"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionWords" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionWords"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , 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 "gtk_source_completion_words_unregister" gtk_source_completion_words_unregister :: 
    Ptr CompletionWords ->                  -- words : TInterface (Name {namespace = "GtkSource", name = "CompletionWords"})
    Ptr Gtk.TextBuffer.TextBuffer ->        -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO ()

-- | Unregisters /@buffer@/ from the /@words@/ provider.
completionWordsUnregister ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) =>
    a
    -- ^ /@words@/: a t'GI.GtkSource.Objects.CompletionWords.CompletionWords'
    -> b
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> m ()
completionWordsUnregister :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCompletionWords a, IsTextBuffer b) =>
a -> b -> m ()
completionWordsUnregister a
words b
buffer = 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 CompletionWords
words' <- a -> IO (Ptr CompletionWords)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
words
    Ptr TextBuffer
buffer' <- b -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
buffer
    Ptr CompletionWords -> Ptr TextBuffer -> IO ()
gtk_source_completion_words_unregister Ptr CompletionWords
words' Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
words
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionWordsUnregisterMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) => O.OverloadedMethod CompletionWordsUnregisterMethodInfo a signature where
    overloadedMethod = completionWordsUnregister

instance O.OverloadedMethodInfo CompletionWordsUnregisterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.CompletionWords.completionWordsUnregister",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-CompletionWords.html#v:completionWordsUnregister"
        })


#endif