{-# LANGUAGE TypeApplications #-}


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

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

module GI.GtkSource.Objects.SearchSettings
    ( 

-- * Exported types
    SearchSettings(..)                      ,
    IsSearchSettings                        ,
    toSearchSettings                        ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveSearchSettingsMethod             ,
#endif


-- ** getAtWordBoundaries #method:getAtWordBoundaries#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsGetAtWordBoundariesMethodInfo,
#endif
    searchSettingsGetAtWordBoundaries       ,


-- ** getCaseSensitive #method:getCaseSensitive#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsGetCaseSensitiveMethodInfo,
#endif
    searchSettingsGetCaseSensitive          ,


-- ** getRegexEnabled #method:getRegexEnabled#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsGetRegexEnabledMethodInfo ,
#endif
    searchSettingsGetRegexEnabled           ,


-- ** getSearchText #method:getSearchText#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsGetSearchTextMethodInfo   ,
#endif
    searchSettingsGetSearchText             ,


-- ** getWrapAround #method:getWrapAround#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsGetWrapAroundMethodInfo   ,
#endif
    searchSettingsGetWrapAround             ,


-- ** new #method:new#

    searchSettingsNew                       ,


-- ** setAtWordBoundaries #method:setAtWordBoundaries#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsSetAtWordBoundariesMethodInfo,
#endif
    searchSettingsSetAtWordBoundaries       ,


-- ** setCaseSensitive #method:setCaseSensitive#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsSetCaseSensitiveMethodInfo,
#endif
    searchSettingsSetCaseSensitive          ,


-- ** setRegexEnabled #method:setRegexEnabled#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsSetRegexEnabledMethodInfo ,
#endif
    searchSettingsSetRegexEnabled           ,


-- ** setSearchText #method:setSearchText#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsSetSearchTextMethodInfo   ,
#endif
    searchSettingsSetSearchText             ,


-- ** setWrapAround #method:setWrapAround#

#if defined(ENABLE_OVERLOADING)
    SearchSettingsSetWrapAroundMethodInfo   ,
#endif
    searchSettingsSetWrapAround             ,




 -- * Properties
-- ** atWordBoundaries #attr:atWordBoundaries#
-- | If 'P.True', a search match must start and end a word. The match can
-- span multiple words.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchSettingsAtWordBoundariesPropertyInfo,
#endif
    constructSearchSettingsAtWordBoundaries ,
    getSearchSettingsAtWordBoundaries       ,
#if defined(ENABLE_OVERLOADING)
    searchSettingsAtWordBoundaries          ,
#endif
    setSearchSettingsAtWordBoundaries       ,


-- ** caseSensitive #attr:caseSensitive#
-- | Whether the search is case sensitive.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchSettingsCaseSensitivePropertyInfo ,
#endif
    constructSearchSettingsCaseSensitive    ,
    getSearchSettingsCaseSensitive          ,
#if defined(ENABLE_OVERLOADING)
    searchSettingsCaseSensitive             ,
#endif
    setSearchSettingsCaseSensitive          ,


-- ** regexEnabled #attr:regexEnabled#
-- | Search by regular expressions with
-- t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/search-text/@ as the pattern.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchSettingsRegexEnabledPropertyInfo  ,
#endif
    constructSearchSettingsRegexEnabled     ,
    getSearchSettingsRegexEnabled           ,
#if defined(ENABLE_OVERLOADING)
    searchSettingsRegexEnabled              ,
#endif
    setSearchSettingsRegexEnabled           ,


-- ** searchText #attr:searchText#
-- | A search string, or 'P.Nothing' if the search is disabled. If the regular
-- expression search is enabled, t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/search-text/@ is
-- the pattern.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchSettingsSearchTextPropertyInfo    ,
#endif
    clearSearchSettingsSearchText           ,
    constructSearchSettingsSearchText       ,
    getSearchSettingsSearchText             ,
#if defined(ENABLE_OVERLOADING)
    searchSettingsSearchText                ,
#endif
    setSearchSettingsSearchText             ,


-- ** wrapAround #attr:wrapAround#
-- | For a forward search, continue at the beginning of the buffer if no
-- search occurrence is found. For a backward search, continue at the
-- end of the buffer.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    SearchSettingsWrapAroundPropertyInfo    ,
#endif
    constructSearchSettingsWrapAround       ,
    getSearchSettingsWrapAround             ,
#if defined(ENABLE_OVERLOADING)
    searchSettingsWrapAround                ,
#endif
    setSearchSettingsWrapAround             ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.Text as T
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 GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "gtk_source_search_settings_get_type"
    c_gtk_source_search_settings_get_type :: IO B.Types.GType

instance B.Types.TypedObject SearchSettings where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_search_settings_get_type

instance B.Types.GObject SearchSettings

-- | Convert 'SearchSettings' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue SearchSettings where
    toGValue :: SearchSettings -> IO GValue
toGValue SearchSettings
o = do
        GType
gtype <- IO GType
c_gtk_source_search_settings_get_type
        SearchSettings -> (Ptr SearchSettings -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SearchSettings
o (GType
-> (GValue -> Ptr SearchSettings -> IO ())
-> Ptr SearchSettings
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr SearchSettings -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO SearchSettings
fromGValue GValue
gv = do
        Ptr SearchSettings
ptr <- GValue -> IO (Ptr SearchSettings)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr SearchSettings)
        (ManagedPtr SearchSettings -> SearchSettings)
-> Ptr SearchSettings -> IO SearchSettings
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SearchSettings -> SearchSettings
SearchSettings Ptr SearchSettings
ptr
        
    

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSearchSettingsMethod (t :: Symbol) (o :: *) :: * where
    ResolveSearchSettingsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSearchSettingsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSearchSettingsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSearchSettingsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSearchSettingsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSearchSettingsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSearchSettingsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSearchSettingsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSearchSettingsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSearchSettingsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSearchSettingsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSearchSettingsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSearchSettingsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSearchSettingsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSearchSettingsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSearchSettingsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSearchSettingsMethod "getAtWordBoundaries" o = SearchSettingsGetAtWordBoundariesMethodInfo
    ResolveSearchSettingsMethod "getCaseSensitive" o = SearchSettingsGetCaseSensitiveMethodInfo
    ResolveSearchSettingsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSearchSettingsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSearchSettingsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSearchSettingsMethod "getRegexEnabled" o = SearchSettingsGetRegexEnabledMethodInfo
    ResolveSearchSettingsMethod "getSearchText" o = SearchSettingsGetSearchTextMethodInfo
    ResolveSearchSettingsMethod "getWrapAround" o = SearchSettingsGetWrapAroundMethodInfo
    ResolveSearchSettingsMethod "setAtWordBoundaries" o = SearchSettingsSetAtWordBoundariesMethodInfo
    ResolveSearchSettingsMethod "setCaseSensitive" o = SearchSettingsSetCaseSensitiveMethodInfo
    ResolveSearchSettingsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSearchSettingsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSearchSettingsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSearchSettingsMethod "setRegexEnabled" o = SearchSettingsSetRegexEnabledMethodInfo
    ResolveSearchSettingsMethod "setSearchText" o = SearchSettingsSetSearchTextMethodInfo
    ResolveSearchSettingsMethod "setWrapAround" o = SearchSettingsSetWrapAroundMethodInfo
    ResolveSearchSettingsMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSearchSettingsMethod t SearchSettings, O.MethodInfo info SearchSettings p) => OL.IsLabel t (SearchSettings -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- VVV Prop "at-word-boundaries"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@at-word-boundaries@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' searchSettings #atWordBoundaries
-- @
getSearchSettingsAtWordBoundaries :: (MonadIO m, IsSearchSettings o) => o -> m Bool
getSearchSettingsAtWordBoundaries :: o -> m Bool
getSearchSettingsAtWordBoundaries o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"at-word-boundaries"

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

-- | Construct a `GValueConstruct` with valid value for the “@at-word-boundaries@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchSettingsAtWordBoundaries :: (IsSearchSettings o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSearchSettingsAtWordBoundaries :: Bool -> m (GValueConstruct o)
constructSearchSettingsAtWordBoundaries Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"at-word-boundaries" Bool
val

#if defined(ENABLE_OVERLOADING)
data SearchSettingsAtWordBoundariesPropertyInfo
instance AttrInfo SearchSettingsAtWordBoundariesPropertyInfo where
    type AttrAllowedOps SearchSettingsAtWordBoundariesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SearchSettingsAtWordBoundariesPropertyInfo = IsSearchSettings
    type AttrSetTypeConstraint SearchSettingsAtWordBoundariesPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SearchSettingsAtWordBoundariesPropertyInfo = (~) Bool
    type AttrTransferType SearchSettingsAtWordBoundariesPropertyInfo = Bool
    type AttrGetType SearchSettingsAtWordBoundariesPropertyInfo = Bool
    type AttrLabel SearchSettingsAtWordBoundariesPropertyInfo = "at-word-boundaries"
    type AttrOrigin SearchSettingsAtWordBoundariesPropertyInfo = SearchSettings
    attrGet = getSearchSettingsAtWordBoundaries
    attrSet = setSearchSettingsAtWordBoundaries
    attrTransfer _ v = do
        return v
    attrConstruct = constructSearchSettingsAtWordBoundaries
    attrClear = undefined
#endif

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

-- | Get the value of the “@case-sensitive@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' searchSettings #caseSensitive
-- @
getSearchSettingsCaseSensitive :: (MonadIO m, IsSearchSettings o) => o -> m Bool
getSearchSettingsCaseSensitive :: o -> m Bool
getSearchSettingsCaseSensitive o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"case-sensitive"

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

-- | Construct a `GValueConstruct` with valid value for the “@case-sensitive@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchSettingsCaseSensitive :: (IsSearchSettings o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSearchSettingsCaseSensitive :: Bool -> m (GValueConstruct o)
constructSearchSettingsCaseSensitive Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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
$ 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 SearchSettingsCaseSensitivePropertyInfo
instance AttrInfo SearchSettingsCaseSensitivePropertyInfo where
    type AttrAllowedOps SearchSettingsCaseSensitivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SearchSettingsCaseSensitivePropertyInfo = IsSearchSettings
    type AttrSetTypeConstraint SearchSettingsCaseSensitivePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SearchSettingsCaseSensitivePropertyInfo = (~) Bool
    type AttrTransferType SearchSettingsCaseSensitivePropertyInfo = Bool
    type AttrGetType SearchSettingsCaseSensitivePropertyInfo = Bool
    type AttrLabel SearchSettingsCaseSensitivePropertyInfo = "case-sensitive"
    type AttrOrigin SearchSettingsCaseSensitivePropertyInfo = SearchSettings
    attrGet = getSearchSettingsCaseSensitive
    attrSet = setSearchSettingsCaseSensitive
    attrTransfer _ v = do
        return v
    attrConstruct = constructSearchSettingsCaseSensitive
    attrClear = undefined
#endif

-- VVV Prop "regex-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@regex-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' searchSettings #regexEnabled
-- @
getSearchSettingsRegexEnabled :: (MonadIO m, IsSearchSettings o) => o -> m Bool
getSearchSettingsRegexEnabled :: o -> m Bool
getSearchSettingsRegexEnabled o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"regex-enabled"

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

-- | Construct a `GValueConstruct` with valid value for the “@regex-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchSettingsRegexEnabled :: (IsSearchSettings o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSearchSettingsRegexEnabled :: Bool -> m (GValueConstruct o)
constructSearchSettingsRegexEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"regex-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data SearchSettingsRegexEnabledPropertyInfo
instance AttrInfo SearchSettingsRegexEnabledPropertyInfo where
    type AttrAllowedOps SearchSettingsRegexEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SearchSettingsRegexEnabledPropertyInfo = IsSearchSettings
    type AttrSetTypeConstraint SearchSettingsRegexEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SearchSettingsRegexEnabledPropertyInfo = (~) Bool
    type AttrTransferType SearchSettingsRegexEnabledPropertyInfo = Bool
    type AttrGetType SearchSettingsRegexEnabledPropertyInfo = Bool
    type AttrLabel SearchSettingsRegexEnabledPropertyInfo = "regex-enabled"
    type AttrOrigin SearchSettingsRegexEnabledPropertyInfo = SearchSettings
    attrGet = getSearchSettingsRegexEnabled
    attrSet = setSearchSettingsRegexEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructSearchSettingsRegexEnabled
    attrClear = undefined
#endif

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

-- | Get the value of the “@search-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' searchSettings #searchText
-- @
getSearchSettingsSearchText :: (MonadIO m, IsSearchSettings o) => o -> m (Maybe T.Text)
getSearchSettingsSearchText :: o -> m (Maybe Text)
getSearchSettingsSearchText o
obj = IO (Maybe Text) -> m (Maybe Text)
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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"search-text"

-- | Set the value of the “@search-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' searchSettings [ #searchText 'Data.GI.Base.Attributes.:=' value ]
-- @
setSearchSettingsSearchText :: (MonadIO m, IsSearchSettings o) => o -> T.Text -> m ()
setSearchSettingsSearchText :: o -> Text -> m ()
setSearchSettingsSearchText o
obj Text
val = IO () -> m ()
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-text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@search-text@” 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' #searchText
-- @
clearSearchSettingsSearchText :: (MonadIO m, IsSearchSettings o) => o -> m ()
clearSearchSettingsSearchText :: o -> m ()
clearSearchSettingsSearchText o
obj = IO () -> m ()
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-text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data SearchSettingsSearchTextPropertyInfo
instance AttrInfo SearchSettingsSearchTextPropertyInfo where
    type AttrAllowedOps SearchSettingsSearchTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SearchSettingsSearchTextPropertyInfo = IsSearchSettings
    type AttrSetTypeConstraint SearchSettingsSearchTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SearchSettingsSearchTextPropertyInfo = (~) T.Text
    type AttrTransferType SearchSettingsSearchTextPropertyInfo = T.Text
    type AttrGetType SearchSettingsSearchTextPropertyInfo = (Maybe T.Text)
    type AttrLabel SearchSettingsSearchTextPropertyInfo = "search-text"
    type AttrOrigin SearchSettingsSearchTextPropertyInfo = SearchSettings
    attrGet = getSearchSettingsSearchText
    attrSet = setSearchSettingsSearchText
    attrTransfer _ v = do
        return v
    attrConstruct = constructSearchSettingsSearchText
    attrClear = clearSearchSettingsSearchText
#endif

-- VVV Prop "wrap-around"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@wrap-around@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' searchSettings #wrapAround
-- @
getSearchSettingsWrapAround :: (MonadIO m, IsSearchSettings o) => o -> m Bool
getSearchSettingsWrapAround :: o -> m Bool
getSearchSettingsWrapAround o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wrap-around"

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

-- | Construct a `GValueConstruct` with valid value for the “@wrap-around@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSearchSettingsWrapAround :: (IsSearchSettings o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSearchSettingsWrapAround :: Bool -> m (GValueConstruct o)
constructSearchSettingsWrapAround Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"wrap-around" Bool
val

#if defined(ENABLE_OVERLOADING)
data SearchSettingsWrapAroundPropertyInfo
instance AttrInfo SearchSettingsWrapAroundPropertyInfo where
    type AttrAllowedOps SearchSettingsWrapAroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SearchSettingsWrapAroundPropertyInfo = IsSearchSettings
    type AttrSetTypeConstraint SearchSettingsWrapAroundPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SearchSettingsWrapAroundPropertyInfo = (~) Bool
    type AttrTransferType SearchSettingsWrapAroundPropertyInfo = Bool
    type AttrGetType SearchSettingsWrapAroundPropertyInfo = Bool
    type AttrLabel SearchSettingsWrapAroundPropertyInfo = "wrap-around"
    type AttrOrigin SearchSettingsWrapAroundPropertyInfo = SearchSettings
    attrGet = getSearchSettingsWrapAround
    attrSet = setSearchSettingsWrapAround
    attrTransfer _ v = do
        return v
    attrConstruct = constructSearchSettingsWrapAround
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SearchSettings
type instance O.AttributeList SearchSettings = SearchSettingsAttributeList
type SearchSettingsAttributeList = ('[ '("atWordBoundaries", SearchSettingsAtWordBoundariesPropertyInfo), '("caseSensitive", SearchSettingsCaseSensitivePropertyInfo), '("regexEnabled", SearchSettingsRegexEnabledPropertyInfo), '("searchText", SearchSettingsSearchTextPropertyInfo), '("wrapAround", SearchSettingsWrapAroundPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
searchSettingsAtWordBoundaries :: AttrLabelProxy "atWordBoundaries"
searchSettingsAtWordBoundaries = AttrLabelProxy

searchSettingsCaseSensitive :: AttrLabelProxy "caseSensitive"
searchSettingsCaseSensitive = AttrLabelProxy

searchSettingsRegexEnabled :: AttrLabelProxy "regexEnabled"
searchSettingsRegexEnabled = AttrLabelProxy

searchSettingsSearchText :: AttrLabelProxy "searchText"
searchSettingsSearchText = AttrLabelProxy

searchSettingsWrapAround :: AttrLabelProxy "wrapAround"
searchSettingsWrapAround = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SearchSettings = SearchSettingsSignalList
type SearchSettingsSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_source_search_settings_new" gtk_source_search_settings_new :: 
    IO (Ptr SearchSettings)

-- | Creates a new search settings object.
-- 
-- /Since: 3.10/
searchSettingsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SearchSettings
    -- ^ __Returns:__ a new search settings object.
searchSettingsNew :: m SearchSettings
searchSettingsNew  = IO SearchSettings -> m SearchSettings
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SearchSettings -> m SearchSettings)
-> IO SearchSettings -> m SearchSettings
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchSettings
result <- IO (Ptr SearchSettings)
gtk_source_search_settings_new
    Text -> Ptr SearchSettings -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"searchSettingsNew" Ptr SearchSettings
result
    SearchSettings
result' <- ((ManagedPtr SearchSettings -> SearchSettings)
-> Ptr SearchSettings -> IO SearchSettings
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SearchSettings -> SearchSettings
SearchSettings) Ptr SearchSettings
result
    SearchSettings -> IO SearchSettings
forall (m :: * -> *) a. Monad m => a -> m a
return SearchSettings
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SearchSettings::get_at_word_boundaries
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , 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_source_search_settings_get_at_word_boundaries" gtk_source_search_settings_get_at_word_boundaries :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchSettingsGetAtWordBoundaries ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> m Bool
    -- ^ __Returns:__ whether to search at word boundaries.
searchSettingsGetAtWordBoundaries :: a -> m Bool
searchSettingsGetAtWordBoundaries a
settings = IO Bool -> m Bool
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 SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    CInt
result <- Ptr SearchSettings -> IO CInt
gtk_source_search_settings_get_at_word_boundaries Ptr SearchSettings
settings'
    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
settings
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SearchSettingsGetAtWordBoundariesMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsGetAtWordBoundariesMethodInfo a signature where
    overloadedMethod = searchSettingsGetAtWordBoundaries

#endif

-- method SearchSettings::get_case_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , 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_source_search_settings_get_case_sensitive" gtk_source_search_settings_get_case_sensitive :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchSettingsGetCaseSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> m Bool
    -- ^ __Returns:__ whether the search is case sensitive.
searchSettingsGetCaseSensitive :: a -> m Bool
searchSettingsGetCaseSensitive a
settings = IO Bool -> m Bool
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 SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    CInt
result <- Ptr SearchSettings -> IO CInt
gtk_source_search_settings_get_case_sensitive Ptr SearchSettings
settings'
    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
settings
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SearchSettingsGetCaseSensitiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsGetCaseSensitiveMethodInfo a signature where
    overloadedMethod = searchSettingsGetCaseSensitive

#endif

-- method SearchSettings::get_regex_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , 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_source_search_settings_get_regex_enabled" gtk_source_search_settings_get_regex_enabled :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchSettingsGetRegexEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> m Bool
    -- ^ __Returns:__ whether to search by regular expressions.
searchSettingsGetRegexEnabled :: a -> m Bool
searchSettingsGetRegexEnabled a
settings = IO Bool -> m Bool
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 SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    CInt
result <- Ptr SearchSettings -> IO CInt
gtk_source_search_settings_get_regex_enabled Ptr SearchSettings
settings'
    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
settings
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SearchSettingsGetRegexEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsGetRegexEnabledMethodInfo a signature where
    overloadedMethod = searchSettingsGetRegexEnabled

#endif

-- method SearchSettings::get_search_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , 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_source_search_settings_get_search_text" gtk_source_search_settings_get_search_text :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO CString

-- | Gets the text to search. The return value must not be freed.
-- 
-- You may be interested to call 'GI.GtkSource.Functions.utilsEscapeSearchText' after
-- this function.
-- 
-- /Since: 3.10/
searchSettingsGetSearchText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the text to search, or 'P.Nothing' if the search is disabled.
searchSettingsGetSearchText :: a -> m (Maybe Text)
searchSettingsGetSearchText a
settings = IO (Maybe Text) -> m (Maybe Text)
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 SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    CString
result <- Ptr SearchSettings -> IO CString
gtk_source_search_settings_get_search_text Ptr SearchSettings
settings'
    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 (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
settings
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SearchSettingsGetSearchTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsGetSearchTextMethodInfo a signature where
    overloadedMethod = searchSettingsGetSearchText

#endif

-- method SearchSettings::get_wrap_around
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , 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_source_search_settings_get_wrap_around" gtk_source_search_settings_get_wrap_around :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 3.10/
searchSettingsGetWrapAround ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> m Bool
    -- ^ __Returns:__ whether to wrap around the search.
searchSettingsGetWrapAround :: a -> m Bool
searchSettingsGetWrapAround a
settings = IO Bool -> m Bool
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 SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    CInt
result <- Ptr SearchSettings -> IO CInt
gtk_source_search_settings_get_wrap_around Ptr SearchSettings
settings'
    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
settings
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SearchSettingsGetWrapAroundMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsGetWrapAroundMethodInfo a signature where
    overloadedMethod = searchSettingsGetWrapAround

#endif

-- method SearchSettings::set_at_word_boundaries
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "at_word_boundaries"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the setting." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_settings_set_at_word_boundaries" gtk_source_search_settings_set_at_word_boundaries :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    CInt ->                                 -- at_word_boundaries : TBasicType TBoolean
    IO ()

-- | Change whether the search is done at word boundaries. If /@atWordBoundaries@/
-- is 'P.True', a search match must start and end a word. The match can span
-- multiple words. See also 'GI.Gtk.Structs.TextIter.textIterStartsWord' and
-- 'GI.Gtk.Structs.TextIter.textIterEndsWord'.
-- 
-- /Since: 3.10/
searchSettingsSetAtWordBoundaries ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> Bool
    -- ^ /@atWordBoundaries@/: the setting.
    -> m ()
searchSettingsSetAtWordBoundaries :: a -> Bool -> m ()
searchSettingsSetAtWordBoundaries a
settings Bool
atWordBoundaries = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    let atWordBoundaries' :: CInt
atWordBoundaries' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
atWordBoundaries
    Ptr SearchSettings -> CInt -> IO ()
gtk_source_search_settings_set_at_word_boundaries Ptr SearchSettings
settings' CInt
atWordBoundaries'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
settings
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchSettingsSetAtWordBoundariesMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsSetAtWordBoundariesMethodInfo a signature where
    overloadedMethod = searchSettingsSetAtWordBoundaries

#endif

-- method SearchSettings::set_case_sensitive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "case_sensitive"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the setting." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_settings_set_case_sensitive" gtk_source_search_settings_set_case_sensitive :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    CInt ->                                 -- case_sensitive : TBasicType TBoolean
    IO ()

-- | Enables or disables the case sensitivity for the search.
-- 
-- /Since: 3.10/
searchSettingsSetCaseSensitive ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> Bool
    -- ^ /@caseSensitive@/: the setting.
    -> m ()
searchSettingsSetCaseSensitive :: a -> Bool -> m ()
searchSettingsSetCaseSensitive a
settings Bool
caseSensitive = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    let caseSensitive' :: CInt
caseSensitive' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
caseSensitive
    Ptr SearchSettings -> CInt -> IO ()
gtk_source_search_settings_set_case_sensitive Ptr SearchSettings
settings' CInt
caseSensitive'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
settings
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchSettingsSetCaseSensitiveMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsSetCaseSensitiveMethodInfo a signature where
    overloadedMethod = searchSettingsSetCaseSensitive

#endif

-- method SearchSettings::set_regex_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "regex_enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the setting." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_settings_set_regex_enabled" gtk_source_search_settings_set_regex_enabled :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    CInt ->                                 -- regex_enabled : TBasicType TBoolean
    IO ()

-- | Enables or disables whether to search by regular expressions.
-- If enabled, the t'GI.GtkSource.Objects.SearchSettings.SearchSettings':@/search-text/@ property contains the
-- pattern of the regular expression.
-- 
-- t'GI.GtkSource.Objects.SearchContext.SearchContext' uses t'GI.GLib.Structs.Regex.Regex' when regex search is enabled. See the
-- <https://developer.gnome.org/glib/stable/glib-regex-syntax.html Regular expression syntax>
-- page in the GLib reference manual.
-- 
-- /Since: 3.10/
searchSettingsSetRegexEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> Bool
    -- ^ /@regexEnabled@/: the setting.
    -> m ()
searchSettingsSetRegexEnabled :: a -> Bool -> m ()
searchSettingsSetRegexEnabled a
settings Bool
regexEnabled = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    let regexEnabled' :: CInt
regexEnabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
regexEnabled
    Ptr SearchSettings -> CInt -> IO ()
gtk_source_search_settings_set_regex_enabled Ptr SearchSettings
settings' CInt
regexEnabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
settings
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchSettingsSetRegexEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsSetRegexEnabledMethodInfo a signature where
    overloadedMethod = searchSettingsSetRegexEnabled

#endif

-- method SearchSettings::set_search_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "search_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the nul-terminated text to search, or %NULL to disable 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_source_search_settings_set_search_text" gtk_source_search_settings_set_search_text :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    CString ->                              -- search_text : TBasicType TUTF8
    IO ()

-- | Sets the text to search. If /@searchText@/ is 'P.Nothing' or is empty, the search
-- will be disabled. A copy of /@searchText@/ will be made, so you can safely free
-- /@searchText@/ after a call to this function.
-- 
-- You may be interested to call 'GI.GtkSource.Functions.utilsUnescapeSearchText' before
-- this function.
-- 
-- /Since: 3.10/
searchSettingsSetSearchText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> Maybe (T.Text)
    -- ^ /@searchText@/: the nul-terminated text to search, or 'P.Nothing' to disable the search.
    -> m ()
searchSettingsSetSearchText :: a -> Maybe Text -> m ()
searchSettingsSetSearchText a
settings Maybe Text
searchText = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    CString
maybeSearchText <- case Maybe Text
searchText of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jSearchText -> do
            CString
jSearchText' <- Text -> IO CString
textToCString Text
jSearchText
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSearchText'
    Ptr SearchSettings -> CString -> IO ()
gtk_source_search_settings_set_search_text Ptr SearchSettings
settings' CString
maybeSearchText
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
settings
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSearchText
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchSettingsSetSearchTextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsSetSearchTextMethodInfo a signature where
    overloadedMethod = searchSettingsSetSearchText

#endif

-- method SearchSettings::set_wrap_around
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SearchSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSearchSettings."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "wrap_around"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the setting." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_search_settings_set_wrap_around" gtk_source_search_settings_set_wrap_around :: 
    Ptr SearchSettings ->                   -- settings : TInterface (Name {namespace = "GtkSource", name = "SearchSettings"})
    CInt ->                                 -- wrap_around : TBasicType TBoolean
    IO ()

-- | Enables or disables the wrap around search. If /@wrapAround@/ is 'P.True', the
-- forward search continues at the beginning of the buffer if no search
-- occurrences are found. Similarly, the backward search continues to search at
-- the end of the buffer.
-- 
-- /Since: 3.10/
searchSettingsSetWrapAround ::
    (B.CallStack.HasCallStack, MonadIO m, IsSearchSettings a) =>
    a
    -- ^ /@settings@/: a t'GI.GtkSource.Objects.SearchSettings.SearchSettings'.
    -> Bool
    -- ^ /@wrapAround@/: the setting.
    -> m ()
searchSettingsSetWrapAround :: a -> Bool -> m ()
searchSettingsSetWrapAround a
settings Bool
wrapAround = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SearchSettings
settings' <- a -> IO (Ptr SearchSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
settings
    let wrapAround' :: CInt
wrapAround' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
wrapAround
    Ptr SearchSettings -> CInt -> IO ()
gtk_source_search_settings_set_wrap_around Ptr SearchSettings
settings' CInt
wrapAround'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
settings
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SearchSettingsSetWrapAroundMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSearchSettings a) => O.MethodInfo SearchSettingsSetWrapAroundMethodInfo a signature where
    overloadedMethod = searchSettingsSetWrapAround

#endif