{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GCompletion@ provides support for automatic completion of a string
-- using any group of target strings. It is typically used for file
-- name completion as is common in many UNIX shells.
-- 
-- A @GCompletion@ is created using [func/@gLib@/.Completion.new]. Target items are
-- added and removed with t'GI.GLib.Structs.Completion.Completion'.@/add_items/@(),
-- t'GI.GLib.Structs.Completion.Completion'.@/remove_items/@() and
-- 'GI.GLib.Structs.Completion.completionClearItems'. A completion attempt is requested with
-- t'GI.GLib.Structs.Completion.Completion'.@/complete/@() or 'GI.GLib.Structs.Completion.completionCompleteUtf8'.
-- When no longer needed, the @GCompletion@ is freed with
-- 'GI.GLib.Structs.Completion.completionFree'.
-- 
-- Items in the completion can be simple strings (e.g. filenames), or
-- pointers to arbitrary data structures. If data structures are used
-- you must provide a [type/@gLib@/.CompletionFunc] in [func/@gLib@/.Completion.new],
-- which retrieves the item’s string from the data structure. You can change
-- the way in which strings are compared by setting a different
-- [type/@gLib@/.CompletionStrncmpFunc] in t'GI.GLib.Structs.Completion.Completion'.@/set_compare/@().
-- 
-- @GCompletion@ has been marked as deprecated, since this API is rarely
-- used and not very actively maintained.

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

module GI.GLib.Structs.Completion
    ( 

-- * Exported types
    Completion(..)                          ,
    newZeroCompletion                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [clearItems]("GI.GLib.Structs.Completion#g:method:clearItems"), [completeUtf8]("GI.GLib.Structs.Completion#g:method:completeUtf8"), [free]("GI.GLib.Structs.Completion#g:method:free").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveCompletionMethod                 ,
#endif

-- ** clearItems #method:clearItems#

#if defined(ENABLE_OVERLOADING)
    CompletionClearItemsMethodInfo          ,
#endif
    completionClearItems                    ,


-- ** completeUtf8 #method:completeUtf8#

#if defined(ENABLE_OVERLOADING)
    CompletionCompleteUtf8MethodInfo        ,
#endif
    completionCompleteUtf8                  ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    CompletionFreeMethodInfo                ,
#endif
    completionFree                          ,




 -- * Properties


-- ** cache #attr:cache#
-- | the list of items which begin with /@prefix@/.

    clearCompletionCache                    ,
#if defined(ENABLE_OVERLOADING)
    completion_cache                        ,
#endif
    getCompletionCache                      ,
    setCompletionCache                      ,


-- ** func #attr:func#
-- | function which is called to get the string associated with a
--        target item. It is 'P.Nothing' if the target items are strings.

    clearCompletionFunc                     ,
#if defined(ENABLE_OVERLOADING)
    completion_func                         ,
#endif
    getCompletionFunc                       ,
    setCompletionFunc                       ,


-- ** items #attr:items#
-- | list of target items (strings or data structures).

    clearCompletionItems                    ,
#if defined(ENABLE_OVERLOADING)
    completion_items                        ,
#endif
    getCompletionItems                      ,
    setCompletionItems                      ,


-- ** prefix #attr:prefix#
-- | the last prefix passed to @/g_completion_complete()/@ or
--          'GI.GLib.Structs.Completion.completionCompleteUtf8'.

    clearCompletionPrefix                   ,
#if defined(ENABLE_OVERLOADING)
    completion_prefix                       ,
#endif
    getCompletionPrefix                     ,
    setCompletionPrefix                     ,


-- ** strncmpFunc #attr:strncmpFunc#
-- | The function to use when comparing strings.  Use
--                @/g_completion_set_compare()/@ to modify this function.

    clearCompletionStrncmpFunc              ,
#if defined(ENABLE_OVERLOADING)
    completion_strncmpFunc                  ,
#endif
    getCompletionStrncmpFunc                ,
    setCompletionStrncmpFunc                ,




    ) 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.GLib.Callbacks as GLib.Callbacks

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks

#endif

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

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

instance BoxedPtr Completion where
    boxedPtrCopy :: Completion -> IO Completion
boxedPtrCopy = \Completion
p -> Completion -> (Ptr Completion -> IO Completion) -> IO Completion
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Completion
p (Int -> Ptr Completion -> IO (Ptr Completion)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
40 (Ptr Completion -> IO (Ptr Completion))
-> (Ptr Completion -> IO Completion)
-> Ptr Completion
-> IO Completion
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr Completion -> Completion)
-> Ptr Completion -> IO Completion
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr Completion -> Completion
Completion)
    boxedPtrFree :: Completion -> IO ()
