{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Completion provider interface.
-- 
-- You must implement this interface to provide proposals to [class/@completion@/].
-- 
-- In most cases, implementations of this interface will want to use
-- [vfunc/@completionProvider@/.populate_async] to asynchronously populate the results
-- to avoid blocking the main loop.

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

module GI.GtkSource.Interfaces.CompletionProvider
    ( 

-- * Exported types
    CompletionProvider(..)                  ,
    IsCompletionProvider                    ,
    toCompletionProvider                    ,


 -- * 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"), [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"), [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)
    ResolveCompletionProviderMethod         ,
#endif

-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderActivateMethodInfo    ,
#endif
    completionProviderActivate              ,


-- ** display #method:display#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderDisplayMethodInfo     ,
#endif
    completionProviderDisplay               ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderGetPriorityMethodInfo ,
#endif
    completionProviderGetPriority           ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderGetTitleMethodInfo    ,
#endif
    completionProviderGetTitle              ,


-- ** isTrigger #method:isTrigger#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderIsTriggerMethodInfo   ,
#endif
    completionProviderIsTrigger             ,


-- ** keyActivates #method:keyActivates#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderKeyActivatesMethodInfo,
#endif
    completionProviderKeyActivates          ,


-- ** listAlternates #method:listAlternates#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderListAlternatesMethodInfo,
#endif
    completionProviderListAlternates        ,


-- ** populateAsync #method:populateAsync#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderPopulateAsyncMethodInfo,
#endif
    completionProviderPopulateAsync         ,


-- ** populateFinish #method:populateFinish#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderPopulateFinishMethodInfo,
#endif
    completionProviderPopulateFinish        ,


-- ** refilter #method:refilter#

#if defined(ENABLE_OVERLOADING)
    CompletionProviderRefilterMethodInfo    ,
#endif
    completionProviderRefilter              ,




    ) 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.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.Gdk.Flags as Gdk.Flags
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProposal as GtkSource.CompletionProposal
import {-# SOURCE #-} qualified GI.GtkSource.Objects.CompletionCell as GtkSource.CompletionCell
import {-# SOURCE #-} qualified GI.GtkSource.Objects.CompletionContext as GtkSource.CompletionContext

#endif

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

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

foreign import ccall "gtk_source_completion_provider_get_type"
    c_gtk_source_completion_provider_get_type :: IO B.Types.GType

instance B.Types.TypedObject CompletionProvider where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_completion_provider_get_type

instance B.Types.GObject CompletionProvider

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CompletionProvider
type instance O.AttributeList CompletionProvider = CompletionProviderAttributeList
type CompletionProviderAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#endif

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

#endif

-- method CompletionProvider::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proposal"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProposal" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProposal"
--                 , 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_provider_activate" gtk_source_completion_provider_activate :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr GtkSource.CompletionProposal.CompletionProposal -> -- proposal : TInterface (Name {namespace = "GtkSource", name = "CompletionProposal"})
    IO ()

-- | This function requests /@proposal@/ to be activated by the
-- t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'.
-- 
-- What the provider does to activate the proposal is specific to that
-- provider. Many providers may choose to insert a t'GI.GtkSource.Objects.Snippet.Snippet' with
-- edit points the user may cycle through.
-- 
-- See also: [class/@snippet@/], [class/@snippetChunk@/], [method/@view@/.push_snippet]
completionProviderActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> c
    -- ^ /@proposal@/: a t'GI.GtkSource.Interfaces.CompletionProposal.CompletionProposal'
    -> m ()
completionProviderActivate :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b, IsCompletionProposal c) =>
a -> b -> c -> m ()
completionProviderActivate a
self b
context c
proposal = 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 CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr CompletionProposal
proposal' <- c -> IO (Ptr CompletionProposal)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
proposal
    Ptr CompletionProvider
-> Ptr CompletionContext -> Ptr CompletionProposal -> IO ()
gtk_source_completion_provider_activate Ptr CompletionProvider
self' Ptr CompletionContext
context' Ptr CompletionProposal
proposal'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
proposal
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionProviderActivateMethodInfo
instance (signature ~ (b -> c -> m ()), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c) => O.OverloadedMethod CompletionProviderActivateMethodInfo a signature where
    overloadedMethod = completionProviderActivate

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


#endif

-- method CompletionProvider::display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proposal"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProposal" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProposal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cell"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionCell" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionCell"
--                 , 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_provider_display" gtk_source_completion_provider_display :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr GtkSource.CompletionProposal.CompletionProposal -> -- proposal : TInterface (Name {namespace = "GtkSource", name = "CompletionProposal"})
    Ptr GtkSource.CompletionCell.CompletionCell -> -- cell : TInterface (Name {namespace = "GtkSource", name = "CompletionCell"})
    IO ()

-- | This function requests that the t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider' prepares
-- /@cell@/ to display the contents of /@proposal@/.
-- 
-- Based on /@cells@/ column type, you may want to display different information.
-- 
-- This allows for columns of information among completion proposals
-- resulting in better alignment of similar content (icons, return types,
-- method names, and parameter lists).
completionProviderDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c, GtkSource.CompletionCell.IsCompletionCell d) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> c
    -- ^ /@proposal@/: a t'GI.GtkSource.Interfaces.CompletionProposal.CompletionProposal'
    -> d
    -- ^ /@cell@/: a t'GI.GtkSource.Objects.CompletionCell.CompletionCell'
    -> m ()
