{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkStringFilter@ determines whether to include items by comparing
-- strings to a fixed search term.
-- 
-- The strings are obtained from the items by evaluating a @GtkExpression@
-- set with 'GI.Gtk.Objects.StringFilter.stringFilterSetExpression', and they are
-- compared against a search term set with 'GI.Gtk.Objects.StringFilter.stringFilterSetSearch'.
-- 
-- @GtkStringFilter@ has several different modes of comparison - it
-- can match the whole string, just a prefix, or any substring. Use
-- 'GI.Gtk.Objects.StringFilter.stringFilterSetMatchMode' choose a mode.
-- 
-- It is also possible to make case-insensitive comparisons, with
-- 'GI.Gtk.Objects.StringFilter.stringFilterSetIgnoreCase'.

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

module GI.Gtk.Objects.StringFilter
    ( 

-- * Exported types
    StringFilter(..)                        ,
    IsStringFilter                          ,
    toStringFilter                          ,


 -- * 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"), [changed]("GI.Gtk.Objects.Filter#g:method:changed"), [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"), [match]("GI.Gtk.Objects.Filter#g:method:match"), [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"), [getExpression]("GI.Gtk.Objects.StringFilter#g:method:getExpression"), [getIgnoreCase]("GI.Gtk.Objects.StringFilter#g:method:getIgnoreCase"), [getMatchMode]("GI.Gtk.Objects.StringFilter#g:method:getMatchMode"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSearch]("GI.Gtk.Objects.StringFilter#g:method:getSearch"), [getStrictness]("GI.Gtk.Objects.Filter#g:method:getStrictness").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setExpression]("GI.Gtk.Objects.StringFilter#g:method:setExpression"), [setIgnoreCase]("GI.Gtk.Objects.StringFilter#g:method:setIgnoreCase"), [setMatchMode]("GI.Gtk.Objects.StringFilter#g:method:setMatchMode"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSearch]("GI.Gtk.Objects.StringFilter#g:method:setSearch").

#if defined(ENABLE_OVERLOADING)
    ResolveStringFilterMethod               ,
#endif

-- ** getExpression #method:getExpression#

#if defined(ENABLE_OVERLOADING)
    StringFilterGetExpressionMethodInfo     ,
#endif
    stringFilterGetExpression               ,


-- ** getIgnoreCase #method:getIgnoreCase#

#if defined(ENABLE_OVERLOADING)
    StringFilterGetIgnoreCaseMethodInfo     ,
#endif
    stringFilterGetIgnoreCase               ,


-- ** getMatchMode #method:getMatchMode#

#if defined(ENABLE_OVERLOADING)
    StringFilterGetMatchModeMethodInfo      ,
#endif
    stringFilterGetMatchMode                ,


-- ** getSearch #method:getSearch#

#if defined(ENABLE_OVERLOADING)
    StringFilterGetSearchMethodInfo         ,
#endif
    stringFilterGetSearch                   ,


-- ** new #method:new#

    stringFilterNew                         ,


-- ** setExpression #method:setExpression#

#if defined(ENABLE_OVERLOADING)
    StringFilterSetExpressionMethodInfo     ,
#endif
    stringFilterSetExpression               ,


-- ** setIgnoreCase #method:setIgnoreCase#

#if defined(ENABLE_OVERLOADING)
    StringFilterSetIgnoreCaseMethodInfo     ,
#endif
    stringFilterSetIgnoreCase               ,


-- ** setMatchMode #method:setMatchMode#

#if defined(ENABLE_OVERLOADING)
    StringFilterSetMatchModeMethodInfo      ,
#endif
    stringFilterSetMatchMode                ,


-- ** setSearch #method:setSearch#

#if defined(ENABLE_OVERLOADING)
    StringFilterSetSearchMethodInfo         ,
#endif
    stringFilterSetSearch                   ,




 -- * Properties


-- ** expression #attr:expression#
-- | The expression to evaluate on item to get a string to compare with.

#if defined(ENABLE_OVERLOADING)
    StringFilterExpressionPropertyInfo      ,
#endif
    clearStringFilterExpression             ,
    constructStringFilterExpression         ,
    getStringFilterExpression               ,
    setStringFilterExpression               ,
#if defined(ENABLE_OVERLOADING)
    stringFilterExpression                  ,
#endif


-- ** ignoreCase #attr:ignoreCase#
-- | If matching is case sensitive.

#if defined(ENABLE_OVERLOADING)
    StringFilterIgnoreCasePropertyInfo      ,
#endif
    constructStringFilterIgnoreCase         ,
    getStringFilterIgnoreCase               ,
    setStringFilterIgnoreCase               ,
#if defined(ENABLE_OVERLOADING)
    stringFilterIgnoreCase                  ,
#endif


-- ** matchMode #attr:matchMode#
-- | If exact matches are necessary or if substrings are allowed.

#if defined(ENABLE_OVERLOADING)
    StringFilterMatchModePropertyInfo       ,
#endif
    constructStringFilterMatchMode          ,
    getStringFilterMatchMode                ,
    setStringFilterMatchMode                ,
#if defined(ENABLE_OVERLOADING)
    stringFilterMatchMode                   ,
#endif


-- ** search #attr:search#
-- | The search term.

#if defined(ENABLE_OVERLOADING)
    StringFilterSearchPropertyInfo          ,
#endif
    clearStringFilterSearch                 ,
    constructStringFilterSearch             ,
    getStringFilterSearch                   ,
    setStringFilterSearch                   ,
#if defined(ENABLE_OVERLOADING)
    stringFilterSearch                      ,
#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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.Expression as Gtk.Expression
import {-# SOURCE #-} qualified GI.Gtk.Objects.Filter as Gtk.Filter

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

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

foreign import ccall "gtk_string_filter_get_type"
    c_gtk_string_filter_get_type :: IO B.Types.GType

instance B.Types.TypedObject StringFilter where
    glibType :: IO GType
glibType = IO GType
c_gtk_string_filter_get_type

instance B.Types.GObject StringFilter

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

instance O.HasParentTypes StringFilter
type instance O.ParentTypes StringFilter = '[Gtk.Filter.Filter, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveStringFilterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveStringFilterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStringFilterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStringFilterMethod "changed" o = Gtk.Filter.FilterChangedMethodInfo
    ResolveStringFilterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStringFilterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStringFilterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStringFilterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStringFilterMethod "match" o = Gtk.Filter.FilterMatchMethodInfo
    ResolveStringFilterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStringFilterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStringFilterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveStringFilterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStringFilterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStringFilterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStringFilterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStringFilterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStringFilterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveStringFilterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStringFilterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStringFilterMethod "getExpression" o = StringFilterGetExpressionMethodInfo
    ResolveStringFilterMethod "getIgnoreCase" o = StringFilterGetIgnoreCaseMethodInfo
    ResolveStringFilterMethod "getMatchMode" o = StringFilterGetMatchModeMethodInfo
    ResolveStringFilterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStringFilterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStringFilterMethod "getSearch" o = StringFilterGetSearchMethodInfo
    ResolveStringFilterMethod "getStrictness" o = Gtk.Filter.FilterGetStrictnessMethodInfo
    ResolveStringFilterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStringFilterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStringFilterMethod "setExpression" o = StringFilterSetExpressionMethodInfo
    ResolveStringFilterMethod "setIgnoreCase" o = StringFilterSetIgnoreCaseMethodInfo
    ResolveStringFilterMethod "setMatchMode" o = StringFilterSetMatchModeMethodInfo
    ResolveStringFilterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStringFilterMethod "setSearch" o = StringFilterSetSearchMethodInfo
    ResolveStringFilterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "expression"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Expression"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@expression@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stringFilter #expression
-- @
getStringFilterExpression :: (MonadIO m, IsStringFilter o) => o -> m (Maybe Gtk.Expression.Expression)
getStringFilterExpression :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> m (Maybe Expression)
getStringFilterExpression o
obj = IO (Maybe Expression) -> m (Maybe Expression)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Expression) -> m (Maybe Expression))
-> IO (Maybe Expression) -> m (Maybe Expression)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Expression)
forall a b. (GObject a, IsGValue b) => a -> String -> IO b
B.Properties.getObjectPropertyIsGValueInstance o
obj String
"expression"

