{-# LANGUAGE TypeApplications #-} -- | Copyright : Will Thompson and Iñaki García Etxebarria -- 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 , -- ** newForMatchFull #method:newForMatchFull# regexNewForMatchFull , -- ** newForSearch #method:newForSearch# regexNewForSearch , -- ** newForSearchFull #method:newForSearchFull# regexNewForSearchFull , -- ** 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.GHashTable as B.GHT import qualified Data.GI.Base.GVariant as B.GVariant import qualified Data.GI.Base.GValue as B.GValue import qualified Data.GI.Base.GParamSpec as B.GParamSpec import qualified Data.GI.Base.CallStack as B.CallStack import qualified Data.GI.Base.Properties as B.Properties import qualified Data.GI.Base.Signals as B.Signals import qualified Control.Monad.IO.Class as MIO import qualified Data.Coerce as Coerce import qualified Data.Text as T import qualified Data.Kind as DK import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import qualified Foreign.Ptr as FP import qualified GHC.OverloadedLabels as OL import qualified GHC.Records as R import qualified Data.Word as DW import qualified Data.Int as DI import qualified System.Posix.Types as SPT import qualified Foreign.C.Types as FCT -- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392 #if MIN_VERSION_base(4,18,0) #else #endif -- | 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 $c== :: Regex -> Regex -> Bool == :: Regex -> Regex -> Bool $c/= :: Regex -> Regex -> Bool /= :: 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 t'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 <- Ptr GValue -> IO (Ptr Regex) forall b. Ptr GValue -> IO (Ptr b) B.GValue.get_boxed Ptr GValue gv :: IO (Ptr Regex) if ptr /= FP.nullPtr then P.Just <$> B.ManagedPtr.newBoxed Regex ptr else return P.Nothing #if defined(ENABLE_OVERLOADING) instance O.HasAttributeList Regex type instance O.AttributeList Regex = RegexAttributeList type RegexAttributeList = ('[ ] :: [(Symbol, DK.Type)]) #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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "pattern_length" -- , argType = TBasicType TSSize -- , 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 -- , argCallbackUserData = 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 -- , argCallbackUserData = 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 DI.Int64 -> -- pattern_length : TBasicType TSSize 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, and man:pcre2api(3) for -- information about the supported /@flags@/. -- -- The regex will be compiled using \<literal>PCRE2_UTF\<\/literal> 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 -> DI.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 a. IO a -> m a 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 pattern' <- Text -> IO CString textToCString Text pattern onException (do result <- propagateGError $ vte_regex_new_for_match pattern' patternLength flags checkUnexpectedReturnNULL "regexNewForMatch" result result' <- (wrapBoxed Regex) result freeMem pattern' return result' ) (do freeMem pattern' ) #if defined(ENABLE_OVERLOADING) #endif -- method Regex::new_for_match_full -- 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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "pattern_length" -- , argType = TBasicType TSSize -- , 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 -- , argCallbackUserData = 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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "extra_flags" -- , argType = TBasicType TUInt32 -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "PCRE2 extra compile flags" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "error_offset" -- , argType = TBasicType TSize -- , direction = DirectionOut -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "return location to store the error offset" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferEverything -- } -- ] -- Lengths: [] -- returnType: Just (TInterface Name { namespace = "Vte" , name = "Regex" }) -- throws : True -- Skip return : False foreign import ccall "vte_regex_new_for_match_full" vte_regex_new_for_match_full :: CString -> -- pattern : TBasicType TUTF8 DI.Int64 -> -- pattern_length : TBasicType TSSize Word32 -> -- flags : TBasicType TUInt32 Word32 -> -- extra_flags : TBasicType TUInt32 Ptr FCT.CSize -> -- error_offset : TBasicType TSize 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, and man:pcre2api(3) for -- information about the supported /@flags@/ and /@extraFlags@/. -- -- The regex will be compiled using \<literal>PCRE2_UTF\<\/literal> and -- possibly other flags, in addition to the flags supplied in /@flags@/. -- -- If regex compilation fails, /@error@/ will be set and /@errorOffset@/ point -- to error as an offset into /@pattern@/. -- -- /Since: 0.76/ regexNewForMatchFull :: (B.CallStack.HasCallStack, MonadIO m) => T.Text -- ^ /@pattern@/: a regex pattern string -> DI.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 -> Word32 -- ^ /@extraFlags@/: PCRE2 extra compile flags -> m ((Regex, FCT.CSize)) -- ^ __Returns:__ a newly created t'GI.Vte.Structs.Regex.Regex', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/ regexNewForMatchFull :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> Int64 -> Word32 -> Word32 -> m (Regex, CSize) regexNewForMatchFull Text pattern Int64 patternLength Word32 flags Word32 extraFlags = IO (Regex, CSize) -> m (Regex, CSize) forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Regex, CSize) -> m (Regex, CSize)) -> IO (Regex, CSize) -> m (Regex, CSize) forall a b. (a -> b) -> a -> b $ do pattern' <- Text -> IO CString textToCString Text pattern errorOffset <- allocMem :: IO (Ptr FCT.CSize) onException (do result <- propagateGError $ vte_regex_new_for_match_full pattern' patternLength flags extraFlags errorOffset checkUnexpectedReturnNULL "regexNewForMatchFull" result result' <- (wrapBoxed Regex) result errorOffset' <- peek errorOffset freeMem pattern' freeMem errorOffset return (result', errorOffset') ) (do freeMem pattern' freeMem errorOffset ) #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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "pattern_length" -- , argType = TBasicType TSSize -- , 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 -- , argCallbackUserData = 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 -- , argCallbackUserData = 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 DI.Int64 -> -- pattern_length : TBasicType TSSize 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, and man:pcre2api(3) for -- information about the supported /@flags@/. -- -- The regex will be compiled using \<literal>PCRE2_UTF\<\/literal> 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 -> DI.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 a. IO a -> m a 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 pattern' <- Text -> IO CString textToCString Text pattern onException (do result <- propagateGError $ vte_regex_new_for_search pattern' patternLength flags checkUnexpectedReturnNULL "regexNewForSearch" result result' <- (wrapBoxed Regex) result freeMem pattern' return result' ) (do freeMem pattern' ) #if defined(ENABLE_OVERLOADING) #endif -- method Regex::new_for_search_full -- 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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "pattern_length" -- , argType = TBasicType TSSize -- , 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 -- , argCallbackUserData = 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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "extra_flags" -- , argType = TBasicType TUInt32 -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation { rawDocText = Nothing , sinceVersion = Nothing } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "error_offset" -- , argType = TBasicType TSize -- , direction = DirectionOut -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "return location to store the error offset" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = False -- , transfer = TransferEverything -- } -- ] -- Lengths: [] -- returnType: Just (TInterface Name { namespace = "Vte" , name = "Regex" }) -- throws : True -- Skip return : False foreign import ccall "vte_regex_new_for_search_full" vte_regex_new_for_search_full :: CString -> -- pattern : TBasicType TUTF8 DI.Int64 -> -- pattern_length : TBasicType TSSize Word32 -> -- flags : TBasicType TUInt32 Word32 -> -- extra_flags : TBasicType TUInt32 Ptr FCT.CSize -> -- error_offset : TBasicType TSize 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, and man:pcre2api(3) for -- information about the supported /@flags@/ and /@extraFlags@/. -- -- The regex will be compiled using \<literal>PCRE2_UTF\<\/literal> and -- possibly other flags, in addition to the flags supplied in /@flags@/. -- -- If regex compilation fails, /@error@/ will be set and /@errorOffset@/ point -- to error as an offset into /@pattern@/. -- -- /Since: 0.76/ regexNewForSearchFull :: (B.CallStack.HasCallStack, MonadIO m) => T.Text -- ^ /@pattern@/: a regex pattern string -> DI.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 -> Word32 -> m ((Regex, FCT.CSize)) -- ^ __Returns:__ a newly created t'GI.Vte.Structs.Regex.Regex', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/ regexNewForSearchFull :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> Int64 -> Word32 -> Word32 -> m (Regex, CSize) regexNewForSearchFull Text pattern Int64 patternLength Word32 flags Word32 extraFlags = IO (Regex, CSize) -> m (Regex, CSize) forall a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Regex, CSize) -> m (Regex, CSize)) -> IO (Regex, CSize) -> m (Regex, CSize) forall a b. (a -> b) -> a -> b $ do pattern' <- Text -> IO CString textToCString Text pattern errorOffset <- allocMem :: IO (Ptr FCT.CSize) onException (do result <- propagateGError $ vte_regex_new_for_search_full pattern' patternLength flags extraFlags errorOffset checkUnexpectedReturnNULL "regexNewForSearchFull" result result' <- (wrapBoxed Regex) result errorOffset' <- peek errorOffset freeMem pattern' freeMem errorOffset return (result', errorOffset') ) (do freeMem pattern' freeMem errorOffset ) #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 -- , argCallbackUserData = False -- , transfer = TransferNothing -- } -- , Arg -- { argCName = "flags" -- , argType = TBasicType TUInt32 -- , direction = DirectionIn -- , mayBeNull = False -- , argDoc = -- Documentation -- { rawDocText = Just "PCRE2 JIT flags, or 0" -- , sinceVersion = Nothing -- } -- , argScope = ScopeTypeInvalid -- , argClosure = -1 -- , argDestroy = -1 -- , argCallerAllocates = False -- , argCallbackUserData = 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 -- ^ /@flags@/: PCRE2 JIT flags, or 0 -> 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 a. IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ do regex' <- Regex -> IO (Ptr Regex) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Regex regex onException (do _ <- propagateGError $ vte_regex_jit regex' flags touchManagedPtr regex return () ) (do 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 = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Vte.Structs.Regex.regexJit", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/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 -- , argCallbackUserData = 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 a. IO a -> m a 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 regex' <- Regex -> IO (Ptr Regex) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Regex regex result <- vte_regex_ref regex' checkUnexpectedReturnNULL "regexRef" result result' <- (wrapBoxed Regex) result touchManagedPtr regex return 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 = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Vte.Structs.Regex.regexRef", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/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 -- , argCallbackUserData = 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 -- , argCallbackUserData = 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 -- , argCallbackUserData = 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 -- , argCallbackUserData = 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) and man:pcre2_substitute(3) 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 a. IO a -> m a 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 regex' <- Regex -> IO (Ptr Regex) forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) unsafeManagedPtrGetPtr Regex regex subject' <- textToCString subject replacement' <- textToCString replacement onException (do result <- propagateGError $ vte_regex_substitute regex' subject' replacement' flags checkUnexpectedReturnNULL "regexSubstitute" result result' <- cstringToText result freeMem result touchManagedPtr regex freeMem subject' freeMem replacement' return result' ) (do freeMem subject' freeMem 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 = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Vte.Structs.Regex.regexSubstitute", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/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 -- , argCallbackUserData = 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 a. IO a -> m a 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 regex' <- Regex -> IO (Ptr Regex) forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a) B.ManagedPtr.disownBoxed Regex regex result <- vte_regex_unref regex' checkUnexpectedReturnNULL "regexUnref" result result' <- (wrapBoxed Regex) result touchManagedPtr regex return 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 = P.Just (O.ResolvedSymbolInfo { O.resolvedSymbolName = "GI.Vte.Structs.Regex.regexUnref", O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-vte-2.91.35/docs/GI-Vte-Structs-Regex.html#v:regexUnref" }) #endif #if defined(ENABLE_OVERLOADING) type family ResolveRegexMethod (t :: Symbol) (o :: DK.Type) :: DK.Type 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