{-# 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.FuzzyIndexMatch
    ( 

-- * Exported types
    FuzzyIndexMatch(..)                     ,
    IsFuzzyIndexMatch                       ,
    toFuzzyIndexMatch                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [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"), [getDocument]("GI.Dazzle.Objects.FuzzyIndexMatch#g:method:getDocument"), [getKey]("GI.Dazzle.Objects.FuzzyIndexMatch#g:method:getKey"), [getPriority]("GI.Dazzle.Objects.FuzzyIndexMatch#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScore]("GI.Dazzle.Objects.FuzzyIndexMatch#g:method:getScore").
-- 
-- ==== 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)
    ResolveFuzzyIndexMatchMethod            ,
#endif

-- ** getDocument #method:getDocument#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchGetDocumentMethodInfo    ,
#endif
    fuzzyIndexMatchGetDocument              ,


-- ** getKey #method:getKey#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchGetKeyMethodInfo         ,
#endif
    fuzzyIndexMatchGetKey                   ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchGetPriorityMethodInfo    ,
#endif
    fuzzyIndexMatchGetPriority              ,


-- ** getScore #method:getScore#

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchGetScoreMethodInfo       ,
#endif
    fuzzyIndexMatchGetScore                 ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchDocumentPropertyInfo     ,
#endif
    constructFuzzyIndexMatchDocument        ,
#if defined(ENABLE_OVERLOADING)
    fuzzyIndexMatchDocument                 ,
#endif
    getFuzzyIndexMatchDocument              ,


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

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchKeyPropertyInfo          ,
#endif
    constructFuzzyIndexMatchKey             ,
#if defined(ENABLE_OVERLOADING)
    fuzzyIndexMatchKey                      ,
#endif
    getFuzzyIndexMatchKey                   ,


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

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchPriorityPropertyInfo     ,
#endif
    constructFuzzyIndexMatchPriority        ,
#if defined(ENABLE_OVERLOADING)
    fuzzyIndexMatchPriority                 ,
#endif
    getFuzzyIndexMatchPriority              ,


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

#if defined(ENABLE_OVERLOADING)
    FuzzyIndexMatchScorePropertyInfo        ,
#endif
    constructFuzzyIndexMatchScore           ,
#if defined(ENABLE_OVERLOADING)
    fuzzyIndexMatchScore                    ,
#endif
    getFuzzyIndexMatchScore                 ,




    ) 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 GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "dzl_fuzzy_index_match_get_type"
    c_dzl_fuzzy_index_match_get_type :: IO B.Types.GType

instance B.Types.TypedObject FuzzyIndexMatch where
    glibType :: IO GType
glibType = IO GType
c_dzl_fuzzy_index_match_get_type

instance B.Types.GObject FuzzyIndexMatch

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFuzzyIndexMatchMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFuzzyIndexMatchMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFuzzyIndexMatchMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFuzzyIndexMatchMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFuzzyIndexMatchMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFuzzyIndexMatchMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFuzzyIndexMatchMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFuzzyIndexMatchMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFuzzyIndexMatchMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFuzzyIndexMatchMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFuzzyIndexMatchMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFuzzyIndexMatchMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFuzzyIndexMatchMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFuzzyIndexMatchMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFuzzyIndexMatchMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFuzzyIndexMatchMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFuzzyIndexMatchMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFuzzyIndexMatchMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFuzzyIndexMatchMethod "getDocument" o = FuzzyIndexMatchGetDocumentMethodInfo
    ResolveFuzzyIndexMatchMethod "getKey" o = FuzzyIndexMatchGetKeyMethodInfo
    ResolveFuzzyIndexMatchMethod "getPriority" o = FuzzyIndexMatchGetPriorityMethodInfo
    ResolveFuzzyIndexMatchMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFuzzyIndexMatchMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFuzzyIndexMatchMethod "getScore" o = FuzzyIndexMatchGetScoreMethodInfo
    ResolveFuzzyIndexMatchMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFuzzyIndexMatchMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFuzzyIndexMatchMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFuzzyIndexMatchMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "document"
   -- Type: TVariant
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@document@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' fuzzyIndexMatch #document
-- @
getFuzzyIndexMatchDocument :: (MonadIO m, IsFuzzyIndexMatch o) => o -> m GVariant
getFuzzyIndexMatchDocument :: forall (m :: * -> *) o.
(MonadIO m, IsFuzzyIndexMatch o) =>
o -> m GVariant
getFuzzyIndexMatchDocument o
obj = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe GVariant) -> IO GVariant
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getFuzzyIndexMatchDocument" (IO (Maybe GVariant) -> IO GVariant)
-> IO (Maybe GVariant) -> IO GVariant
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe GVariant)
forall a. GObject a => a -> String -> IO (Maybe GVariant)
B.Properties.getObjectPropertyVariant o
obj String
"document"