completionProviderDisplay :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b, IsCompletionProposal c,
 IsCompletionCell d) =>
a -> b -> c -> d -> m ()
completionProviderDisplay a
self b
context c
proposal d
cell = 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 CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr CompletionProposal
proposal' <- c -> IO (Ptr CompletionProposal)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
proposal
    Ptr CompletionCell
cell' <- d -> IO (Ptr CompletionCell)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
cell
    Ptr CompletionProvider
-> Ptr CompletionContext
-> Ptr CompletionProposal
-> Ptr CompletionCell
-> IO ()
gtk_source_completion_provider_display Ptr CompletionProvider
self' Ptr CompletionContext
context' Ptr CompletionProposal
proposal' Ptr CompletionCell
cell'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
proposal
    d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr d
cell
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionProviderDisplayMethodInfo
instance (signature ~ (b -> c -> d -> m ()), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c, GtkSource.CompletionCell.IsCompletionCell d) => O.OverloadedMethod CompletionProviderDisplayMethodInfo a signature where
    overloadedMethod = completionProviderDisplay

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


#endif

-- method CompletionProvider::get_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_provider_get_priority" gtk_source_completion_provider_get_priority :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    IO Int32

-- | This function should return the priority of /@self@/ in /@context@/.
-- 
-- The priority is used to sort groups of completion proposals by
-- provider so that higher priority providers results are shown
-- above lower priority providers.
-- 
-- Higher value indicates higher priority.
completionProviderGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> m Int32
completionProviderGetPriority :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b) =>
a -> b -> m Int32
completionProviderGetPriority a
self b
context = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Int32
result <- Ptr CompletionProvider -> Ptr CompletionContext -> IO Int32
gtk_source_completion_provider_get_priority Ptr CompletionProvider
self' Ptr CompletionContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data CompletionProviderGetPriorityMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b) => O.OverloadedMethod CompletionProviderGetPriorityMethodInfo a signature where
    overloadedMethod = completionProviderGetPriority

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


#endif

-- method CompletionProvider::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , 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 "gtk_source_completion_provider_get_title" gtk_source_completion_provider_get_title :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    IO CString

-- | Gets the title of the completion provider, if any.
-- 
-- Currently, titles are not displayed in the completion results, but may be
-- at some point in the future when non-'P.Nothing'.
completionProviderGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a title for the provider or 'P.Nothing'
completionProviderGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionProvider a) =>
a -> m (Maybe Text)
completionProviderGetTitle a
self = 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 CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr CompletionProvider -> IO CString
gtk_source_completion_provider_get_title Ptr CompletionProvider
self'
    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'
        Text -> IO Text
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
    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 CompletionProviderGetTitleMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsCompletionProvider a) => O.OverloadedMethod CompletionProviderGetTitleMethodInfo a signature where
    overloadedMethod = completionProviderGetTitle

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


#endif

-- method CompletionProvider::is_trigger
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextIter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ch"
--           , argType = TBasicType TUniChar
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gunichar of the character inserted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_provider_is_trigger" gtk_source_completion_provider_is_trigger :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr Gtk.TextIter.TextIter ->            -- iter : TInterface (Name {namespace = "Gtk", name = "TextIter"})
    CInt ->                                 -- ch : TBasicType TUniChar
    IO CInt

