{-# 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(..)                               ,
    noRegex                                 ,


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

#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.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 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


-- | Memory-managed wrapper type.
newtype Regex = Regex (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)
foreign import ccall "vte_regex_get_type" c_vte_regex_get_type :: 
    IO GType

instance BoxedObject Regex where
    boxedType :: Regex -> IO GType
boxedType _ = IO GType
c_vte_regex_get_type

-- | Convert 'Regex' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Regex where
    toGValue :: Regex -> IO GValue
toGValue o :: Regex
o = do
        GType
gtype <- IO GType
c_vte_regex_get_type
        Regex -> (Ptr Regex -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Regex
o (GType -> (GValue -> Ptr Regex -> IO ()) -> Ptr Regex -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Regex -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Regex
fromGValue gv :: GValue
gv = do
        Ptr Regex
ptr <- GValue -> IO (Ptr Regex)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Regex)
        (ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Regex -> Regex
Regex Ptr Regex
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `Regex`.
noRegex :: Maybe Regex
noRegex :: Maybe Regex
noRegex = Maybe Regex
forall a. Maybe a
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 = Nothing , 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 = Nothing , 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 (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)

-- | /No description available in the introspection data./
regexNewForMatch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> Int64
    -> Word32
    -> m Regex
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
regexNewForMatch :: Text -> Int64 -> Word32 -> m Regex
regexNewForMatch pattern :: Text
pattern patternLength :: Int64
patternLength flags :: 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 "regexNewForMatch" Ptr Regex
result
        Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, BoxedObject 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 = Nothing , 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 = Nothing , 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 (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)

-- | /No description available in the introspection data./
regexNewForSearch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> Int64
    -> Word32
    -> m Regex
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
regexNewForSearch :: Text -> Int64 -> Word32 -> m Regex
regexNewForSearch pattern :: Text
pattern patternLength :: Int64
patternLength flags :: 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 "regexNewForSearch" Ptr Regex
result
        Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, BoxedObject 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 = Nothing , 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

-- | /No description available in the introspection data./
regexJit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -> Word32
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
regexJit :: Regex -> Word32 -> m ()
regexJit regex :: Regex
regex flags :: 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.MethodInfo RegexJitMethodInfo Regex signature where
    overloadedMethod = 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 = Nothing , 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)

-- | /No description available in the introspection data./
regexRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -> m Regex
regexRef :: Regex -> m Regex
regexRef regex :: 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 "regexRef" Ptr Regex
result
    Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, BoxedObject 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.MethodInfo RegexRefMethodInfo Regex signature where
    overloadedMethod = 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 = Nothing , 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 = Nothing , 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 = Nothing , 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 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

-- | /No description available in the introspection data./
regexSubstitute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -> T.Text
    -> T.Text
    -> Word32
    -> m T.Text
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
regexSubstitute :: Regex -> Text -> Text -> Word32 -> m Text
regexSubstitute regex :: Regex
regex subject :: Text
subject replacement :: Text
replacement flags :: 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 "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.MethodInfo RegexSubstituteMethodInfo Regex signature where
    overloadedMethod = 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 = Nothing , 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_unref" vte_regex_unref :: 
    Ptr Regex ->                            -- regex : TInterface (Name {namespace = "Vte", name = "Regex"})
    IO (Ptr Regex)

-- | /No description available in the introspection data./
regexUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Regex
    -> m Regex
regexUnref :: Regex -> m Regex
regexUnref regex :: 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_unref Ptr Regex
regex'
    Text -> Ptr Regex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "regexUnref" Ptr Regex
result
    Regex
result' <- ((ManagedPtr Regex -> Regex) -> Ptr Regex -> IO Regex
forall a.
(HasCallStack, BoxedObject 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.MethodInfo RegexUnrefMethodInfo Regex signature where
    overloadedMethod = 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.MethodInfo 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

#endif