{-# 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.Vte.Structs.Regex
    ( 

-- * Exported types
    Regex(..)                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [jit]("GI.Vte.Structs.Regex#g:method:jit"), [ref]("GI.Vte.Structs.Regex#g:method:ref"), [substitute]("GI.Vte.Structs.Regex#g:method:substitute"), [unref]("GI.Vte.Structs.Regex#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRegexMethod                      ,
#endif

-- ** jit #method:jit#

#if defined(ENABLE_OVERLOADING)
    RegexJitMethodInfo                      ,
#endif
    regexJit                                ,


-- ** newForMatch #method:newForMatch#

    regexNewForMatch                        ,


-- ** newForSearch #method:newForSearch#

    regexNewForSearch                       ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    RegexRefMethodInfo                      ,
#endif
    regexRef                                ,


-- ** substitute #method:substitute#

#if defined(ENABLE_OVERLOADING)
    RegexSubstituteMethodInfo               ,
#endif
    regexSubstitute                         ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    RegexUnrefMethodInfo                    ,
#endif
    regexUnref                              ,




    ) 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.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 GHC.Records as R


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

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

foreign import ccall "vte_regex_get_type" c_vte_regex_get_type :: 
    IO GType

type instance O.ParentTypes Regex = '[]
instance O.HasParentTypes Regex

instance B.Types.TypedObject Regex where
    glibType :: IO GType
glibType = IO GType
c_vte_regex_get_type

instance B.Types.GBoxed Regex

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Regex
type instance O.AttributeList Regex = RegexAttributeList
type RegexAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method Regex::new_for_match
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "pattern"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a regex pattern string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pattern_length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the length of @pattern in bytes, or -1 if the\n string is NUL-terminated and the length is unknown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "PCRE2 compile flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Regex" })
-- throws : True
-- Skip return : False

foreign import ccall "vte_regex_new_for_match" vte_regex_new_for_match :: 
    CString ->                              -- pattern : TBasicType TUTF8
    Int64 ->                                -- pattern_length : TBasicType TInt64
    Word32 ->                               -- flags : TBasicType TUInt32
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Regex)

-- | Compiles /@pattern@/ into a regex for use as a match regex
-- with 'GI.Vte.Objects.Terminal.terminalMatchAddRegex' or
-- @/vte_terminal_event_check_regex_simple()/@.
-- 
-- See man:pcre2pattern(3) for information
-- about the supported regex language.
-- 
-- The regex will be compiled using @/PCRE2_UTF/@ and possibly other flags, in
-- addition to the flags supplied in /@flags@/.
regexNewForMatch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@pattern@/: a regex pattern string
    -> Int64
    -- ^ /@patternLength@/: the length of /@pattern@/ in bytes, or -1 if the
    --  string is NUL-terminated and the length is unknown
    -> Word32
    -- ^ /@flags@/: PCRE2 compile flags
    -> m Regex
    -- ^ __Returns:__ a newly created t'GI.Vte.Structs.Regex.Regex', or 'P.Nothing' with /@error@/ filled in /(Can throw 'Data.GI.Base.GError.GError')/
regexNewForMatch :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> Word32 -> m Regex
regexNewForMatch Text
pattern Int64
patternLength Word32
flags = IO Regex -> m Regex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Regex -> m Regex) -> IO Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ do
    CString
pattern' <- Text -> IO CString
textToCString Text
pattern
    IO Regex -> IO () -> IO Regex
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Regex
result <- (Ptr (Ptr GError) -> IO (Ptr Regex)) -> IO (Ptr Regex)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Regex)) -> IO (Ptr Regex))
-> (Ptr (Ptr GError) -> IO (Ptr Regex)) -> IO (Ptr Regex)
forall a b. (a -> b) -> a -> b
$ CString -> Int64 -> Word32 -> Ptr (Ptr GError) -> IO (Ptr Regex)
vte_regex_new_for_match CString
pattern' Int64
patternLength Word32
flags
        Text -> Ptr Regex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regexNewForMatch" Ptr Regex
result
        Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Regex -> Regex
Regex) Ptr Regex
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pattern'
        Regex -> IO Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pattern'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Regex::new_for_search
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "pattern"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a regex pattern string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pattern_length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the length of @pattern in bytes, or -1 if the\n string is NUL-terminated and the length is unknown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "PCRE2 compile flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Regex" })
-- throws : True
-- Skip return : False

foreign import ccall "vte_regex_new_for_search" vte_regex_new_for_search :: 
    CString ->                              -- pattern : TBasicType TUTF8
    Int64 ->                                -- pattern_length : TBasicType TInt64
    Word32 ->                               -- flags : TBasicType TUInt32
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Regex)