-- | This function is used to determine if a character inserted into the text
-- editor should cause a new completion request to be triggered.
-- 
-- An example would be period \'.\' which might indicate that the user wants
-- to complete method or field names of an object.
-- 
-- This method will only trigger when text is inserted into the t'GI.Gtk.Objects.TextBuffer.TextBuffer'
-- while the completion list is visible and a proposal is selected. Incremental
-- key-presses (like shift, control, or alt) are not triggerable.
completionProviderIsTrigger ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> Gtk.TextIter.TextIter
    -- ^ /@iter@/: a t'GI.Gtk.Structs.TextIter.TextIter'
    -> Char
    -- ^ /@ch@/: a @/gunichar/@ of the character inserted
    -> m Bool
completionProviderIsTrigger :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCompletionProvider a) =>
a -> TextIter -> Char -> m Bool
completionProviderIsTrigger a
self TextIter
iter Char
ch = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TextIter
iter' <- TextIter -> IO (Ptr TextIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextIter
iter
    let ch' :: CInt
ch' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
SP.ord) Char
ch
    CInt
result <- Ptr CompletionProvider -> Ptr TextIter -> CInt -> IO CInt
gtk_source_completion_provider_is_trigger Ptr CompletionProvider
self' Ptr TextIter
iter' CInt
ch'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    TextIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextIter
iter
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CompletionProviderIsTriggerMethodInfo
instance (signature ~ (Gtk.TextIter.TextIter -> Char -> m Bool), MonadIO m, IsCompletionProvider a) => O.OverloadedMethod CompletionProviderIsTriggerMethodInfo a signature where
    overloadedMethod = completionProviderIsTrigger

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


#endif

-- method CompletionProvider::key_activates
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proposal"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProposal" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProposal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a keyval such as [const@Gdk.KEY_period]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkModifierType or 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_provider_key_activates" gtk_source_completion_provider_key_activates :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr GtkSource.CompletionProposal.CompletionProposal -> -- proposal : TInterface (Name {namespace = "GtkSource", name = "CompletionProposal"})
    Word32 ->                               -- keyval : TBasicType TUInt
    CUInt ->                                -- state : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    IO CInt

-- | This function is used to determine if a key typed by the user should
-- activate /@proposal@/ (resulting in committing the text to the editor).
-- 
-- This is useful when using languages where convention may lead to less
-- typing by the user. One example may be the use of \".\" or \"-\" to expand
-- a field access in the C programming language.
completionProviderKeyActivates ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> c
    -- ^ /@proposal@/: a t'GI.GtkSource.Interfaces.CompletionProposal.CompletionProposal'
    -> Word32
    -- ^ /@keyval@/: a keyval such as [const/@gdk@/.KEY_period]
    -> [Gdk.Flags.ModifierType]
    -- ^ /@state@/: a t'GI.Gdk.Flags.ModifierType' or 0
    -> m Bool
completionProviderKeyActivates :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b, IsCompletionProposal c) =>
a -> b -> c -> Word32 -> [ModifierType] -> m Bool
completionProviderKeyActivates a
self b
context c
proposal Word32
keyval [ModifierType]
state = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr CompletionProposal
proposal' <- c -> IO (Ptr CompletionProposal)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
proposal
    let state' :: CUInt
state' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
state
    CInt
result <- Ptr CompletionProvider
-> Ptr CompletionContext
-> Ptr CompletionProposal
-> Word32
-> CUInt
-> IO CInt
gtk_source_completion_provider_key_activates Ptr CompletionProvider
self' Ptr CompletionContext
context' Ptr CompletionProposal
proposal' Word32
keyval CUInt
state'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
proposal
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CompletionProviderKeyActivatesMethodInfo
instance (signature ~ (b -> c -> Word32 -> [Gdk.Flags.ModifierType] -> m Bool), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c) => O.OverloadedMethod CompletionProviderKeyActivatesMethodInfo a signature where
    overloadedMethod = completionProviderKeyActivates

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


#endif