-- | Set the value of the “@expression@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stringFilter [ #expression 'Data.GI.Base.Attributes.:=' value ]
-- @
setStringFilterExpression :: (MonadIO m, IsStringFilter o, Gtk.Expression.IsExpression a) => o -> a -> m ()
setStringFilterExpression :: forall (m :: * -> *) o a.
(MonadIO m, IsStringFilter o, IsExpression a) =>
o -> a -> m ()
setStringFilterExpression o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Expression
val' <- a -> IO Expression
forall (m :: * -> *) o.
(MonadIO m, IsExpression o) =>
o -> m Expression
Gtk.Expression.toExpression a
val
    o -> String -> Maybe Expression -> IO ()
forall a b. (GObject a, IsGValue b) => a -> String -> b -> IO ()
B.Properties.setObjectPropertyIsGValueInstance o
obj String
"expression" (Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
val')

-- | Construct a `GValueConstruct` with valid value for the “@expression@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStringFilterExpression :: (IsStringFilter o, MIO.MonadIO m, Gtk.Expression.IsExpression a) => a -> m (GValueConstruct o)
constructStringFilterExpression :: forall o (m :: * -> *) a.
(IsStringFilter o, MonadIO m, IsExpression a) =>
a -> m (GValueConstruct o)
constructStringFilterExpression 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
    Expression
val' <- a -> IO Expression
forall (m :: * -> *) o.
(MonadIO m, IsExpression o) =>
o -> m Expression
Gtk.Expression.toExpression a
val
    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 Expression -> IO (GValueConstruct o)
forall b o. IsGValue b => String -> b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyIsGValueInstance String
"expression" (Expression -> Maybe Expression
forall a. a -> Maybe a
P.Just Expression
val')

-- | Set the value of the “@expression@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #expression
-- @
clearStringFilterExpression :: (MonadIO m, IsStringFilter o) => o -> m ()
clearStringFilterExpression :: forall (m :: * -> *) o. (MonadIO m, IsStringFilter o) => o -> m ()
clearStringFilterExpression o
obj = 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
$ o -> String -> Maybe Expression -> IO ()
forall a b. (GObject a, IsGValue b) => a -> String -> b -> IO ()
B.Properties.setObjectPropertyIsGValueInstance o
obj String
"expression" (Maybe Expression
forall a. Maybe a
Nothing :: Maybe Gtk.Expression.Expression)

#if defined(ENABLE_OVERLOADING)
data StringFilterExpressionPropertyInfo
instance AttrInfo StringFilterExpressionPropertyInfo where
    type AttrAllowedOps StringFilterExpressionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StringFilterExpressionPropertyInfo = IsStringFilter
    type AttrSetTypeConstraint StringFilterExpressionPropertyInfo = (~) Gtk.Expression.Expression
    type AttrTransferTypeConstraint StringFilterExpressionPropertyInfo = (~) Gtk.Expression.Expression
    type AttrTransferType StringFilterExpressionPropertyInfo = Gtk.Expression.Expression
    type AttrGetType StringFilterExpressionPropertyInfo = (Maybe Gtk.Expression.Expression)
    type AttrLabel StringFilterExpressionPropertyInfo = "expression"
    type AttrOrigin StringFilterExpressionPropertyInfo = StringFilter
    attrGet = getStringFilterExpression
    attrSet = setStringFilterExpression
    attrTransfer _ v = do
        return v
    attrConstruct = constructStringFilterExpression
    attrClear = clearStringFilterExpression
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.expression"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#g:attr:expression"
        })
#endif

-- VVV Prop "ignore-case"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@ignore-case@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stringFilter #ignoreCase
-- @
getStringFilterIgnoreCase :: (MonadIO m, IsStringFilter o) => o -> m Bool
getStringFilterIgnoreCase :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> m Bool
getStringFilterIgnoreCase 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
"ignore-case"

-- | Set the value of the “@ignore-case@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stringFilter [ #ignoreCase 'Data.GI.Base.Attributes.:=' value ]
-- @
setStringFilterIgnoreCase :: (MonadIO m, IsStringFilter o) => o -> Bool -> m ()
setStringFilterIgnoreCase :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> Bool -> m ()
setStringFilterIgnoreCase o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"ignore-case" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@ignore-case@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStringFilterIgnoreCase :: (IsStringFilter o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStringFilterIgnoreCase :: forall o (m :: * -> *).
(IsStringFilter o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructStringFilterIgnoreCase 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
"ignore-case" Bool
val

#if defined(ENABLE_OVERLOADING)
data StringFilterIgnoreCasePropertyInfo
instance AttrInfo StringFilterIgnoreCasePropertyInfo where
    type AttrAllowedOps StringFilterIgnoreCasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StringFilterIgnoreCasePropertyInfo = IsStringFilter
    type AttrSetTypeConstraint StringFilterIgnoreCasePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StringFilterIgnoreCasePropertyInfo = (~) Bool
    type AttrTransferType StringFilterIgnoreCasePropertyInfo = Bool
    type AttrGetType StringFilterIgnoreCasePropertyInfo = Bool
    type AttrLabel StringFilterIgnoreCasePropertyInfo = "ignore-case"
    type AttrOrigin StringFilterIgnoreCasePropertyInfo = StringFilter
    attrGet = getStringFilterIgnoreCase
    attrSet = setStringFilterIgnoreCase
    attrTransfer _ v = do
        return v
    attrConstruct = constructStringFilterIgnoreCase
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.ignoreCase"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#g:attr:ignoreCase"
        })
#endif

-- VVV Prop "match-mode"
   -- Type: TInterface (Name {namespace = "Gtk", name = "StringFilterMatchMode"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@match-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stringFilter #matchMode
-- @
getStringFilterMatchMode :: (MonadIO m, IsStringFilter o) => o -> m Gtk.Enums.StringFilterMatchMode
getStringFilterMatchMode :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> m StringFilterMatchMode
getStringFilterMatchMode o
obj = IO StringFilterMatchMode -> m StringFilterMatchMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO StringFilterMatchMode -> m StringFilterMatchMode)
-> IO StringFilterMatchMode -> m StringFilterMatchMode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO StringFilterMatchMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"match-mode"

-- | Set the value of the “@match-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stringFilter [ #matchMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setStringFilterMatchMode :: (MonadIO m, IsStringFilter o) => o -> Gtk.Enums.StringFilterMatchMode -> m ()
setStringFilterMatchMode :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> StringFilterMatchMode -> m ()
setStringFilterMatchMode o
obj StringFilterMatchMode
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> StringFilterMatchMode -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"match-mode" StringFilterMatchMode
val

-- | Construct a `GValueConstruct` with valid value for the “@match-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStringFilterMatchMode :: (IsStringFilter o, MIO.MonadIO m) => Gtk.Enums.StringFilterMatchMode -> m (GValueConstruct o)
constructStringFilterMatchMode :: forall o (m :: * -> *).
(IsStringFilter o, MonadIO m) =>
StringFilterMatchMode -> m (GValueConstruct o)
constructStringFilterMatchMode StringFilterMatchMode
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 -> StringFilterMatchMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"match-mode" StringFilterMatchMode
val

#if defined(ENABLE_OVERLOADING)
data StringFilterMatchModePropertyInfo
instance AttrInfo StringFilterMatchModePropertyInfo where
    type AttrAllowedOps StringFilterMatchModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StringFilterMatchModePropertyInfo = IsStringFilter
    type AttrSetTypeConstraint StringFilterMatchModePropertyInfo = (~) Gtk.Enums.StringFilterMatchMode
    type AttrTransferTypeConstraint StringFilterMatchModePropertyInfo = (~) Gtk.Enums.StringFilterMatchMode
    type AttrTransferType StringFilterMatchModePropertyInfo = Gtk.Enums.StringFilterMatchMode
    type AttrGetType StringFilterMatchModePropertyInfo = Gtk.Enums.StringFilterMatchMode
    type AttrLabel StringFilterMatchModePropertyInfo = "match-mode"
    type AttrOrigin StringFilterMatchModePropertyInfo = StringFilter
    attrGet = getStringFilterMatchMode
    attrSet = setStringFilterMatchMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructStringFilterMatchMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.matchMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#g:attr:matchMode"
        })
#endif

-- VVV Prop "search"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@search@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' stringFilter #search
-- @
getStringFilterSearch :: (MonadIO m, IsStringFilter o) => o -> m (Maybe T.Text)
getStringFilterSearch :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> m (Maybe Text)
getStringFilterSearch 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
"search"

-- | Set the value of the “@search@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' stringFilter [ #search 'Data.GI.Base.Attributes.:=' value ]
-- @
setStringFilterSearch :: (MonadIO m, IsStringFilter o) => o -> T.Text -> m ()
setStringFilterSearch :: forall (m :: * -> *) o.
(MonadIO m, IsStringFilter o) =>
o -> Text -> m ()
setStringFilterSearch o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"search" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@search@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStringFilterSearch :: (IsStringFilter o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStringFilterSearch :: forall o (m :: * -> *).
(IsStringFilter o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructStringFilterSearch 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
"search" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@search@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #search
-- @
clearStringFilterSearch :: (MonadIO m, IsStringFilter o) => o -> m ()
clearStringFilterSearch :: forall (m :: * -> *) o. (MonadIO m, IsStringFilter o) => o -> m ()
clearStringFilterSearch o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"search" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data StringFilterSearchPropertyInfo
instance AttrInfo StringFilterSearchPropertyInfo where
    type AttrAllowedOps StringFilterSearchPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StringFilterSearchPropertyInfo = IsStringFilter
    type AttrSetTypeConstraint StringFilterSearchPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StringFilterSearchPropertyInfo = (~) T.Text
    type AttrTransferType StringFilterSearchPropertyInfo = T.Text
    type AttrGetType StringFilterSearchPropertyInfo = (Maybe T.Text)
    type AttrLabel StringFilterSearchPropertyInfo = "search"
    type AttrOrigin StringFilterSearchPropertyInfo = StringFilter
    attrGet = getStringFilterSearch
    attrSet = setStringFilterSearch
    attrTransfer _ v = do
        return v
    attrConstruct = constructStringFilterSearch
    attrClear = clearStringFilterSearch
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.search"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#g:attr:search"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList StringFilter
type instance O.AttributeList StringFilter = StringFilterAttributeList
type StringFilterAttributeList = ('[ '("expression", StringFilterExpressionPropertyInfo), '("ignoreCase", StringFilterIgnoreCasePropertyInfo), '("matchMode", StringFilterMatchModePropertyInfo), '("search", StringFilterSearchPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
stringFilterExpression :: AttrLabelProxy "expression"
stringFilterExpression = AttrLabelProxy

stringFilterIgnoreCase :: AttrLabelProxy "ignoreCase"
stringFilterIgnoreCase = AttrLabelProxy

stringFilterMatchMode :: AttrLabelProxy "matchMode"
stringFilterMatchMode = AttrLabelProxy

stringFilterSearch :: AttrLabelProxy "search"
stringFilterSearch = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList StringFilter = StringFilterSignalList
type StringFilterSignalList = ('[ '("changed", Gtk.Filter.FilterChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method StringFilter::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "expression"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The expression to evaluate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "StringFilter" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_new" gtk_string_filter_new :: 
    Ptr Gtk.Expression.Expression ->        -- expression : TInterface (Name {namespace = "Gtk", name = "Expression"})
    IO (Ptr StringFilter)

-- | Creates a new string filter.
-- 
-- You will want to set up the filter by providing a string to search for
-- and by providing a property to look up on the item.
stringFilterNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Expression.IsExpression a) =>
    Maybe (a)
    -- ^ /@expression@/: The expression to evaluate
    -> m StringFilter
    -- ^ __Returns:__ a new @GtkStringFilter@
stringFilterNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsExpression a) =>
Maybe a -> m StringFilter
stringFilterNew Maybe a
expression = IO StringFilter -> m StringFilter
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StringFilter -> m StringFilter)
-> IO StringFilter -> m StringFilter
forall a b. (a -> b) -> a -> b
$ do
    Ptr Expression
maybeExpression <- case Maybe a
expression of
        Maybe a
Nothing -> Ptr Expression -> IO (Ptr Expression)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Expression
forall a. Ptr a
nullPtr
        Just a
jExpression -> do
            Ptr Expression
jExpression' <- a -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
B.ManagedPtr.disownManagedPtr a
jExpression
            Ptr Expression -> IO (Ptr Expression)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Expression
jExpression'
    Ptr StringFilter
result <- Ptr Expression -> IO (Ptr StringFilter)
gtk_string_filter_new Ptr Expression
maybeExpression
    Text -> Ptr StringFilter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stringFilterNew" Ptr StringFilter
result
    StringFilter
result' <- ((ManagedPtr StringFilter -> StringFilter)
-> Ptr StringFilter -> IO StringFilter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StringFilter -> StringFilter
StringFilter) Ptr StringFilter
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
expression a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    StringFilter -> IO StringFilter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StringFilter
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StringFilter::get_expression
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Expression" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_get_expression" gtk_string_filter_get_expression :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    IO (Ptr Gtk.Expression.Expression)

-- | Gets the expression that the string filter uses to
-- obtain strings from items.
stringFilterGetExpression ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> m (Maybe Gtk.Expression.Expression)
    -- ^ __Returns:__ a @GtkExpression@
stringFilterGetExpression :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> m (Maybe Expression)
stringFilterGetExpression a
self = IO (Maybe Expression) -> m (Maybe Expression)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Expression) -> m (Maybe Expression))
-> IO (Maybe Expression) -> m (Maybe Expression)
forall a b. (a -> b) -> a -> b
$ do
    Ptr StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Expression
result <- Ptr StringFilter -> IO (Ptr Expression)
gtk_string_filter_get_expression Ptr StringFilter
self'
    Maybe Expression
maybeResult <- Ptr Expression
-> (Ptr Expression -> IO Expression) -> IO (Maybe Expression)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Expression
result ((Ptr Expression -> IO Expression) -> IO (Maybe Expression))
-> (Ptr Expression -> IO Expression) -> IO (Maybe Expression)
forall a b. (a -> b) -> a -> b
$ \Ptr Expression
result' -> do
        Expression
result'' <- ((ManagedPtr Expression -> Expression)
-> Ptr Expression -> IO Expression
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Expression -> Expression
Gtk.Expression.Expression) Ptr Expression
result'
        Expression -> IO Expression
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Expression -> IO (Maybe Expression)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Expression
maybeResult

#if defined(ENABLE_OVERLOADING)
data StringFilterGetExpressionMethodInfo
instance (signature ~ (m (Maybe Gtk.Expression.Expression)), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterGetExpressionMethodInfo a signature where
    overloadedMethod = stringFilterGetExpression

instance O.OverloadedMethodInfo StringFilterGetExpressionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterGetExpression",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterGetExpression"
        })