boxedPtrFree = \Completion
x -> Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr Completion
x Ptr Completion -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr Completion where
    boxedPtrCalloc :: IO (Ptr Completion)
boxedPtrCalloc = Int -> IO (Ptr Completion)
forall a. Int -> IO (Ptr a)
callocBytes Int
40


-- | Construct a `Completion` struct initialized to zero.
newZeroCompletion :: MonadIO m => m Completion
newZeroCompletion :: forall (m :: * -> *). MonadIO m => m Completion
newZeroCompletion = IO Completion -> m Completion
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Completion -> m Completion) -> IO Completion -> m Completion
forall a b. (a -> b) -> a -> b
$ IO (Ptr Completion)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr Completion)
-> (Ptr Completion -> IO Completion) -> IO Completion
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Completion -> Completion)
-> Ptr Completion -> IO Completion
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr Completion -> Completion
Completion

instance tag ~ 'AttrSet => Constructible Completion tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr Completion -> Completion)
-> [AttrOp Completion tag] -> m Completion
new ManagedPtr Completion -> Completion
_ [AttrOp Completion tag]
attrs = do
        Completion
o <- m Completion
forall (m :: * -> *). MonadIO m => m Completion
newZeroCompletion
        Completion -> [AttrOp Completion 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set Completion
o [AttrOp Completion tag]
[AttrOp Completion 'AttrSet]
attrs
        Completion -> m Completion
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Completion
o


-- | Get the value of the “@items@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completion #items
-- @
getCompletionItems :: MonadIO m => Completion -> m ([Ptr ()])
getCompletionItems :: forall (m :: * -> *). MonadIO m => Completion -> m [Ptr ()]
getCompletionItems Completion
s = IO [Ptr ()] -> m [Ptr ()]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ Completion -> (Ptr Completion -> IO [Ptr ()]) -> IO [Ptr ()]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO [Ptr ()]) -> IO [Ptr ()])
-> (Ptr Completion -> IO [Ptr ()]) -> IO [Ptr ()]
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (GList (Ptr ()))
val <- Ptr (Ptr (GList (Ptr ()))) -> IO (Ptr (GList (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr (GList (Ptr ())))
    [Ptr ()]
val' <- Ptr (GList (Ptr ())) -> IO [Ptr ()]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ()))
val
    [Ptr ()] -> IO [Ptr ()]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr ()]
val'

-- | Set the value of the “@items@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completion [ #items 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionItems :: MonadIO m => Completion -> Ptr (GList (Ptr ())) -> m ()
setCompletionItems :: forall (m :: * -> *).
MonadIO m =>
Completion -> Ptr (GList (Ptr ())) -> m ()
setCompletionItems Completion
s Ptr (GList (Ptr ()))
val = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (Ptr (GList (Ptr ()))) -> Ptr (GList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr (GList (Ptr ()))
val :: Ptr (GList (Ptr ())))

-- | Set the value of the “@items@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #items
-- @
clearCompletionItems :: MonadIO m => Completion -> m ()
clearCompletionItems :: forall (m :: * -> *). MonadIO m => Completion -> m ()
clearCompletionItems Completion
s = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (Ptr (GList (Ptr ()))) -> Ptr (GList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr (GList (Ptr ()))
forall a. Ptr a
FP.nullPtr :: Ptr (GList (Ptr ())))

#if defined(ENABLE_OVERLOADING)
data CompletionItemsFieldInfo
instance AttrInfo CompletionItemsFieldInfo where
    type AttrBaseTypeConstraint CompletionItemsFieldInfo = (~) Completion
    type AttrAllowedOps CompletionItemsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CompletionItemsFieldInfo = (~) (Ptr (GList (Ptr ())))
    type AttrTransferTypeConstraint CompletionItemsFieldInfo = (~)(Ptr (GList (Ptr ())))
    type AttrTransferType CompletionItemsFieldInfo = (Ptr (GList (Ptr ())))
    type AttrGetType CompletionItemsFieldInfo = [Ptr ()]
    type AttrLabel CompletionItemsFieldInfo = "items"
    type AttrOrigin CompletionItemsFieldInfo = Completion
    attrGet = getCompletionItems
    attrSet = setCompletionItems
    attrConstruct = undefined
    attrClear = clearCompletionItems
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.items"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#g:attr:items"
        })