-- method CompletionProvider::list_alternates
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proposal"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProposal" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProposal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface
--                     Name { namespace = "GtkSource" , name = "CompletionProposal" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_provider_list_alternates" gtk_source_completion_provider_list_alternates :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr GtkSource.CompletionProposal.CompletionProposal -> -- proposal : TInterface (Name {namespace = "GtkSource", name = "CompletionProposal"})
    IO (Ptr (GPtrArray (Ptr GtkSource.CompletionProposal.CompletionProposal)))

-- | Providers should return a list of alternates to /@proposal@/ or 'P.Nothing' if
-- there are no alternates available.
-- 
-- This can be used by the completion view to allow the user to move laterally
-- through similar proposals, such as overrides of methods by the same name.
completionProviderListAlternates ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> c
    -- ^ /@proposal@/: a t'GI.GtkSource.Interfaces.CompletionProposal.CompletionProposal'
    -> m (Maybe [GtkSource.CompletionProposal.CompletionProposal])
    -- ^ __Returns:__ 
    --   a t'GI.GLib.Structs.PtrArray.PtrArray' of t'GI.GtkSource.Interfaces.CompletionProposal.CompletionProposal' or 'P.Nothing'.
completionProviderListAlternates :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b, IsCompletionProposal c) =>
a -> b -> c -> m (Maybe [CompletionProposal])
completionProviderListAlternates a
self b
context c
proposal = IO (Maybe [CompletionProposal]) -> m (Maybe [CompletionProposal])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [CompletionProposal]) -> m (Maybe [CompletionProposal]))
-> IO (Maybe [CompletionProposal])
-> m (Maybe [CompletionProposal])
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr CompletionProposal
proposal' <- c -> IO (Ptr CompletionProposal)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
proposal
    Ptr (GPtrArray (Ptr CompletionProposal))
result <- Ptr CompletionProvider
-> Ptr CompletionContext
-> Ptr CompletionProposal
-> IO (Ptr (GPtrArray (Ptr CompletionProposal)))
gtk_source_completion_provider_list_alternates Ptr CompletionProvider
self' Ptr CompletionContext
context' Ptr CompletionProposal
proposal'
    Maybe [CompletionProposal]
maybeResult <- Ptr (GPtrArray (Ptr CompletionProposal))
-> (Ptr (GPtrArray (Ptr CompletionProposal))
    -> IO [CompletionProposal])
-> IO (Maybe [CompletionProposal])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr (GPtrArray (Ptr CompletionProposal))
result ((Ptr (GPtrArray (Ptr CompletionProposal))
  -> IO [CompletionProposal])
 -> IO (Maybe [CompletionProposal]))
-> (Ptr (GPtrArray (Ptr CompletionProposal))
    -> IO [CompletionProposal])
-> IO (Maybe [CompletionProposal])
forall a b. (a -> b) -> a -> b
$ \Ptr (GPtrArray (Ptr CompletionProposal))
result' -> do
        [Ptr CompletionProposal]
result'' <- Ptr (GPtrArray (Ptr CompletionProposal))
-> IO [Ptr CompletionProposal]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr CompletionProposal))
result'
        [CompletionProposal]