#endif

-- method StringFilter::get_ignore_case
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_get_ignore_case" gtk_string_filter_get_ignore_case :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    IO CInt

-- | Returns whether the filter ignores case differences.
stringFilterGetIgnoreCase ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the filter ignores case
stringFilterGetIgnoreCase :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> m Bool
stringFilterGetIgnoreCase a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr StringFilter -> IO CInt
gtk_string_filter_get_ignore_case Ptr StringFilter
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StringFilterGetIgnoreCaseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterGetIgnoreCaseMethodInfo a signature where
    overloadedMethod = stringFilterGetIgnoreCase

instance O.OverloadedMethodInfo StringFilterGetIgnoreCaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterGetIgnoreCase",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterGetIgnoreCase"
        })


#endif

-- method StringFilter::get_match_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gtk" , name = "StringFilterMatchMode" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_get_match_mode" gtk_string_filter_get_match_mode :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    IO CUInt

-- | Returns the match mode that the filter is using.
stringFilterGetMatchMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> m Gtk.Enums.StringFilterMatchMode
    -- ^ __Returns:__ the match mode of the filter
stringFilterGetMatchMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> m StringFilterMatchMode
stringFilterGetMatchMode a
self = IO StringFilterMatchMode -> m StringFilterMatchMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StringFilterMatchMode -> m StringFilterMatchMode)
-> IO StringFilterMatchMode -> m StringFilterMatchMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr StringFilter -> IO CUInt
gtk_string_filter_get_match_mode Ptr StringFilter
self'
    let result' :: StringFilterMatchMode