completion_items :: AttrLabelProxy "items"
completion_items = AttrLabelProxy

#endif


-- | Get the value of the “@func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completion #func
-- @
getCompletionFunc :: MonadIO m => Completion -> m (Maybe GLib.Callbacks.CompletionFunc_WithClosures)
getCompletionFunc :: forall (m :: * -> *).
MonadIO m =>
Completion -> m (Maybe CompletionFunc_WithClosures)
getCompletionFunc Completion
s = IO (Maybe CompletionFunc_WithClosures)
-> m (Maybe CompletionFunc_WithClosures)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CompletionFunc_WithClosures)
 -> m (Maybe CompletionFunc_WithClosures))
-> IO (Maybe CompletionFunc_WithClosures)
-> m (Maybe CompletionFunc_WithClosures)
forall a b. (a -> b) -> a -> b
$ Completion
-> (Ptr Completion -> IO (Maybe CompletionFunc_WithClosures))
-> IO (Maybe CompletionFunc_WithClosures)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO (Maybe CompletionFunc_WithClosures))
 -> IO (Maybe CompletionFunc_WithClosures))
-> (Ptr Completion -> IO (Maybe CompletionFunc_WithClosures))
-> IO (Maybe CompletionFunc_WithClosures)
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    FunPtr C_CompletionFunc
val <- Ptr (FunPtr C_CompletionFunc) -> IO (FunPtr C_CompletionFunc)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (FunPtr C_CompletionFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (FunPtr GLib.Callbacks.C_CompletionFunc)
    Maybe CompletionFunc_WithClosures
result <- FunPtr C_CompletionFunc
-> (FunPtr C_CompletionFunc -> IO CompletionFunc_WithClosures)
-> IO (Maybe CompletionFunc_WithClosures)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_CompletionFunc
val ((FunPtr C_CompletionFunc -> IO CompletionFunc_WithClosures)
 -> IO (Maybe CompletionFunc_WithClosures))
-> (FunPtr C_CompletionFunc -> IO CompletionFunc_WithClosures)
-> IO (Maybe CompletionFunc_WithClosures)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_CompletionFunc
val' -> do
        let val'' :: CompletionFunc_WithClosures
val'' = FunPtr C_CompletionFunc -> CompletionFunc_WithClosures
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_CompletionFunc -> Ptr () -> m Text
GLib.Callbacks.dynamic_CompletionFunc FunPtr C_CompletionFunc
val'
        CompletionFunc_WithClosures -> IO CompletionFunc_WithClosures
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionFunc_WithClosures
val''
    Maybe CompletionFunc_WithClosures
-> IO (Maybe CompletionFunc_WithClosures)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CompletionFunc_WithClosures
result

-- | Set the value of the “@func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completion [ #func 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionFunc :: MonadIO m => Completion -> FunPtr GLib.Callbacks.C_CompletionFunc -> m ()
setCompletionFunc :: forall (m :: * -> *).
MonadIO m =>
Completion -> FunPtr C_CompletionFunc -> m ()
setCompletionFunc Completion
s FunPtr C_CompletionFunc
val = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (FunPtr C_CompletionFunc) -> FunPtr C_CompletionFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (FunPtr C_CompletionFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (FunPtr C_CompletionFunc
val :: FunPtr GLib.Callbacks.C_CompletionFunc)

-- | Set the value of the “@func@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #func
-- @
clearCompletionFunc :: MonadIO m => Completion -> m ()
clearCompletionFunc :: forall (m :: * -> *). MonadIO m => Completion -> m ()
clearCompletionFunc Completion
s = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (FunPtr C_CompletionFunc) -> FunPtr C_CompletionFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (FunPtr C_CompletionFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (FunPtr C_CompletionFunc
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GLib.Callbacks.C_CompletionFunc)

#if defined(ENABLE_OVERLOADING)
data CompletionFuncFieldInfo
instance AttrInfo CompletionFuncFieldInfo where
    type AttrBaseTypeConstraint CompletionFuncFieldInfo = (~) Completion
    type AttrAllowedOps CompletionFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CompletionFuncFieldInfo = (~) (FunPtr GLib.Callbacks.C_CompletionFunc)
    type AttrTransferTypeConstraint CompletionFuncFieldInfo = (~)GLib.Callbacks.CompletionFunc_WithClosures
    type AttrTransferType CompletionFuncFieldInfo = (FunPtr GLib.Callbacks.C_CompletionFunc)
    type AttrGetType CompletionFuncFieldInfo = Maybe GLib.Callbacks.CompletionFunc_WithClosures
    type AttrLabel CompletionFuncFieldInfo = "func"
    type AttrOrigin CompletionFuncFieldInfo = Completion
    attrGet = getCompletionFunc
    attrSet = setCompletionFunc
    attrConstruct = undefined
    attrClear = clearCompletionFunc
    attrTransfer _ v = do
        GLib.Callbacks.mk_CompletionFunc (GLib.Callbacks.wrap_CompletionFunc Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.func"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#g:attr:func"
        })

completion_func :: AttrLabelProxy "func"
completion_func = AttrLabelProxy

#endif


-- | Get the value of the “@prefix@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completion #prefix
-- @
getCompletionPrefix :: MonadIO m => Completion -> m (Maybe T.Text)
getCompletionPrefix :: forall (m :: * -> *). MonadIO m => Completion -> m (Maybe Text)
getCompletionPrefix Completion
s = 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
$ Completion
-> (Ptr Completion -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Completion -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Completion
ptr Ptr Completion -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@prefix@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completion [ #prefix 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionPrefix :: MonadIO m => Completion -> CString -> m ()
setCompletionPrefix :: forall (m :: * -> *). MonadIO m => Completion -> CString -> m ()
setCompletionPrefix Completion
s CString
val = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@prefix@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #prefix
-- @
clearCompletionPrefix :: MonadIO m => Completion -> m ()
clearCompletionPrefix :: forall (m :: * -> *). MonadIO m => Completion -> m ()
clearCompletionPrefix Completion
s = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CompletionPrefixFieldInfo
instance AttrInfo CompletionPrefixFieldInfo where
    type AttrBaseTypeConstraint CompletionPrefixFieldInfo = (~) Completion
    type AttrAllowedOps CompletionPrefixFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CompletionPrefixFieldInfo = (~) CString
    type AttrTransferTypeConstraint CompletionPrefixFieldInfo = (~)CString
    type AttrTransferType CompletionPrefixFieldInfo = CString
    type AttrGetType CompletionPrefixFieldInfo = Maybe T.Text
    type AttrLabel CompletionPrefixFieldInfo = "prefix"
    type AttrOrigin CompletionPrefixFieldInfo = Completion
    attrGet = getCompletionPrefix
    attrSet = setCompletionPrefix
    attrConstruct = undefined
    attrClear = clearCompletionPrefix
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.prefix"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#g:attr:prefix"
        })

completion_prefix :: AttrLabelProxy "prefix"
completion_prefix = AttrLabelProxy

#endif


-- | Get the value of the “@cache@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completion #cache
-- @
getCompletionCache :: MonadIO m => Completion -> m ([Ptr ()])
getCompletionCache :: forall (m :: * -> *). MonadIO m => Completion -> m [Ptr ()]
getCompletionCache Completion
s = IO [Ptr ()] -> m [Ptr ()]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ Completion -> (Ptr Completion -> IO [Ptr ()]) -> IO [Ptr ()]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO [Ptr ()]) -> IO [Ptr ()])
-> (Ptr Completion -> IO [Ptr ()]) -> IO [Ptr ()]
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (GList (Ptr ()))
val <- Ptr (Ptr (GList (Ptr ()))) -> IO (Ptr (GList (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (Ptr (GList (Ptr ())))
    [Ptr ()]
val' <- Ptr (GList (Ptr ())) -> IO [Ptr ()]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ()))
val
    [Ptr ()] -> IO [Ptr ()]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Ptr ()]
val'

-- | Set the value of the “@cache@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completion [ #cache 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionCache :: MonadIO m => Completion -> Ptr (GList (Ptr ())) -> m ()
setCompletionCache :: forall (m :: * -> *).
MonadIO m =>
Completion -> Ptr (GList (Ptr ())) -> m ()
setCompletionCache Completion
s Ptr (GList (Ptr ()))
val = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (Ptr (GList (Ptr ()))) -> Ptr (GList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr (GList (Ptr ()))
val :: Ptr (GList (Ptr ())))

-- | Set the value of the “@cache@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #cache
-- @
clearCompletionCache :: MonadIO m => Completion -> m ()
clearCompletionCache :: forall (m :: * -> *). MonadIO m => Completion -> m ()
clearCompletionCache Completion
s = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (Ptr (GList (Ptr ()))) -> Ptr (GList (Ptr ())) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (Ptr (GList (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Ptr (GList (Ptr ()))
forall a. Ptr a
FP.nullPtr :: Ptr (GList (Ptr ())))

#if defined(ENABLE_OVERLOADING)
data CompletionCacheFieldInfo
instance AttrInfo CompletionCacheFieldInfo where
    type AttrBaseTypeConstraint CompletionCacheFieldInfo = (~) Completion
    type AttrAllowedOps CompletionCacheFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CompletionCacheFieldInfo = (~) (Ptr (GList (Ptr ())))
    type AttrTransferTypeConstraint CompletionCacheFieldInfo = (~)(Ptr (GList (Ptr ())))
    type AttrTransferType CompletionCacheFieldInfo = (Ptr (GList (Ptr ())))
    type AttrGetType CompletionCacheFieldInfo = [Ptr ()]
    type AttrLabel CompletionCacheFieldInfo = "cache"
    type AttrOrigin CompletionCacheFieldInfo = Completion
    attrGet = getCompletionCache
    attrSet = setCompletionCache
    attrConstruct = undefined
    attrClear = clearCompletionCache
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.cache"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#g:attr:cache"
        })

completion_cache :: AttrLabelProxy "cache"
completion_cache = AttrLabelProxy

#endif


-- | Get the value of the “@strncmp_func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completion #strncmpFunc
-- @
getCompletionStrncmpFunc :: MonadIO m => Completion -> m (Maybe GLib.Callbacks.CompletionStrncmpFunc)
getCompletionStrncmpFunc :: forall (m :: * -> *).
MonadIO m =>
Completion -> m (Maybe CompletionStrncmpFunc)
getCompletionStrncmpFunc Completion
s = IO (Maybe CompletionStrncmpFunc) -> m (Maybe CompletionStrncmpFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CompletionStrncmpFunc)
 -> m (Maybe CompletionStrncmpFunc))
-> IO (Maybe CompletionStrncmpFunc)
-> m (Maybe CompletionStrncmpFunc)
forall a b. (a -> b) -> a -> b
$ Completion
-> (Ptr Completion -> IO (Maybe CompletionStrncmpFunc))
-> IO (Maybe CompletionStrncmpFunc)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO (Maybe CompletionStrncmpFunc))
 -> IO (Maybe CompletionStrncmpFunc))
-> (Ptr Completion -> IO (Maybe CompletionStrncmpFunc))
-> IO (Maybe CompletionStrncmpFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    FunPtr C_CompletionStrncmpFunc
val <- Ptr (FunPtr C_CompletionStrncmpFunc)
-> IO (FunPtr C_CompletionStrncmpFunc)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (FunPtr C_CompletionStrncmpFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO (FunPtr GLib.Callbacks.C_CompletionStrncmpFunc)
    Maybe CompletionStrncmpFunc
result <- FunPtr C_CompletionStrncmpFunc
-> (FunPtr C_CompletionStrncmpFunc -> IO CompletionStrncmpFunc)
-> IO (Maybe CompletionStrncmpFunc)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_CompletionStrncmpFunc
val ((FunPtr C_CompletionStrncmpFunc -> IO CompletionStrncmpFunc)
 -> IO (Maybe CompletionStrncmpFunc))
-> (FunPtr C_CompletionStrncmpFunc -> IO CompletionStrncmpFunc)
-> IO (Maybe CompletionStrncmpFunc)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_CompletionStrncmpFunc
val' -> do
        let val'' :: CompletionStrncmpFunc
val'' = FunPtr C_CompletionStrncmpFunc -> CompletionStrncmpFunc
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_CompletionStrncmpFunc -> Text -> Text -> CSize -> m Int32
GLib.Callbacks.dynamic_CompletionStrncmpFunc FunPtr C_CompletionStrncmpFunc
val'
        CompletionStrncmpFunc -> IO CompletionStrncmpFunc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionStrncmpFunc
val''
    Maybe CompletionStrncmpFunc -> IO (Maybe CompletionStrncmpFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CompletionStrncmpFunc
result

-- | Set the value of the “@strncmp_func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completion [ #strncmpFunc 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionStrncmpFunc :: MonadIO m => Completion -> FunPtr GLib.Callbacks.C_CompletionStrncmpFunc -> m ()
setCompletionStrncmpFunc :: forall (m :: * -> *).
MonadIO m =>
Completion -> FunPtr C_CompletionStrncmpFunc -> m ()
setCompletionStrncmpFunc Completion
s FunPtr C_CompletionStrncmpFunc
val = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (FunPtr C_CompletionStrncmpFunc)
-> FunPtr C_CompletionStrncmpFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (FunPtr C_CompletionStrncmpFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (FunPtr C_CompletionStrncmpFunc
val :: FunPtr GLib.Callbacks.C_CompletionStrncmpFunc)

-- | Set the value of the “@strncmp_func@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #strncmpFunc
-- @
clearCompletionStrncmpFunc :: MonadIO m => Completion -> m ()
clearCompletionStrncmpFunc :: forall (m :: * -> *). MonadIO m => Completion -> m ()
clearCompletionStrncmpFunc Completion
s = 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
$ Completion -> (Ptr Completion -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Completion
s ((Ptr Completion -> IO ()) -> IO ())
-> (Ptr Completion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Completion
ptr -> do
    Ptr (FunPtr C_CompletionStrncmpFunc)
-> FunPtr C_CompletionStrncmpFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Completion
ptr Ptr Completion -> Int -> Ptr (FunPtr C_CompletionStrncmpFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (FunPtr C_CompletionStrncmpFunc
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GLib.Callbacks.C_CompletionStrncmpFunc)

#if defined(ENABLE_OVERLOADING)
data CompletionStrncmpFuncFieldInfo
instance AttrInfo CompletionStrncmpFuncFieldInfo where
    type AttrBaseTypeConstraint CompletionStrncmpFuncFieldInfo = (~) Completion
    type AttrAllowedOps CompletionStrncmpFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CompletionStrncmpFuncFieldInfo = (~) (FunPtr GLib.Callbacks.C_CompletionStrncmpFunc)
    type AttrTransferTypeConstraint CompletionStrncmpFuncFieldInfo = (~)GLib.Callbacks.CompletionStrncmpFunc
    type AttrTransferType CompletionStrncmpFuncFieldInfo = (FunPtr GLib.Callbacks.C_CompletionStrncmpFunc)
    type AttrGetType CompletionStrncmpFuncFieldInfo = Maybe GLib.Callbacks.CompletionStrncmpFunc
    type AttrLabel CompletionStrncmpFuncFieldInfo = "strncmp_func"
    type AttrOrigin CompletionStrncmpFuncFieldInfo = Completion
    attrGet = getCompletionStrncmpFunc
    attrSet = setCompletionStrncmpFunc
    attrConstruct = undefined
    attrClear = clearCompletionStrncmpFunc
    attrTransfer _ v = do
        GLib.Callbacks.mk_CompletionStrncmpFunc (GLib.Callbacks.wrap_CompletionStrncmpFunc Nothing v)
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.strncmpFunc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#g:attr:strncmpFunc"
        })

completion_strncmpFunc :: AttrLabelProxy "strncmpFunc"
completion_strncmpFunc = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Completion
type instance O.AttributeList Completion = CompletionAttributeList
type CompletionAttributeList = ('[ '("items", CompletionItemsFieldInfo), '("func", CompletionFuncFieldInfo), '("prefix", CompletionPrefixFieldInfo), '("cache", CompletionCacheFieldInfo), '("strncmpFunc", CompletionStrncmpFuncFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Completion::clear_items
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cmp"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "Completion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GCompletion." , 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 "g_completion_clear_items" g_completion_clear_items :: 
    Ptr Completion ->                       -- cmp : TInterface (Name {namespace = "GLib", name = "Completion"})
    IO ()

{-# DEPRECATED completionClearItems ["(Since version 2.26)","Rarely used API"] #-}
-- | Removes all items from the t'GI.GLib.Structs.Completion.Completion'. The items are not freed, so if the
-- memory was dynamically allocated, it should be freed after calling this
-- function.
completionClearItems ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Completion
    -- ^ /@cmp@/: the t'GI.GLib.Structs.Completion.Completion'.
    -> m ()
completionClearItems :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Completion -> m ()
completionClearItems Completion
cmp = 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 Completion
cmp' <- Completion -> IO (Ptr Completion)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Completion
cmp
    Ptr Completion -> IO ()
g_completion_clear_items Ptr Completion
cmp'
    Completion -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Completion
cmp
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionClearItemsMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod CompletionClearItemsMethodInfo Completion signature where
    overloadedMethod = completionClearItems

instance O.OverloadedMethodInfo CompletionClearItemsMethodInfo Completion where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.completionClearItems",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#v:completionClearItems"
        })


#endif

-- method Completion::complete_utf8
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cmp"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "Completion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GCompletion" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the prefix string, typically used by the user, which is compared\n   with each of the items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if non-%NULL, returns the longest prefix which is common to all\n   items that matched @prefix, or %NULL if no items matched @prefix.\n   This string should be freed when no longer needed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "g_completion_complete_utf8" g_completion_complete_utf8 :: 
    Ptr Completion ->                       -- cmp : TInterface (Name {namespace = "GLib", name = "Completion"})
    CString ->                              -- prefix : TBasicType TUTF8
    CString ->                              -- new_prefix : TBasicType TUTF8
    IO (Ptr (GList CString))

{-# DEPRECATED completionCompleteUtf8 ["(Since version 2.26)","Rarely used API"] #-}
-- | Attempts to complete the string /@prefix@/ using the t'GI.GLib.Structs.Completion.Completion' target items.
-- In contrast to @/g_completion_complete()/@, this function returns the largest common
-- prefix that is a valid UTF-8 string, omitting a possible common partial
-- character.
-- 
-- You should use this function instead of @/g_completion_complete()/@ if your
-- items are UTF-8 strings.
-- 
-- /Since: 2.4/
completionCompleteUtf8 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Completion
    -- ^ /@cmp@/: the t'GI.GLib.Structs.Completion.Completion'
    -> T.Text
    -- ^ /@prefix@/: the prefix string, typically used by the user, which is compared
    --    with each of the items
    -> T.Text
    -- ^ /@newPrefix@/: if non-'P.Nothing', returns the longest prefix which is common to all
    --    items that matched /@prefix@/, or 'P.Nothing' if no items matched /@prefix@/.
    --    This string should be freed when no longer needed.
    -> m [T.Text]
    -- ^ __Returns:__ the list of items whose strings begin with /@prefix@/. This should
    -- not be changed.
completionCompleteUtf8 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Completion -> Text -> Text -> m [Text]
completionCompleteUtf8 Completion
cmp Text
prefix Text
newPrefix = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Completion
cmp' <- Completion -> IO (Ptr Completion)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Completion
cmp
    CString
prefix' <- Text -> IO CString
textToCString Text
prefix
    CString
newPrefix' <- Text -> IO CString
textToCString Text
newPrefix
    Ptr (GList CString)
result <- Ptr Completion -> CString -> CString -> IO (Ptr (GList CString))
g_completion_complete_utf8 Ptr Completion
cmp' CString
prefix' CString
newPrefix'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    Completion -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Completion
cmp
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
prefix'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newPrefix'
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data CompletionCompleteUtf8MethodInfo
instance (signature ~ (T.Text -> T.Text -> m [T.Text]), MonadIO m) => O.OverloadedMethod CompletionCompleteUtf8MethodInfo Completion signature where
    overloadedMethod = completionCompleteUtf8

instance O.OverloadedMethodInfo CompletionCompleteUtf8MethodInfo Completion where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.completionCompleteUtf8",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#v:completionCompleteUtf8"
        })


#endif

-- method Completion::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cmp"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "Completion" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GCompletion." , 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 "g_completion_free" g_completion_free :: 
    Ptr Completion ->                       -- cmp : TInterface (Name {namespace = "GLib", name = "Completion"})
    IO ()

{-# DEPRECATED completionFree ["(Since version 2.26)","Rarely used API"] #-}
-- | Frees all memory used by the t'GI.GLib.Structs.Completion.Completion'. The items are not freed, so if
-- the memory was dynamically allocated, it should be freed after calling this
-- function.
completionFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Completion
    -- ^ /@cmp@/: the t'GI.GLib.Structs.Completion.Completion'.
    -> m ()
completionFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Completion -> m ()
completionFree Completion
cmp = 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 Completion
cmp' <- Completion -> IO (Ptr Completion)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Completion
cmp
    Ptr Completion -> IO ()
g_completion_free Ptr Completion
cmp'
    Completion -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Completion
cmp
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod CompletionFreeMethodInfo Completion signature where
    overloadedMethod = completionFree

instance O.OverloadedMethodInfo CompletionFreeMethodInfo Completion where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GLib.Structs.Completion.completionFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.30/docs/GI-GLib-Structs-Completion.html#v:completionFree"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCompletionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCompletionMethod "clearItems" o = CompletionClearItemsMethodInfo
    ResolveCompletionMethod "completeUtf8" o = CompletionCompleteUtf8MethodInfo
    ResolveCompletionMethod "free" o = CompletionFreeMethodInfo
    ResolveCompletionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif