{-# LANGUAGE TypeApplications #-}


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

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

module GI.Dazzle.Objects.FuzzyIndex
    ( 

-- * Exported types
    FuzzyIndex(..)                          ,
    IsFuzzyIndex                            ,
    toFuzzyIndex                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadFile]("GI.Dazzle.Objects.FuzzyIndex#g:method:loadFile"), [loadFileAsync]("GI.Dazzle.Objects.FuzzyIndex#g:method:loadFileAsync"), [loadFileFinish]("GI.Dazzle.Objects.FuzzyIndex#g:method:loadFileFinish"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [queryAsync]("GI.Dazzle.Objects.FuzzyIndex#g:method:queryAsync"), [queryFinish]("GI.Dazzle.Objects.FuzzyIndex#g:method:queryFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [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"), [getMetadata]("GI.Dazzle.Objects.FuzzyIndex#g:method:getMetadata"), [getMetadataString]("GI.Dazzle.Objects.FuzzyIndex#g:method:getMetadataString"), [getMetadataUint32]("GI.Dazzle.Objects.FuzzyIndex#g:method:getMetadataUint32"), [getMetadataUint64]("GI.Dazzle.Objects.FuzzyIndex#g:method:getMetadataUint64"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== 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)
    ResolveFuzzyIndexMethod                 ,
#endif

-- ** getMetadata #method:getMetadata#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexGetMetadataMethodInfo         ,
#endif
    fuzzyIndexGetMetadata                   ,


-- ** getMetadataString #method:getMetadataString#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexGetMetadataStringMethodInfo   ,
#endif
    fuzzyIndexGetMetadataString             ,


-- ** getMetadataUint32 #method:getMetadataUint32#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexGetMetadataUint32MethodInfo   ,
#endif
    fuzzyIndexGetMetadataUint32             ,


-- ** getMetadataUint64 #method:getMetadataUint64#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexGetMetadataUint64MethodInfo   ,
#endif
    fuzzyIndexGetMetadataUint64             ,


-- ** loadFile #method:loadFile#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexLoadFileMethodInfo            ,
#endif
    fuzzyIndexLoadFile                      ,


-- ** loadFileAsync #method:loadFileAsync#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexLoadFileAsyncMethodInfo       ,
#endif
    fuzzyIndexLoadFileAsync                 ,


-- ** loadFileFinish #method:loadFileFinish#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexLoadFileFinishMethodInfo      ,
#endif
    fuzzyIndexLoadFileFinish                ,


-- ** new #method:new#

    fuzzyIndexNew                           ,


-- ** queryAsync #method:queryAsync#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexQueryAsyncMethodInfo          ,
#endif
    fuzzyIndexQueryAsync                    ,


-- ** queryFinish #method:queryFinish#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexQueryFinishMethodInfo         ,
#endif
    fuzzyIndexQueryFinish                   ,




    ) 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.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#endif

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

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

foreign import ccall "dzl_fuzzy_index_get_type"
    c_dzl_fuzzy_index_get_type :: IO B.Types.GType

instance B.Types.TypedObject FuzzyIndex where
    glibType :: IO GType
glibType = IO GType
c_dzl_fuzzy_index_get_type

instance B.Types.GObject FuzzyIndex

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFuzzyIndexMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFuzzyIndexMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFuzzyIndexMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFuzzyIndexMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFuzzyIndexMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFuzzyIndexMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFuzzyIndexMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFuzzyIndexMethod "loadFile" o = FuzzyIndexLoadFileMethodInfo
    ResolveFuzzyIndexMethod "loadFileAsync" o = FuzzyIndexLoadFileAsyncMethodInfo
    ResolveFuzzyIndexMethod "loadFileFinish" o = FuzzyIndexLoadFileFinishMethodInfo
    ResolveFuzzyIndexMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFuzzyIndexMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFuzzyIndexMethod "queryAsync" o = FuzzyIndexQueryAsyncMethodInfo
    ResolveFuzzyIndexMethod "queryFinish" o = FuzzyIndexQueryFinishMethodInfo
    ResolveFuzzyIndexMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFuzzyIndexMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFuzzyIndexMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFuzzyIndexMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFuzzyIndexMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFuzzyIndexMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFuzzyIndexMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFuzzyIndexMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFuzzyIndexMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFuzzyIndexMethod "getMetadata" o = FuzzyIndexGetMetadataMethodInfo
    ResolveFuzzyIndexMethod "getMetadataString" o = FuzzyIndexGetMetadataStringMethodInfo
    ResolveFuzzyIndexMethod "getMetadataUint32" o = FuzzyIndexGetMetadataUint32MethodInfo
    ResolveFuzzyIndexMethod "getMetadataUint64" o = FuzzyIndexGetMetadataUint64MethodInfo
    ResolveFuzzyIndexMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFuzzyIndexMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFuzzyIndexMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFuzzyIndexMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFuzzyIndexMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFuzzyIndexMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "dzl_fuzzy_index_new" dzl_fuzzy_index_new :: 
    IO (Ptr FuzzyIndex)

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

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "dzl_fuzzy_index_get_metadata" dzl_fuzzy_index_get_metadata :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    CString ->                              -- key : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Looks up the metadata for /@key@/.
fuzzyIndexGetMetadata ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a) =>
    a
    -> T.Text
    -> m (Maybe GVariant)
    -- ^ __Returns:__ A t'GVariant' or 'P.Nothing'.