result' = (Int -> StringFilterMatchMode
forall a. Enum a => Int -> a
toEnum (Int -> StringFilterMatchMode)
-> (CUInt -> Int) -> CUInt -> StringFilterMatchMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    StringFilterMatchMode -> IO StringFilterMatchMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StringFilterMatchMode
result'

#if defined(ENABLE_OVERLOADING)
data StringFilterGetMatchModeMethodInfo
instance (signature ~ (m Gtk.Enums.StringFilterMatchMode), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterGetMatchModeMethodInfo a signature where
    overloadedMethod = stringFilterGetMatchMode

instance O.OverloadedMethodInfo StringFilterGetMatchModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterGetMatchMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterGetMatchMode"
        })


#endif

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

foreign import ccall "gtk_string_filter_get_search" gtk_string_filter_get_search :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    IO CString

-- | Gets the search term.
stringFilterGetSearch ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The search term
stringFilterGetSearch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> m (Maybe Text)
stringFilterGetSearch a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr StringFilter -> IO CString
gtk_string_filter_get_search Ptr StringFilter
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data StringFilterGetSearchMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterGetSearchMethodInfo a signature where
    overloadedMethod = stringFilterGetSearch

instance O.OverloadedMethodInfo StringFilterGetSearchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterGetSearch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterGetSearch"
        })