result''' <- (Ptr CompletionProposal -> IO CompletionProposal)
-> [Ptr CompletionProposal] -> IO [CompletionProposal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr CompletionProposal -> CompletionProposal)
-> Ptr CompletionProposal -> IO CompletionProposal
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CompletionProposal -> CompletionProposal
GtkSource.CompletionProposal.CompletionProposal) [Ptr CompletionProposal]
result''
        Ptr (GPtrArray (Ptr CompletionProposal)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr CompletionProposal))
result'
        [CompletionProposal] -> IO [CompletionProposal]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionProposal]
result'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
proposal
    Maybe [CompletionProposal] -> IO (Maybe [CompletionProposal])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [CompletionProposal]
maybeResult

#if defined(ENABLE_OVERLOADING)
data CompletionProviderListAlternatesMethodInfo
instance (signature ~ (b -> c -> m (Maybe [GtkSource.CompletionProposal.CompletionProposal])), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, GtkSource.CompletionProposal.IsCompletionProposal c) => O.OverloadedMethod CompletionProviderListAlternatesMethodInfo a signature where
    overloadedMethod = completionProviderListAlternates

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


#endif

-- method CompletionProvider::populate_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a callback to execute upon completion"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "closure data for @callback"
--                 , 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_provider_populate_async" gtk_source_completion_provider_populate_async :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously requests that the provider populates the completion
-- results for /@context@/.
-- 
-- For providers that would like to populate a t'GI.Gio.Interfaces.ListModel.ListModel' while those
-- results are displayed to the user,
-- [method/@completionContext@/.set_proposals_for_provider] may be used
-- to reduce latency until the user sees results.
completionProviderPopulateAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to execute upon completion
    -> m ()
completionProviderPopulateAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b, IsCancellable c) =>
a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
completionProviderPopulateAsync a
self b
context Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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 CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr CompletionProvider
-> Ptr CompletionContext
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_source_completion_provider_populate_async Ptr CompletionProvider
self' Ptr CompletionContext
context' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionProviderPopulateAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod CompletionProviderPopulateAsyncMethodInfo a signature where
    overloadedMethod = completionProviderPopulateAsync

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


#endif

-- method CompletionProvider::populate_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult provided to callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_completion_provider_populate_finish" gtk_source_completion_provider_populate_finish :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.ListModel.ListModel)

-- | Completes an asynchronous operation to populate a completion provider.
completionProviderPopulateFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult' provided to callback
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.ListModel.ListModel' of t'GI.GtkSource.Interfaces.CompletionProposal.CompletionProposal' /(Can throw 'Data.GI.Base.GError.GError')/
completionProviderPopulateFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsAsyncResult b) =>
a -> b -> m ListModel
completionProviderPopulateFinish a
self b
result_ = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO ListModel -> IO () -> IO ListModel
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ListModel
result <- (Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel))
-> (Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel)
forall a b. (a -> b) -> a -> b
$ Ptr CompletionProvider
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ListModel)
gtk_source_completion_provider_populate_finish Ptr CompletionProvider
self' Ptr AsyncResult
result_'
        Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"completionProviderPopulateFinish" Ptr ListModel
result
        ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CompletionProviderPopulateFinishMethodInfo
instance (signature ~ (b -> m Gio.ListModel.ListModel), MonadIO m, IsCompletionProvider a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod CompletionProviderPopulateFinishMethodInfo a signature where
    overloadedMethod = completionProviderPopulateFinish

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


#endif

-- method CompletionProvider::refilter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionProvider"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GListModel" , 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_provider_refilter" gtk_source_completion_provider_refilter :: 
    Ptr CompletionProvider ->               -- self : TInterface (Name {namespace = "GtkSource", name = "CompletionProvider"})
    Ptr GtkSource.CompletionContext.CompletionContext -> -- context : TInterface (Name {namespace = "GtkSource", name = "CompletionContext"})
    Ptr Gio.ListModel.ListModel ->          -- model : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | This function can be used to filter results previously provided to
-- the [class/@completionContext@/] by the t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'.
-- 
-- This can happen as the user types additional text onto the word so
-- that previously matched items may be removed from the list instead of
-- generating new t'GI.Gio.Interfaces.ListModel.ListModel' of results.
completionProviderRefilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, Gio.ListModel.IsListModel c) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Interfaces.CompletionProvider.CompletionProvider'
    -> b
    -- ^ /@context@/: a t'GI.GtkSource.Objects.CompletionContext.CompletionContext'
    -> c
    -- ^ /@model@/: a t'GI.Gio.Interfaces.ListModel.ListModel'
    -> m ()
completionProviderRefilter :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsCompletionProvider a,
 IsCompletionContext b, IsListModel c) =>
a -> b -> c -> m ()
completionProviderRefilter a
self b
context c
model = 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 CompletionProvider
self' <- a -> IO (Ptr CompletionProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CompletionContext
context' <- b -> IO (Ptr CompletionContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr ListModel
model' <- c -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
model
    Ptr CompletionProvider
-> Ptr CompletionContext -> Ptr ListModel -> IO ()
gtk_source_completion_provider_refilter Ptr CompletionProvider
self' Ptr CompletionContext
context' Ptr ListModel
model'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
model
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionProviderRefilterMethodInfo
instance (signature ~ (b -> c -> m ()), MonadIO m, IsCompletionProvider a, GtkSource.CompletionContext.IsCompletionContext b, Gio.ListModel.IsListModel c) => O.OverloadedMethod CompletionProviderRefilterMethodInfo a signature where
    overloadedMethod = completionProviderRefilter

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


#endif

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

#endif