fuzzyIndexGetMetadata :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndex a) =>
a -> Text -> m (Maybe GVariant)
fuzzyIndexGetMetadata a
self Text
key = IO (Maybe GVariant) -> m (Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr GVariant
result <- Ptr FuzzyIndex -> CString -> IO (Ptr GVariant)
dzl_fuzzy_index_get_metadata Ptr FuzzyIndex
self' CString
key'
    Maybe GVariant
maybeResult <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
result ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \Ptr GVariant
result' -> do
        GVariant
result'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result'
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Maybe GVariant -> IO (Maybe GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GVariant
maybeResult

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexGetMetadataMethodInfo
instance (signature ~ (T.Text -> m (Maybe GVariant)), MonadIO m, IsFuzzyIndex a) => O.OverloadedMethod FuzzyIndexGetMetadataMethodInfo a signature where
    overloadedMethod = fuzzyIndexGetMetadata

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


#endif

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

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

-- | /No description available in the introspection data./
fuzzyIndexGetMetadataString ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a) =>
    a
    -> T.Text
    -> m T.Text
fuzzyIndexGetMetadataString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndex a) =>
a -> Text -> m Text
fuzzyIndexGetMetadataString a
self Text
key = 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 FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
result <- Ptr FuzzyIndex -> CString -> IO CString
dzl_fuzzy_index_get_metadata_string Ptr FuzzyIndex
self' CString
key'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fuzzyIndexGetMetadataString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

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


#endif

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

foreign import ccall "dzl_fuzzy_index_get_metadata_uint32" dzl_fuzzy_index_get_metadata_uint32 :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    CString ->                              -- key : TBasicType TUTF8
    IO Word32

-- | /No description available in the introspection data./
fuzzyIndexGetMetadataUint32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a) =>
    a
    -> T.Text
    -> m Word32
fuzzyIndexGetMetadataUint32 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndex a) =>
a -> Text -> m Word32
fuzzyIndexGetMetadataUint32 a
self Text
key = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Word32
result <- Ptr FuzzyIndex -> CString -> IO Word32
dzl_fuzzy_index_get_metadata_uint32 Ptr FuzzyIndex
self' CString
key'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexGetMetadataUint32MethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsFuzzyIndex a) => O.OverloadedMethod FuzzyIndexGetMetadataUint32MethodInfo a signature where
    overloadedMethod = fuzzyIndexGetMetadataUint32

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


#endif

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

foreign import ccall "dzl_fuzzy_index_get_metadata_uint64" dzl_fuzzy_index_get_metadata_uint64 :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    CString ->                              -- key : TBasicType TUTF8
    IO Word64

-- | /No description available in the introspection data./
fuzzyIndexGetMetadataUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a) =>
    a
    -> T.Text
    -> m Word64
fuzzyIndexGetMetadataUint64 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndex a) =>
a -> Text -> m Word64
fuzzyIndexGetMetadataUint64 a
self Text
key = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    Word64
result <- Ptr FuzzyIndex -> CString -> IO Word64
dzl_fuzzy_index_get_metadata_uint64 Ptr FuzzyIndex
self' CString
key'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexGetMetadataUint64MethodInfo
instance (signature ~ (T.Text -> m Word64), MonadIO m, IsFuzzyIndex a) => O.OverloadedMethod FuzzyIndexGetMetadataUint64MethodInfo a signature where
    overloadedMethod = fuzzyIndexGetMetadataUint64

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


#endif

-- method FuzzyIndex::load_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_fuzzy_index_load_file" dzl_fuzzy_index_load_file :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
fuzzyIndexLoadFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fuzzyIndexLoadFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFuzzyIndex a, IsFile b,
 IsCancellable c) =>