#endif

-- method StringFilter::set_expression
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expression"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Expression" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkExpression`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_set_expression" gtk_string_filter_set_expression :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    Ptr Gtk.Expression.Expression ->        -- expression : TInterface (Name {namespace = "Gtk", name = "Expression"})
    IO ()

-- | Sets the expression that the string filter uses to
-- obtain strings from items.
-- 
-- The expression must have a value type of @/G_TYPE_STRING/@.
stringFilterSetExpression ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a, Gtk.Expression.IsExpression b) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> Maybe (b)
    -- ^ /@expression@/: a @GtkExpression@
    -> m ()
stringFilterSetExpression :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStringFilter a, IsExpression b) =>
a -> Maybe b -> m ()
stringFilterSetExpression a
self Maybe b
expression = 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 StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Expression
maybeExpression <- case Maybe b
expression of
        Maybe b
Nothing -> Ptr Expression -> IO (Ptr Expression)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Expression
forall a. Ptr a
nullPtr
        Just b
jExpression -> do
            Ptr Expression
jExpression' <- b -> IO (Ptr Expression)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jExpression
            Ptr Expression -> IO (Ptr Expression)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Expression
jExpression'
    Ptr StringFilter -> Ptr Expression -> IO ()
gtk_string_filter_set_expression Ptr StringFilter
self' Ptr Expression
maybeExpression
    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
expression b -> 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 StringFilterSetExpressionMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsStringFilter a, Gtk.Expression.IsExpression b) => O.OverloadedMethod StringFilterSetExpressionMethodInfo a signature where
    overloadedMethod = stringFilterSetExpression

instance O.OverloadedMethodInfo StringFilterSetExpressionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterSetExpression",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterSetExpression"
        })


#endif

-- method StringFilter::set_ignore_case
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ignore_case"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to ignore case"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_set_ignore_case" gtk_string_filter_set_ignore_case :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    CInt ->                                 -- ignore_case : TBasicType TBoolean
    IO ()

-- | Sets whether the filter ignores case differences.
stringFilterSetIgnoreCase ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> Bool
    -- ^ /@ignoreCase@/: 'P.True' to ignore case
    -> m ()
stringFilterSetIgnoreCase :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> Bool -> m ()
stringFilterSetIgnoreCase a
self Bool
ignoreCase = 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 StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let ignoreCase' :: CInt
ignoreCase' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
ignoreCase
    Ptr StringFilter -> CInt -> IO ()
gtk_string_filter_set_ignore_case Ptr StringFilter
self' CInt
ignoreCase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StringFilterSetIgnoreCaseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterSetIgnoreCaseMethodInfo a signature where
    overloadedMethod = stringFilterSetIgnoreCase

instance O.OverloadedMethodInfo StringFilterSetIgnoreCaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterSetIgnoreCase",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterSetIgnoreCase"
        })


#endif

-- method StringFilter::set_match_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "StringFilterMatchMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new match mode" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_set_match_mode" gtk_string_filter_set_match_mode :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gtk", name = "StringFilterMatchMode"})
    IO ()

-- | Sets the match mode for the filter.
stringFilterSetMatchMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> Gtk.Enums.StringFilterMatchMode
    -- ^ /@mode@/: the new match mode
    -> m ()
stringFilterSetMatchMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> StringFilterMatchMode -> m ()
stringFilterSetMatchMode a
self StringFilterMatchMode
mode = 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 StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StringFilterMatchMode -> Int) -> StringFilterMatchMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringFilterMatchMode -> Int
forall a. Enum a => a -> Int
fromEnum) StringFilterMatchMode
mode
    Ptr StringFilter -> CUInt -> IO ()
gtk_string_filter_set_match_mode Ptr StringFilter
self' CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StringFilterSetMatchModeMethodInfo
instance (signature ~ (Gtk.Enums.StringFilterMatchMode -> m ()), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterSetMatchModeMethodInfo a signature where
    overloadedMethod = stringFilterSetMatchMode

instance O.OverloadedMethodInfo StringFilterSetMatchModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterSetMatchMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterSetMatchMode"
        })


#endif

-- method StringFilter::set_search
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "StringFilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkStringFilter`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "search"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The string to search for\n  or %NULL to clear the search"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_string_filter_set_search" gtk_string_filter_set_search :: 
    Ptr StringFilter ->                     -- self : TInterface (Name {namespace = "Gtk", name = "StringFilter"})
    CString ->                              -- search : TBasicType TUTF8
    IO ()

-- | Sets the string to search for.
stringFilterSetSearch ::
    (B.CallStack.HasCallStack, MonadIO m, IsStringFilter a) =>
    a
    -- ^ /@self@/: a @GtkStringFilter@
    -> Maybe (T.Text)
    -- ^ /@search@/: The string to search for
    --   or 'P.Nothing' to clear the search
    -> m ()
stringFilterSetSearch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStringFilter a) =>
a -> Maybe Text -> m ()
stringFilterSetSearch a
self Maybe Text
search = 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 StringFilter
self' <- a -> IO (Ptr StringFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeSearch <- case Maybe Text
search of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jSearch -> do
            CString
jSearch' <- Text -> IO CString
textToCString Text
jSearch
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSearch'
    Ptr StringFilter -> CString -> IO ()
gtk_string_filter_set_search Ptr StringFilter
self' CString
maybeSearch
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSearch
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StringFilterSetSearchMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsStringFilter a) => O.OverloadedMethod StringFilterSetSearchMethodInfo a signature where
    overloadedMethod = stringFilterSetSearch

instance O.OverloadedMethodInfo StringFilterSetSearchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.StringFilter.stringFilterSetSearch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-StringFilter.html#v:stringFilterSetSearch"
        })


#endif