-- | Construct a `GValueConstruct` with valid value for the “@document@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFuzzyIndexMatchDocument :: (IsFuzzyIndexMatch o, MIO.MonadIO m) => GVariant -> m (GValueConstruct o)
constructFuzzyIndexMatchDocument :: forall o (m :: * -> *).
(IsFuzzyIndexMatch o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructFuzzyIndexMatchDocument GVariant
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant String
"document" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
P.Just GVariant
val)

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchDocumentPropertyInfo
instance AttrInfo FuzzyIndexMatchDocumentPropertyInfo where
    type AttrAllowedOps FuzzyIndexMatchDocumentPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FuzzyIndexMatchDocumentPropertyInfo = IsFuzzyIndexMatch
    type AttrSetTypeConstraint FuzzyIndexMatchDocumentPropertyInfo = (~) GVariant
    type AttrTransferTypeConstraint FuzzyIndexMatchDocumentPropertyInfo = (~) GVariant
    type AttrTransferType FuzzyIndexMatchDocumentPropertyInfo = GVariant
    type AttrGetType FuzzyIndexMatchDocumentPropertyInfo = GVariant
    type AttrLabel FuzzyIndexMatchDocumentPropertyInfo = "document"
    type AttrOrigin FuzzyIndexMatchDocumentPropertyInfo = FuzzyIndexMatch
    attrGet = getFuzzyIndexMatchDocument
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFuzzyIndexMatchDocument
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexMatch.document"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.1/docs/GI-Dazzle-Objects-FuzzyIndexMatch.html#g:attr:document"
        })
#endif

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

-- | Get the value of the “@key@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' fuzzyIndexMatch #key
-- @
getFuzzyIndexMatchKey :: (MonadIO m, IsFuzzyIndexMatch o) => o -> m T.Text
getFuzzyIndexMatchKey :: forall (m :: * -> *) o.
(MonadIO m, IsFuzzyIndexMatch o) =>
o -> m Text
getFuzzyIndexMatchKey o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getFuzzyIndexMatchKey" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"key"