a -> b -> Maybe c -> m ()
fuzzyIndexLoadFile a
self b
file Maybe c
cancellable = 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 FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    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'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr FuzzyIndex
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_fuzzy_index_load_file Ptr FuzzyIndex
self' Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
        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 ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexLoadFileMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsFuzzyIndex a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FuzzyIndexLoadFileMethodInfo a signature where
    overloadedMethod = fuzzyIndexLoadFile

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


#endif

-- method FuzzyIndex::load_file_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_fuzzy_index_load_file_async" dzl_fuzzy_index_load_file_async :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    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 ()

-- | /No description available in the introspection data./
fuzzyIndexLoadFileAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -> m ()
fuzzyIndexLoadFileAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFuzzyIndex a, IsFile b,
 IsCancellable c) =>
a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fuzzyIndexLoadFileAsync a
self b
file 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 FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    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 FuzzyIndex
-> Ptr File
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
dzl_fuzzy_index_load_file_async Ptr FuzzyIndex
self' Ptr File
file' 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
file
    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 FuzzyIndexLoadFileAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFuzzyIndex a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FuzzyIndexLoadFileAsyncMethodInfo a signature where
    overloadedMethod = fuzzyIndexLoadFileAsync

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


#endif

-- method FuzzyIndex::load_file_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_fuzzy_index_load_file_finish" dzl_fuzzy_index_load_file_finish :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
fuzzyIndexLoadFileFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -> b
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fuzzyIndexLoadFileFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFuzzyIndex a, IsAsyncResult b) =>
a -> b -> m ()
fuzzyIndexLoadFileFinish a
self b
result_ = 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 FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
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 () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr FuzzyIndex -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
dzl_fuzzy_index_load_file_finish Ptr FuzzyIndex
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexLoadFileFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFuzzyIndex a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FuzzyIndexLoadFileFinishMethodInfo a signature where
    overloadedMethod = fuzzyIndexLoadFileFinish

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


#endif

-- method FuzzyIndex::query_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_matches"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_fuzzy_index_query_async" dzl_fuzzy_index_query_async :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    CString ->                              -- query : TBasicType TUTF8
    Word32 ->                               -- max_matches : TBasicType TUInt
    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 ()

-- | /No description available in the introspection data./
fuzzyIndexQueryAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a, Gio.Cancellable.IsCancellable b) =>
    a
    -> T.Text
    -> Word32
    -> Maybe (b)
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -> m ()
fuzzyIndexQueryAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFuzzyIndex a, IsCancellable b) =>
a -> Text -> Word32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fuzzyIndexQueryAsync a
self Text
query Word32
maxMatches Maybe b
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 FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
query' <- Text -> IO CString
textToCString Text
query
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
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 b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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 FuzzyIndex
-> CString
-> Word32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
dzl_fuzzy_index_query_async Ptr FuzzyIndex
self' CString
query' Word32
maxMatches Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
query'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexQueryAsyncMethodInfo
instance (signature ~ (T.Text -> Word32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFuzzyIndex a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FuzzyIndexQueryAsyncMethodInfo a signature where
    overloadedMethod = fuzzyIndexQueryAsync

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


#endif

-- method FuzzyIndex::query_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 "dzl_fuzzy_index_query_finish" dzl_fuzzy_index_query_finish :: 
    Ptr FuzzyIndex ->                       -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndex"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.ListModel.ListModel)

-- | Completes an asynchronous request to 'GI.Dazzle.Objects.FuzzyIndex.fuzzyIndexQueryAsync'.
fuzzyIndexQueryFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndex a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -> b
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ A t'GI.Gio.Interfaces.ListModel.ListModel' of results. /(Can throw 'Data.GI.Base.GError.GError')/
fuzzyIndexQueryFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFuzzyIndex a, IsAsyncResult b) =>
a -> b -> m ListModel
fuzzyIndexQueryFinish 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 FuzzyIndex
self' <- a -> IO (Ptr FuzzyIndex)
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 FuzzyIndex
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ListModel)
dzl_fuzzy_index_query_finish Ptr FuzzyIndex
self' Ptr AsyncResult
result_'
        Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fuzzyIndexQueryFinish" 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 FuzzyIndexQueryFinishMethodInfo
instance (signature ~ (b -> m Gio.ListModel.ListModel), MonadIO m, IsFuzzyIndex a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FuzzyIndexQueryFinishMethodInfo a signature where
    overloadedMethod = fuzzyIndexQueryFinish

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


#endif