-- | Compiles /@pattern@/ into a regex for use as a search regex
-- with 'GI.Vte.Objects.Terminal.terminalSearchSetRegex'.
-- 
-- See man:pcre2pattern(3) for information
-- about the supported regex language.
-- 
-- The regex will be compiled using @/PCRE2_UTF/@ and possibly other flags, in
-- addition to the flags supplied in /@flags@/.
regexNewForSearch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@pattern@/: a regex pattern string
    -> Int64
    -- ^ /@patternLength@/: the length of /@pattern@/ in bytes, or -1 if the
    --  string is NUL-terminated and the length is unknown
    -> Word32
    -- ^ /@flags@/: PCRE2 compile flags
    -> m Regex
    -- ^ __Returns:__ a newly created t'GI.Vte.Structs.Regex.Regex', or 'P.Nothing' with /@error@/ filled in /(Can throw 'Data.GI.Base.GError.GError')/
regexNewForSearch :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> Word32 -> m Regex
regexNewForSearch Text
pattern Int64
patternLength Word32
flags = IO Regex -> m Regex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Regex -> m Regex) -> IO Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ do
    CString
pattern' <- Text -> IO CString
textToCString Text
pattern
    IO Regex -> IO () -> IO Regex
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Regex
result <- (Ptr (Ptr GError) -> IO (Ptr Regex)) -> IO (Ptr Regex)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Regex)) -> IO (Ptr Regex))
-> (Ptr (Ptr GError) -> IO (Ptr Regex)) -> IO (Ptr Regex)
forall a b. (a -> b) -> a -> b
$ CString -> Int64 -> Word32 -> Ptr (Ptr GError) -> IO (Ptr Regex)
vte_regex_new_for_search CString
pattern' Int64
patternLength Word32
flags
        Text -> Ptr Regex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regexNewForSearch" Ptr Regex
result
        Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Regex -> Regex
Regex) Ptr Regex
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pattern'
        Regex -> IO Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pattern'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Regex::jit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "regex"
--           , argType = TInterface Name { namespace = "Vte" , name = "Regex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VteRegex" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "vte_regex_jit" vte_regex_jit :: 
    Ptr Regex ->                            -- regex : TInterface (Name {namespace = "Vte", name = "Regex"})
    Word32 ->                               -- flags : TBasicType TUInt32
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | If the platform supports JITing, JIT compiles /@regex@/.
regexJit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -- ^ /@regex@/: a t'GI.Vte.Structs.Regex.Regex'
    -> Word32
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
regexJit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Regex -> Word32 -> m ()
regexJit Regex
regex Word32
flags = 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 Regex
regex' <- Regex -> IO (Ptr Regex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Regex
regex
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Regex -> Word32 -> Ptr (Ptr GError) -> IO CInt
vte_regex_jit Ptr Regex
regex' Word32
flags
        Regex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Regex
regex
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RegexJitMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod RegexJitMethodInfo Regex signature where
    overloadedMethod = regexJit

instance O.OverloadedMethodInfo RegexJitMethodInfo Regex where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vte.Structs.Regex.regexJit",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vte-2.91.28/docs/GI-Vte-Structs-Regex.html#v:regexJit"
        }


#endif

-- method Regex::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "regex"
--           , argType = TInterface Name { namespace = "Vte" , name = "Regex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VteRegex" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Regex" })
-- throws : False
-- Skip return : False

foreign import ccall "vte_regex_ref" vte_regex_ref :: 
    Ptr Regex ->                            -- regex : TInterface (Name {namespace = "Vte", name = "Regex"})
    IO (Ptr Regex)

-- | Increases the reference count of /@regex@/ by one.
regexRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -- ^ /@regex@/: a t'GI.Vte.Structs.Regex.Regex'
    -> m Regex
    -- ^ __Returns:__ /@regex@/
regexRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Regex -> m Regex
regexRef Regex
regex = IO Regex -> m Regex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Regex -> m Regex) -> IO Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ do
    Ptr Regex
regex' <- Regex -> IO (Ptr Regex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Regex
regex
    Ptr Regex
result <- Ptr Regex -> IO (Ptr Regex)
vte_regex_ref Ptr Regex
regex'
    Text -> Ptr Regex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regexRef" Ptr Regex
result
    Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Regex -> Regex
Regex) Ptr Regex
result
    Regex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Regex
regex
    Regex -> IO Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
result'

#if defined(ENABLE_OVERLOADING)
data RegexRefMethodInfo
instance (signature ~ (m Regex), MonadIO m) => O.OverloadedMethod RegexRefMethodInfo Regex signature where
    overloadedMethod = regexRef

instance O.OverloadedMethodInfo RegexRefMethodInfo Regex where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vte.Structs.Regex.regexRef",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vte-2.91.28/docs/GI-Vte-Structs-Regex.html#v:regexRef"
        }


