{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Dazzle.Objects.FuzzyIndexCursor
(
FuzzyIndexCursor(..) ,
IsFuzzyIndexCursor ,
toFuzzyIndexCursor ,
#if defined(ENABLE_OVERLOADING)
ResolveFuzzyIndexCursorMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
FuzzyIndexCursorGetIndexMethodInfo ,
#endif
fuzzyIndexCursorGetIndex ,
#if defined(ENABLE_OVERLOADING)
FuzzyIndexCursorCaseSensitivePropertyInfo,
#endif
constructFuzzyIndexCursorCaseSensitive ,
#if defined(ENABLE_OVERLOADING)
fuzzyIndexCursorCaseSensitive ,
#endif
getFuzzyIndexCursorCaseSensitive ,
#if defined(ENABLE_OVERLOADING)
FuzzyIndexCursorIndexPropertyInfo ,
#endif
constructFuzzyIndexCursorIndex ,
#if defined(ENABLE_OVERLOADING)
fuzzyIndexCursorIndex ,
#endif
#if defined(ENABLE_OVERLOADING)
FuzzyIndexCursorMaxMatchesPropertyInfo ,
#endif
constructFuzzyIndexCursorMaxMatches ,
#if defined(ENABLE_OVERLOADING)
fuzzyIndexCursorMaxMatches ,
#endif
getFuzzyIndexCursorMaxMatches ,
#if defined(ENABLE_OVERLOADING)
FuzzyIndexCursorQueryPropertyInfo ,
#endif
constructFuzzyIndexCursorQuery ,
#if defined(ENABLE_OVERLOADING)
fuzzyIndexCursorQuery ,
#endif
getFuzzyIndexCursorQuery ,
#if defined(ENABLE_OVERLOADING)
FuzzyIndexCursorTablesPropertyInfo ,
#endif
constructFuzzyIndexCursorTables ,
#if defined(ENABLE_OVERLOADING)
fuzzyIndexCursorTables ,
#endif
) 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
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Dazzle.Objects.FuzzyIndex as Dazzle.FuzzyIndex
import qualified GI.GLib.Structs.VariantDict as GLib.VariantDict
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
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 {-# SOURCE #-} qualified GI.Dazzle.Objects.FuzzyIndex as Dazzle.FuzzyIndex
import qualified GI.GLib.Structs.VariantDict as GLib.VariantDict
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
#endif
newtype FuzzyIndexCursor = FuzzyIndexCursor (SP.ManagedPtr FuzzyIndexCursor)
deriving (FuzzyIndexCursor -> FuzzyIndexCursor -> Bool
(FuzzyIndexCursor -> FuzzyIndexCursor -> Bool)
-> (FuzzyIndexCursor -> FuzzyIndexCursor -> Bool)
-> Eq FuzzyIndexCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FuzzyIndexCursor -> FuzzyIndexCursor -> Bool
== :: FuzzyIndexCursor -> FuzzyIndexCursor -> Bool
$c/= :: FuzzyIndexCursor -> FuzzyIndexCursor -> Bool
/= :: FuzzyIndexCursor -> FuzzyIndexCursor -> Bool
Eq)
instance SP.ManagedPtrNewtype FuzzyIndexCursor where
toManagedPtr :: FuzzyIndexCursor -> ManagedPtr FuzzyIndexCursor
toManagedPtr (FuzzyIndexCursor ManagedPtr FuzzyIndexCursor
p) = ManagedPtr FuzzyIndexCursor
p
foreign import ccall "dzl_fuzzy_index_cursor_get_type"
c_dzl_fuzzy_index_cursor_get_type :: IO B.Types.GType
instance B.Types.TypedObject FuzzyIndexCursor where
glibType :: IO GType
glibType = IO GType
c_dzl_fuzzy_index_cursor_get_type
instance B.Types.GObject FuzzyIndexCursor
class (SP.GObject o, O.IsDescendantOf FuzzyIndexCursor o) => IsFuzzyIndexCursor o
instance (SP.GObject o, O.IsDescendantOf FuzzyIndexCursor o) => IsFuzzyIndexCursor o
instance O.HasParentTypes FuzzyIndexCursor
type instance O.ParentTypes FuzzyIndexCursor = '[GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.ListModel.ListModel]
toFuzzyIndexCursor :: (MIO.MonadIO m, IsFuzzyIndexCursor o) => o -> m FuzzyIndexCursor
toFuzzyIndexCursor :: forall (m :: * -> *) o.
(MonadIO m, IsFuzzyIndexCursor o) =>
o -> m FuzzyIndexCursor
toFuzzyIndexCursor = IO FuzzyIndexCursor -> m FuzzyIndexCursor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO FuzzyIndexCursor -> m FuzzyIndexCursor)
-> (o -> IO FuzzyIndexCursor) -> o -> m FuzzyIndexCursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr FuzzyIndexCursor -> FuzzyIndexCursor)
-> o -> IO FuzzyIndexCursor
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr FuzzyIndexCursor -> FuzzyIndexCursor
FuzzyIndexCursor
instance B.GValue.IsGValue (Maybe FuzzyIndexCursor) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_fuzzy_index_cursor_get_type
gvalueSet_ :: Ptr GValue -> Maybe FuzzyIndexCursor -> IO ()
gvalueSet_ Ptr GValue
gv Maybe FuzzyIndexCursor
P.Nothing = Ptr GValue -> Ptr FuzzyIndexCursor -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr FuzzyIndexCursor
forall a. Ptr a
FP.nullPtr :: FP.Ptr FuzzyIndexCursor)
gvalueSet_ Ptr GValue
gv (P.Just FuzzyIndexCursor
obj) = FuzzyIndexCursor -> (Ptr FuzzyIndexCursor -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FuzzyIndexCursor
obj (Ptr GValue -> Ptr FuzzyIndexCursor -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe FuzzyIndexCursor)
gvalueGet_ Ptr GValue
gv = do
Ptr FuzzyIndexCursor
ptr <- Ptr GValue -> IO (Ptr FuzzyIndexCursor)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr FuzzyIndexCursor)
if Ptr FuzzyIndexCursor
ptr Ptr FuzzyIndexCursor -> Ptr FuzzyIndexCursor -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr FuzzyIndexCursor
forall a. Ptr a
FP.nullPtr
then FuzzyIndexCursor -> Maybe FuzzyIndexCursor
forall a. a -> Maybe a
P.Just (FuzzyIndexCursor -> Maybe FuzzyIndexCursor)
-> IO FuzzyIndexCursor -> IO (Maybe FuzzyIndexCursor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr FuzzyIndexCursor -> FuzzyIndexCursor)
-> Ptr FuzzyIndexCursor -> IO FuzzyIndexCursor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr FuzzyIndexCursor -> FuzzyIndexCursor
FuzzyIndexCursor Ptr FuzzyIndexCursor
ptr
else Maybe FuzzyIndexCursor -> IO (Maybe FuzzyIndexCursor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FuzzyIndexCursor
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveFuzzyIndexCursorMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveFuzzyIndexCursorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveFuzzyIndexCursorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveFuzzyIndexCursorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveFuzzyIndexCursorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveFuzzyIndexCursorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveFuzzyIndexCursorMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
ResolveFuzzyIndexCursorMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
ResolveFuzzyIndexCursorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveFuzzyIndexCursorMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
ResolveFuzzyIndexCursorMethod "newFinish" o = Gio.AsyncInitable.AsyncInitableNewFinishMethodInfo
ResolveFuzzyIndexCursorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveFuzzyIndexCursorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveFuzzyIndexCursorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveFuzzyIndexCursorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveFuzzyIndexCursorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveFuzzyIndexCursorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveFuzzyIndexCursorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveFuzzyIndexCursorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveFuzzyIndexCursorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveFuzzyIndexCursorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveFuzzyIndexCursorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveFuzzyIndexCursorMethod "getIndex" o = FuzzyIndexCursorGetIndexMethodInfo
ResolveFuzzyIndexCursorMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
ResolveFuzzyIndexCursorMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
ResolveFuzzyIndexCursorMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
ResolveFuzzyIndexCursorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveFuzzyIndexCursorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveFuzzyIndexCursorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveFuzzyIndexCursorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveFuzzyIndexCursorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveFuzzyIndexCursorMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveFuzzyIndexCursorMethod t FuzzyIndexCursor, O.OverloadedMethod info FuzzyIndexCursor p) => OL.IsLabel t (FuzzyIndexCursor -> 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 ~ ResolveFuzzyIndexCursorMethod t FuzzyIndexCursor, O.OverloadedMethod info FuzzyIndexCursor p, R.HasField t FuzzyIndexCursor p) => R.HasField t FuzzyIndexCursor p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveFuzzyIndexCursorMethod t FuzzyIndexCursor, O.OverloadedMethodInfo info FuzzyIndexCursor) => OL.IsLabel t (O.MethodProxy info FuzzyIndexCursor) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getFuzzyIndexCursorCaseSensitive :: (MonadIO m, IsFuzzyIndexCursor o) => o -> m Bool
getFuzzyIndexCursorCaseSensitive :: forall (m :: * -> *) o.
(MonadIO m, IsFuzzyIndexCursor o) =>
o -> m Bool
getFuzzyIndexCursorCaseSensitive o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"case-sensitive"
constructFuzzyIndexCursorCaseSensitive :: (IsFuzzyIndexCursor o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructFuzzyIndexCursorCaseSensitive :: forall o (m :: * -> *).
(IsFuzzyIndexCursor o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructFuzzyIndexCursorCaseSensitive Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"case-sensitive" Bool
val
#if defined(ENABLE_OVERLOADING)
data FuzzyIndexCursorCaseSensitivePropertyInfo
instance AttrInfo FuzzyIndexCursorCaseSensitivePropertyInfo where
type AttrAllowedOps FuzzyIndexCursorCaseSensitivePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint FuzzyIndexCursorCaseSensitivePropertyInfo = IsFuzzyIndexCursor
type AttrSetTypeConstraint FuzzyIndexCursorCaseSensitivePropertyInfo = (~) Bool
type AttrTransferTypeConstraint FuzzyIndexCursorCaseSensitivePropertyInfo = (~) Bool
type AttrTransferType FuzzyIndexCursorCaseSensitivePropertyInfo = Bool
type AttrGetType FuzzyIndexCursorCaseSensitivePropertyInfo = Bool
type AttrLabel FuzzyIndexCursorCaseSensitivePropertyInfo = "case-sensitive"
type AttrOrigin FuzzyIndexCursorCaseSensitivePropertyInfo = FuzzyIndexCursor
attrGet = getFuzzyIndexCursorCaseSensitive
attrSet = undefined
attrTransfer _ v = do
return v
attrConstruct = constructFuzzyIndexCursorCaseSensitive
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexCursor.caseSensitive"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-FuzzyIndexCursor.html#g:attr:caseSensitive"
})
#endif
constructFuzzyIndexCursorIndex :: (IsFuzzyIndexCursor o, MIO.MonadIO m, Dazzle.FuzzyIndex.IsFuzzyIndex a) => a -> m (GValueConstruct o)
constructFuzzyIndexCursorIndex :: forall o (m :: * -> *) a.
(IsFuzzyIndexCursor o, MonadIO m, IsFuzzyIndex a) =>
a -> m (GValueConstruct o)
constructFuzzyIndexCursorIndex a
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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"index" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data FuzzyIndexCursorIndexPropertyInfo
instance AttrInfo FuzzyIndexCursorIndexPropertyInfo where
type AttrAllowedOps FuzzyIndexCursorIndexPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
type AttrBaseTypeConstraint FuzzyIndexCursorIndexPropertyInfo = IsFuzzyIndexCursor
type AttrSetTypeConstraint FuzzyIndexCursorIndexPropertyInfo = Dazzle.FuzzyIndex.IsFuzzyIndex
type AttrTransferTypeConstraint FuzzyIndexCursorIndexPropertyInfo = Dazzle.FuzzyIndex.IsFuzzyIndex
type AttrTransferType FuzzyIndexCursorIndexPropertyInfo = Dazzle.FuzzyIndex.FuzzyIndex
type AttrGetType FuzzyIndexCursorIndexPropertyInfo = ()
type AttrLabel FuzzyIndexCursorIndexPropertyInfo = "index"
type AttrOrigin FuzzyIndexCursorIndexPropertyInfo = FuzzyIndexCursor
attrGet = undefined
attrSet = undefined
attrTransfer _ v = do
unsafeCastTo Dazzle.FuzzyIndex.FuzzyIndex v
attrConstruct = constructFuzzyIndexCursorIndex
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexCursor.index"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-FuzzyIndexCursor.html#g:attr:index"
})
#endif
getFuzzyIndexCursorMaxMatches :: (MonadIO m, IsFuzzyIndexCursor o) => o -> m Word32
getFuzzyIndexCursorMaxMatches :: forall (m :: * -> *) o.
(MonadIO m, IsFuzzyIndexCursor o) =>
o -> m Word32
getFuzzyIndexCursorMaxMatches 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
"max-matches"
constructFuzzyIndexCursorMaxMatches :: (IsFuzzyIndexCursor o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructFuzzyIndexCursorMaxMatches :: forall o (m :: * -> *).
(IsFuzzyIndexCursor o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructFuzzyIndexCursorMaxMatches 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
"max-matches" Word32
val
#if defined(ENABLE_OVERLOADING)
data FuzzyIndexCursorMaxMatchesPropertyInfo
instance AttrInfo FuzzyIndexCursorMaxMatchesPropertyInfo where
type AttrAllowedOps FuzzyIndexCursorMaxMatchesPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint FuzzyIndexCursorMaxMatchesPropertyInfo = IsFuzzyIndexCursor
type AttrSetTypeConstraint FuzzyIndexCursorMaxMatchesPropertyInfo = (~) Word32
type AttrTransferTypeConstraint FuzzyIndexCursorMaxMatchesPropertyInfo = (~) Word32
type AttrTransferType FuzzyIndexCursorMaxMatchesPropertyInfo = Word32
type AttrGetType FuzzyIndexCursorMaxMatchesPropertyInfo = Word32
type AttrLabel FuzzyIndexCursorMaxMatchesPropertyInfo = "max-matches"
type AttrOrigin FuzzyIndexCursorMaxMatchesPropertyInfo = FuzzyIndexCursor
attrGet = getFuzzyIndexCursorMaxMatches
attrSet = undefined
attrTransfer _ v = do
return v
attrConstruct = constructFuzzyIndexCursorMaxMatches
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexCursor.maxMatches"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-FuzzyIndexCursor.html#g:attr:maxMatches"
})
#endif
getFuzzyIndexCursorQuery :: (MonadIO m, IsFuzzyIndexCursor o) => o -> m (Maybe T.Text)
getFuzzyIndexCursorQuery :: forall (m :: * -> *) o.
(MonadIO m, IsFuzzyIndexCursor o) =>
o -> m (Maybe Text)
getFuzzyIndexCursorQuery o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"query"
constructFuzzyIndexCursorQuery :: (IsFuzzyIndexCursor o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructFuzzyIndexCursorQuery :: forall o (m :: * -> *).
(IsFuzzyIndexCursor o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructFuzzyIndexCursorQuery 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
"query" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data FuzzyIndexCursorQueryPropertyInfo
instance AttrInfo FuzzyIndexCursorQueryPropertyInfo where
type AttrAllowedOps FuzzyIndexCursorQueryPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint FuzzyIndexCursorQueryPropertyInfo = IsFuzzyIndexCursor
type AttrSetTypeConstraint FuzzyIndexCursorQueryPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint FuzzyIndexCursorQueryPropertyInfo = (~) T.Text
type AttrTransferType FuzzyIndexCursorQueryPropertyInfo = T.Text
type AttrGetType FuzzyIndexCursorQueryPropertyInfo = (Maybe T.Text)
type AttrLabel FuzzyIndexCursorQueryPropertyInfo = "query"
type AttrOrigin FuzzyIndexCursorQueryPropertyInfo = FuzzyIndexCursor
attrGet = getFuzzyIndexCursorQuery
attrSet = undefined
attrTransfer _ v = do
return v
attrConstruct = constructFuzzyIndexCursorQuery
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexCursor.query"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-FuzzyIndexCursor.html#g:attr:query"
})
#endif
constructFuzzyIndexCursorTables :: (IsFuzzyIndexCursor o, MIO.MonadIO m) => GLib.VariantDict.VariantDict -> m (GValueConstruct o)
constructFuzzyIndexCursorTables :: forall o (m :: * -> *).
(IsFuzzyIndexCursor o, MonadIO m) =>
VariantDict -> m (GValueConstruct o)
constructFuzzyIndexCursorTables VariantDict
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 VariantDict -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"tables" (VariantDict -> Maybe VariantDict
forall a. a -> Maybe a
P.Just VariantDict
val)
#if defined(ENABLE_OVERLOADING)
data FuzzyIndexCursorTablesPropertyInfo
instance AttrInfo FuzzyIndexCursorTablesPropertyInfo where
type AttrAllowedOps FuzzyIndexCursorTablesPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
type AttrBaseTypeConstraint FuzzyIndexCursorTablesPropertyInfo = IsFuzzyIndexCursor
type AttrSetTypeConstraint FuzzyIndexCursorTablesPropertyInfo = (~) GLib.VariantDict.VariantDict
type AttrTransferTypeConstraint FuzzyIndexCursorTablesPropertyInfo = (~) GLib.VariantDict.VariantDict
type AttrTransferType FuzzyIndexCursorTablesPropertyInfo = GLib.VariantDict.VariantDict
type AttrGetType FuzzyIndexCursorTablesPropertyInfo = ()
type AttrLabel FuzzyIndexCursorTablesPropertyInfo = "tables"
type AttrOrigin FuzzyIndexCursorTablesPropertyInfo = FuzzyIndexCursor
attrGet = undefined
attrSet = undefined
attrTransfer _ v = do
return v
attrConstruct = constructFuzzyIndexCursorTables
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexCursor.tables"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-FuzzyIndexCursor.html#g:attr:tables"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FuzzyIndexCursor
type instance O.AttributeList FuzzyIndexCursor = FuzzyIndexCursorAttributeList
type FuzzyIndexCursorAttributeList = ('[ '("caseSensitive", FuzzyIndexCursorCaseSensitivePropertyInfo), '("index", FuzzyIndexCursorIndexPropertyInfo), '("maxMatches", FuzzyIndexCursorMaxMatchesPropertyInfo), '("query", FuzzyIndexCursorQueryPropertyInfo), '("tables", FuzzyIndexCursorTablesPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
fuzzyIndexCursorCaseSensitive :: AttrLabelProxy "caseSensitive"
fuzzyIndexCursorCaseSensitive = AttrLabelProxy
fuzzyIndexCursorIndex :: AttrLabelProxy "index"
fuzzyIndexCursorIndex = AttrLabelProxy
fuzzyIndexCursorMaxMatches :: AttrLabelProxy "maxMatches"
fuzzyIndexCursorMaxMatches = AttrLabelProxy
fuzzyIndexCursorQuery :: AttrLabelProxy "query"
fuzzyIndexCursorQuery = AttrLabelProxy
fuzzyIndexCursorTables :: AttrLabelProxy "tables"
fuzzyIndexCursorTables = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList FuzzyIndexCursor = FuzzyIndexCursorSignalList
type FuzzyIndexCursorSignalList = ('[ '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "dzl_fuzzy_index_cursor_get_index" dzl_fuzzy_index_cursor_get_index ::
Ptr FuzzyIndexCursor ->
IO (Ptr Dazzle.FuzzyIndex.FuzzyIndex)
fuzzyIndexCursorGetIndex ::
(B.CallStack.HasCallStack, MonadIO m, IsFuzzyIndexCursor a) =>
a
-> m Dazzle.FuzzyIndex.FuzzyIndex
fuzzyIndexCursorGetIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFuzzyIndexCursor a) =>
a -> m FuzzyIndex
fuzzyIndexCursorGetIndex a
self = 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 FuzzyIndexCursor
self' <- a -> IO (Ptr FuzzyIndexCursor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr FuzzyIndex
result <- Ptr FuzzyIndexCursor -> IO (Ptr FuzzyIndex)
dzl_fuzzy_index_cursor_get_index Ptr FuzzyIndexCursor
self'
Text -> Ptr FuzzyIndex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fuzzyIndexCursorGetIndex" 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
newObject ManagedPtr FuzzyIndex -> FuzzyIndex
Dazzle.FuzzyIndex.FuzzyIndex) Ptr FuzzyIndex
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
FuzzyIndex -> IO FuzzyIndex
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FuzzyIndex
result'
#if defined(ENABLE_OVERLOADING)
data FuzzyIndexCursorGetIndexMethodInfo
instance (signature ~ (m Dazzle.FuzzyIndex.FuzzyIndex), MonadIO m, IsFuzzyIndexCursor a) => O.OverloadedMethod FuzzyIndexCursorGetIndexMethodInfo a signature where
overloadedMethod = fuzzyIndexCursorGetIndex
instance O.OverloadedMethodInfo FuzzyIndexCursorGetIndexMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.FuzzyIndexCursor.fuzzyIndexCursorGetIndex",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-FuzzyIndexCursor.html#v:fuzzyIndexCursorGetIndex"
})
#endif