-- | Construct a `GValueConstruct` with valid value for the “@key@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFuzzyIndexMatchKey :: (IsFuzzyIndexMatch o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructFuzzyIndexMatchKey :: forall o (m :: * -> *).
(IsFuzzyIndexMatch o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructFuzzyIndexMatchKey Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"key" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

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

-- VVV Prop "priority"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFuzzyIndexMatchPriority :: (IsFuzzyIndexMatch o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructFuzzyIndexMatchPriority :: forall o (m :: * -> *).
(IsFuzzyIndexMatch o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructFuzzyIndexMatchPriority Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"priority" Word32
val

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchPriorityPropertyInfo
instance AttrInfo FuzzyIndexMatchPriorityPropertyInfo where
    type AttrAllowedOps FuzzyIndexMatchPriorityPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FuzzyIndexMatchPriorityPropertyInfo = IsFuzzyIndexMatch
    type AttrSetTypeConstraint FuzzyIndexMatchPriorityPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint FuzzyIndexMatchPriorityPropertyInfo = (~) Word32
    type AttrTransferType FuzzyIndexMatchPriorityPropertyInfo = Word32
    type AttrGetType FuzzyIndexMatchPriorityPropertyInfo = Word32
    type AttrLabel FuzzyIndexMatchPriorityPropertyInfo = "priority"
    type AttrOrigin FuzzyIndexMatchPriorityPropertyInfo = FuzzyIndexMatch
    attrGet = getFuzzyIndexMatchPriority
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFuzzyIndexMatchPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexMatch.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.1/docs/GI-Dazzle-Objects-FuzzyIndexMatch.html#g:attr:priority"
        })
#endif

-- VVV Prop "score"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@score@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFuzzyIndexMatchScore :: (IsFuzzyIndexMatch o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructFuzzyIndexMatchScore :: forall o (m :: * -> *).
(IsFuzzyIndexMatch o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructFuzzyIndexMatchScore Float
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"score" Float
val

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchScorePropertyInfo
instance AttrInfo FuzzyIndexMatchScorePropertyInfo where
    type AttrAllowedOps FuzzyIndexMatchScorePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FuzzyIndexMatchScorePropertyInfo = IsFuzzyIndexMatch
    type AttrSetTypeConstraint FuzzyIndexMatchScorePropertyInfo = (~) Float
    type AttrTransferTypeConstraint FuzzyIndexMatchScorePropertyInfo = (~) Float
    type AttrTransferType FuzzyIndexMatchScorePropertyInfo = Float
    type AttrGetType FuzzyIndexMatchScorePropertyInfo = Float
    type AttrLabel FuzzyIndexMatchScorePropertyInfo = "score"
    type AttrOrigin FuzzyIndexMatchScorePropertyInfo = FuzzyIndexMatch
    attrGet = getFuzzyIndexMatchScore
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructFuzzyIndexMatchScore
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexMatch.score"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.1/docs/GI-Dazzle-Objects-FuzzyIndexMatch.html#g:attr:score"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FuzzyIndexMatch
type instance O.AttributeList FuzzyIndexMatch = FuzzyIndexMatchAttributeList
type FuzzyIndexMatchAttributeList = ('[ '("document", FuzzyIndexMatchDocumentPropertyInfo), '("key", FuzzyIndexMatchKeyPropertyInfo), '("priority", FuzzyIndexMatchPriorityPropertyInfo), '("score", FuzzyIndexMatchScorePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
fuzzyIndexMatchDocument :: AttrLabelProxy "document"
fuzzyIndexMatchDocument = AttrLabelProxy

fuzzyIndexMatchKey :: AttrLabelProxy "key"
fuzzyIndexMatchKey = AttrLabelProxy

fuzzyIndexMatchPriority :: AttrLabelProxy "priority"
fuzzyIndexMatchPriority = AttrLabelProxy

fuzzyIndexMatchScore :: AttrLabelProxy "score"
fuzzyIndexMatchScore = AttrLabelProxy

#endif

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

#endif

-- method FuzzyIndexMatch::get_document
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndexMatch" }
--           , 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_match_get_document" dzl_fuzzy_index_match_get_document :: 
    Ptr FuzzyIndexMatch ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndexMatch"})
    IO (Ptr GVariant)

-- | /No description available in the introspection data./
fuzzyIndexMatchGetDocument ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
    a
    -> m GVariant
    -- ^ __Returns:__ A t'GVariant'.
fuzzyIndexMatchGetDocument :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
a -> m GVariant
fuzzyIndexMatchGetDocument a
self = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr FuzzyIndexMatch
self' <- a -> IO (Ptr FuzzyIndexMatch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GVariant
result <- Ptr FuzzyIndexMatch -> IO (Ptr GVariant)
dzl_fuzzy_index_match_get_document Ptr FuzzyIndexMatch
self'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fuzzyIndexMatchGetDocument" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchGetDocumentMethodInfo
instance (signature ~ (m GVariant), MonadIO m, IsFuzzyIndexMatch a) => O.OverloadedMethod FuzzyIndexMatchGetDocumentMethodInfo a signature where
    overloadedMethod = fuzzyIndexMatchGetDocument

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


#endif

-- method FuzzyIndexMatch::get_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndexMatch" }
--           , 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_match_get_key" dzl_fuzzy_index_match_get_key :: 
    Ptr FuzzyIndexMatch ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndexMatch"})
    IO CString

-- | /No description available in the introspection data./
fuzzyIndexMatchGetKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
    a
    -> m T.Text
fuzzyIndexMatchGetKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
a -> m Text
fuzzyIndexMatchGetKey a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FuzzyIndexMatch
self' <- a -> IO (Ptr FuzzyIndexMatch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr FuzzyIndexMatch -> IO CString
dzl_fuzzy_index_match_get_key Ptr FuzzyIndexMatch
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fuzzyIndexMatchGetKey" 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
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchGetKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFuzzyIndexMatch a) => O.OverloadedMethod FuzzyIndexMatchGetKeyMethodInfo a signature where
    overloadedMethod = fuzzyIndexMatchGetKey

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


#endif

-- method FuzzyIndexMatch::get_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndexMatch" }
--           , 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 TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_fuzzy_index_match_get_priority" dzl_fuzzy_index_match_get_priority :: 
    Ptr FuzzyIndexMatch ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndexMatch"})
    IO Word32

-- | /No description available in the introspection data./
fuzzyIndexMatchGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
    a
    -> m Word32
fuzzyIndexMatchGetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
a -> m Word32
fuzzyIndexMatchGetPriority a
self = 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 FuzzyIndexMatch
self' <- a -> IO (Ptr FuzzyIndexMatch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr FuzzyIndexMatch -> IO Word32
dzl_fuzzy_index_match_get_priority Ptr FuzzyIndexMatch
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchGetPriorityMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsFuzzyIndexMatch a) => O.OverloadedMethod FuzzyIndexMatchGetPriorityMethodInfo a signature where
    overloadedMethod = fuzzyIndexMatchGetPriority

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


#endif

-- method FuzzyIndexMatch::get_score
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "FuzzyIndexMatch" }
--           , 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 TFloat)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_fuzzy_index_match_get_score" dzl_fuzzy_index_match_get_score :: 
    Ptr FuzzyIndexMatch ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "FuzzyIndexMatch"})
    IO CFloat

-- | /No description available in the introspection data./
fuzzyIndexMatchGetScore ::
    (B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
    a
    -> m Float
fuzzyIndexMatchGetScore :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndexMatch a) =>
a -> m Float
fuzzyIndexMatchGetScore a
self = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr FuzzyIndexMatch
self' <- a -> IO (Ptr FuzzyIndexMatch)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CFloat
result <- Ptr FuzzyIndexMatch -> IO CFloat
dzl_fuzzy_index_match_get_score Ptr FuzzyIndexMatch
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data FuzzyIndexMatchGetScoreMethodInfo
instance (signature ~ (m Float), MonadIO m, IsFuzzyIndexMatch a) => O.OverloadedMethod FuzzyIndexMatchGetScoreMethodInfo a signature where
    overloadedMethod = fuzzyIndexMatchGetScore

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


#endif