#endif

-- method Regex::substitute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "regex"
--           , argType = TInterface Name { namespace = "Vte" , name = "Regex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VteRegex" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subject"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the subject string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "replacement"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the replacement string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "PCRE2 match flags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "vte_regex_substitute" vte_regex_substitute :: 
    Ptr Regex ->                            -- regex : TInterface (Name {namespace = "Vte", name = "Regex"})
    CString ->                              -- subject : TBasicType TUTF8
    CString ->                              -- replacement : TBasicType TUTF8
    Word32 ->                               -- flags : TBasicType TUInt32
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | See man:pcre2api(3) on @/pcre2_substitute()/@ for more information.
-- 
-- /Since: 0.56/
regexSubstitute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -- ^ /@regex@/: a t'GI.Vte.Structs.Regex.Regex'
    -> T.Text
    -- ^ /@subject@/: the subject string
    -> T.Text
    -- ^ /@replacement@/: the replacement string
    -> Word32
    -- ^ /@flags@/: PCRE2 match flags
    -> m T.Text
    -- ^ __Returns:__ the substituted string, or 'P.Nothing'
    --   if an error occurred /(Can throw 'Data.GI.Base.GError.GError')/
regexSubstitute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Regex -> Text -> Text -> Word32 -> m Text
regexSubstitute Regex
regex Text
subject Text
replacement Word32
flags = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Regex
regex' <- Regex -> IO (Ptr Regex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Regex
regex
    CString
subject' <- Text -> IO CString
textToCString Text
subject
    CString
replacement' <- Text -> IO CString
textToCString Text
replacement
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Regex
-> CString -> CString -> Word32 -> Ptr (Ptr GError) -> IO CString
vte_regex_substitute Ptr Regex
regex' CString
subject' CString
replacement' Word32
flags
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regexSubstitute" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        Regex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Regex
regex
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subject'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replacement'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subject'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
replacement'
     )

#if defined(ENABLE_OVERLOADING)
data RegexSubstituteMethodInfo
instance (signature ~ (T.Text -> T.Text -> Word32 -> m T.Text), MonadIO m) => O.OverloadedMethod RegexSubstituteMethodInfo Regex signature where
    overloadedMethod = regexSubstitute

instance O.OverloadedMethodInfo RegexSubstituteMethodInfo Regex where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vte.Structs.Regex.regexSubstitute",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vte-2.91.28/docs/GI-Vte-Structs-Regex.html#v:regexSubstitute"
        }


#endif

-- method Regex::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "regex"
--           , argType = TInterface Name { namespace = "Vte" , name = "Regex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #VteRegex" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Vte" , name = "Regex" })
-- throws : False
-- Skip return : False

foreign import ccall "vte_regex_unref" vte_regex_unref :: 
    Ptr Regex ->                            -- regex : TInterface (Name {namespace = "Vte", name = "Regex"})
    IO (Ptr Regex)

-- | Decreases the reference count of /@regex@/ by one, and frees /@regex@/
-- if the refcount reaches zero.
regexUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -- ^ /@regex@/: a t'GI.Vte.Structs.Regex.Regex'
    -> m Regex
    -- ^ __Returns:__ 'P.Nothing'
regexUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Regex -> m Regex
regexUnref Regex
regex = IO Regex -> m Regex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Regex -> m Regex) -> IO Regex -> m Regex
forall a b. (a -> b) -> a -> b
$ do
    Ptr Regex
regex' <- Regex -> IO (Ptr Regex)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Regex
regex
    Ptr Regex
result <- Ptr Regex -> IO (Ptr Regex)
vte_regex_unref Ptr Regex
regex'
    Text -> Ptr Regex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"regexUnref" Ptr Regex
result
    Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Regex -> Regex
Regex) Ptr Regex
result
    Regex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Regex
regex
    Regex -> IO Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
result'

#if defined(ENABLE_OVERLOADING)
data RegexUnrefMethodInfo
instance (signature ~ (m Regex), MonadIO m) => O.OverloadedMethod RegexUnrefMethodInfo Regex signature where
    overloadedMethod = regexUnref

instance O.OverloadedMethodInfo RegexUnrefMethodInfo Regex where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Vte.Structs.Regex.regexUnref",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-vte-2.91.28/docs/GI-Vte-Structs-Regex.html#v:regexUnref"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRegexMethod (t :: Symbol) (o :: *) :: * where
    ResolveRegexMethod "jit" o = RegexJitMethodInfo
    ResolveRegexMethod "ref" o = RegexRefMethodInfo
    ResolveRegexMethod "substitute" o = RegexSubstituteMethodInfo
    ResolveRegexMethod "unref" o = RegexUnrefMethodInfo
    ResolveRegexMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif