{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.GLib.Structs.MatchInfo
(
MatchInfo(..) ,
#if defined(ENABLE_OVERLOADING)
ResolveMatchInfoMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
MatchInfoExpandReferencesMethodInfo ,
#endif
matchInfoExpandReferences ,
#if defined(ENABLE_OVERLOADING)
MatchInfoFetchMethodInfo ,
#endif
matchInfoFetch ,
#if defined(ENABLE_OVERLOADING)
MatchInfoFetchAllMethodInfo ,
#endif
matchInfoFetchAll ,
#if defined(ENABLE_OVERLOADING)
MatchInfoFetchNamedMethodInfo ,
#endif
matchInfoFetchNamed ,
#if defined(ENABLE_OVERLOADING)
MatchInfoFetchNamedPosMethodInfo ,
#endif
matchInfoFetchNamedPos ,
#if defined(ENABLE_OVERLOADING)
MatchInfoFetchPosMethodInfo ,
#endif
matchInfoFetchPos ,
#if defined(ENABLE_OVERLOADING)
MatchInfoFreeMethodInfo ,
#endif
matchInfoFree ,
#if defined(ENABLE_OVERLOADING)
MatchInfoGetMatchCountMethodInfo ,
#endif
matchInfoGetMatchCount ,
#if defined(ENABLE_OVERLOADING)
MatchInfoGetRegexMethodInfo ,
#endif
matchInfoGetRegex ,
#if defined(ENABLE_OVERLOADING)
MatchInfoGetStringMethodInfo ,
#endif
matchInfoGetString ,
#if defined(ENABLE_OVERLOADING)
MatchInfoIsPartialMatchMethodInfo ,
#endif
matchInfoIsPartialMatch ,
#if defined(ENABLE_OVERLOADING)
MatchInfoMatchesMethodInfo ,
#endif
matchInfoMatches ,
#if defined(ENABLE_OVERLOADING)
MatchInfoNextMethodInfo ,
#endif
matchInfoNext ,
#if defined(ENABLE_OVERLOADING)
MatchInfoRefMethodInfo ,
#endif
matchInfoRef ,
#if defined(ENABLE_OVERLOADING)
MatchInfoUnrefMethodInfo ,
#endif
matchInfoUnref ,
) 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.Coerce as Coerce
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
import {-# SOURCE #-} qualified GI.GLib.Structs.Regex as GLib.Regex
newtype MatchInfo = MatchInfo (SP.ManagedPtr MatchInfo)
deriving (MatchInfo -> MatchInfo -> Bool
(MatchInfo -> MatchInfo -> Bool)
-> (MatchInfo -> MatchInfo -> Bool) -> Eq MatchInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchInfo -> MatchInfo -> Bool
$c/= :: MatchInfo -> MatchInfo -> Bool
== :: MatchInfo -> MatchInfo -> Bool
$c== :: MatchInfo -> MatchInfo -> Bool
Eq)
instance SP.ManagedPtrNewtype MatchInfo where
toManagedPtr :: MatchInfo -> ManagedPtr MatchInfo
toManagedPtr (MatchInfo ManagedPtr MatchInfo
p) = ManagedPtr MatchInfo
p
foreign import ccall "g_match_info_get_type" c_g_match_info_get_type ::
IO GType
type instance O.ParentTypes MatchInfo = '[]
instance O.HasParentTypes MatchInfo
instance B.Types.TypedObject MatchInfo where
glibType :: IO GType
glibType = IO GType
c_g_match_info_get_type
instance B.Types.GBoxed MatchInfo
instance B.GValue.IsGValue (Maybe MatchInfo) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_match_info_get_type
gvalueSet_ :: Ptr GValue -> Maybe MatchInfo -> IO ()
gvalueSet_ Ptr GValue
gv Maybe MatchInfo
P.Nothing = Ptr GValue -> Ptr MatchInfo -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr MatchInfo
forall a. Ptr a
FP.nullPtr :: FP.Ptr MatchInfo)
gvalueSet_ Ptr GValue
gv (P.Just MatchInfo
obj) = MatchInfo -> (Ptr MatchInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MatchInfo
obj (Ptr GValue -> Ptr MatchInfo -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe MatchInfo)
gvalueGet_ Ptr GValue
gv = do
Ptr MatchInfo
ptr <- Ptr GValue -> IO (Ptr MatchInfo)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr MatchInfo)
if Ptr MatchInfo
ptr Ptr MatchInfo -> Ptr MatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr MatchInfo
forall a. Ptr a
FP.nullPtr
then MatchInfo -> Maybe MatchInfo
forall a. a -> Maybe a
P.Just (MatchInfo -> Maybe MatchInfo)
-> IO MatchInfo -> IO (Maybe MatchInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr MatchInfo -> MatchInfo)
-> Ptr MatchInfo -> IO MatchInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr MatchInfo -> MatchInfo
MatchInfo Ptr MatchInfo
ptr
else Maybe MatchInfo -> IO (Maybe MatchInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MatchInfo
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MatchInfo
type instance O.AttributeList MatchInfo = MatchInfoAttributeList
type MatchInfoAttributeList = ('[ ] :: [(Symbol, *)])
#endif
foreign import ccall "g_match_info_expand_references" g_match_info_expand_references ::
Ptr MatchInfo ->
CString ->
Ptr (Ptr GError) ->
IO CString
matchInfoExpandReferences ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> T.Text
-> m (Maybe T.Text)
matchInfoExpandReferences :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> Text -> m (Maybe Text)
matchInfoExpandReferences MatchInfo
matchInfo Text
stringToExpand = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CString
stringToExpand' <- Text -> IO CString
textToCString Text
stringToExpand
IO (Maybe Text) -> IO () -> IO (Maybe 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 MatchInfo -> CString -> Ptr (Ptr GError) -> IO CString
g_match_info_expand_references Ptr MatchInfo
matchInfo' CString
stringToExpand'
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'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stringToExpand'
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
stringToExpand'
)
#if defined(ENABLE_OVERLOADING)
data MatchInfoExpandReferencesMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod MatchInfoExpandReferencesMethodInfo MatchInfo signature where
overloadedMethod = matchInfoExpandReferences
instance O.OverloadedMethodInfo MatchInfoExpandReferencesMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoExpandReferences",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoExpandReferences"
})
#endif
foreign import ccall "g_match_info_fetch" g_match_info_fetch ::
Ptr MatchInfo ->
Int32 ->
IO CString
matchInfoFetch ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> Int32
-> m (Maybe T.Text)
matchInfoFetch :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> Int32 -> m (Maybe Text)
matchInfoFetch MatchInfo
matchInfo Int32
matchNum = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CString
result <- Ptr MatchInfo -> Int32 -> IO CString
g_match_info_fetch Ptr MatchInfo
matchInfo' Int32
matchNum
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'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data MatchInfoFetchMethodInfo
instance (signature ~ (Int32 -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod MatchInfoFetchMethodInfo MatchInfo signature where
overloadedMethod = matchInfoFetch
instance O.OverloadedMethodInfo MatchInfoFetchMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoFetch",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoFetch"
})
#endif
foreign import ccall "g_match_info_fetch_all" g_match_info_fetch_all ::
Ptr MatchInfo ->
IO (Ptr CString)
matchInfoFetchAll ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m [T.Text]
matchInfoFetchAll :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m [Text]
matchInfoFetchAll MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Ptr CString
result <- Ptr MatchInfo -> IO (Ptr CString)
g_match_info_fetch_all Ptr MatchInfo
matchInfo'
Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matchInfoFetchAll" Ptr CString
result
[Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
(CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
[Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'
#if defined(ENABLE_OVERLOADING)
data MatchInfoFetchAllMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod MatchInfoFetchAllMethodInfo MatchInfo signature where
overloadedMethod = matchInfoFetchAll
instance O.OverloadedMethodInfo MatchInfoFetchAllMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoFetchAll",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoFetchAll"
})
#endif
foreign import ccall "g_match_info_fetch_named" g_match_info_fetch_named ::
Ptr MatchInfo ->
CString ->
IO CString
matchInfoFetchNamed ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> T.Text
-> m (Maybe T.Text)
matchInfoFetchNamed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> Text -> m (Maybe Text)
matchInfoFetchNamed MatchInfo
matchInfo Text
name = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CString
name' <- Text -> IO CString
textToCString Text
name
CString
result <- Ptr MatchInfo -> CString -> IO CString
g_match_info_fetch_named Ptr MatchInfo
matchInfo' CString
name'
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'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data MatchInfoFetchNamedMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod MatchInfoFetchNamedMethodInfo MatchInfo signature where
overloadedMethod = matchInfoFetchNamed
instance O.OverloadedMethodInfo MatchInfoFetchNamedMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoFetchNamed",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoFetchNamed"
})
#endif
foreign import ccall "g_match_info_fetch_named_pos" g_match_info_fetch_named_pos ::
Ptr MatchInfo ->
CString ->
Ptr Int32 ->
Ptr Int32 ->
IO CInt
matchInfoFetchNamedPos ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> T.Text
-> m ((Bool, Int32, Int32))
matchInfoFetchNamedPos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> Text -> m (Bool, Int32, Int32)
matchInfoFetchNamedPos MatchInfo
matchInfo Text
name = IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32))
-> IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
Ptr MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr Int32
startPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
Ptr Int32
endPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
CInt
result <- Ptr MatchInfo -> CString -> Ptr Int32 -> Ptr Int32 -> IO CInt
g_match_info_fetch_named_pos Ptr MatchInfo
matchInfo' CString
name' Ptr Int32
startPos Ptr Int32
endPos
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
Int32
startPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
startPos
Int32
endPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
endPos
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
startPos
Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
endPos
(Bool, Int32, Int32) -> IO (Bool, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
startPos', Int32
endPos')
#if defined(ENABLE_OVERLOADING)
data MatchInfoFetchNamedPosMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Int32, Int32))), MonadIO m) => O.OverloadedMethod MatchInfoFetchNamedPosMethodInfo MatchInfo signature where
overloadedMethod = matchInfoFetchNamedPos
instance O.OverloadedMethodInfo MatchInfoFetchNamedPosMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoFetchNamedPos",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoFetchNamedPos"
})
#endif
foreign import ccall "g_match_info_fetch_pos" g_match_info_fetch_pos ::
Ptr MatchInfo ->
Int32 ->
Ptr Int32 ->
Ptr Int32 ->
IO CInt
matchInfoFetchPos ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> Int32
-> m ((Bool, Int32, Int32))
matchInfoFetchPos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> Int32 -> m (Bool, Int32, Int32)
matchInfoFetchPos MatchInfo
matchInfo Int32
matchNum = IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32))
-> IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
Ptr MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Ptr Int32
startPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
Ptr Int32
endPos <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
CInt
result <- Ptr MatchInfo -> Int32 -> Ptr Int32 -> Ptr Int32 -> IO CInt
g_match_info_fetch_pos Ptr MatchInfo
matchInfo' Int32
matchNum Ptr Int32
startPos Ptr Int32
endPos
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
Int32
startPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
startPos
Int32
endPos' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
endPos
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
startPos
Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
endPos
(Bool, Int32, Int32) -> IO (Bool, Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
startPos', Int32
endPos')
#if defined(ENABLE_OVERLOADING)
data MatchInfoFetchPosMethodInfo
instance (signature ~ (Int32 -> m ((Bool, Int32, Int32))), MonadIO m) => O.OverloadedMethod MatchInfoFetchPosMethodInfo MatchInfo signature where
overloadedMethod = matchInfoFetchPos
instance O.OverloadedMethodInfo MatchInfoFetchPosMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoFetchPos",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoFetchPos"
})
#endif
foreign import ccall "g_match_info_free" g_match_info_free ::
Ptr MatchInfo ->
IO ()
matchInfoFree ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m ()
matchInfoFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m ()
matchInfoFree MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Ptr MatchInfo -> IO ()
g_match_info_free Ptr MatchInfo
matchInfo'
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data MatchInfoFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MatchInfoFreeMethodInfo MatchInfo signature where
overloadedMethod = matchInfoFree
instance O.OverloadedMethodInfo MatchInfoFreeMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoFree",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoFree"
})
#endif
foreign import ccall "g_match_info_get_match_count" g_match_info_get_match_count ::
Ptr MatchInfo ->
IO Int32
matchInfoGetMatchCount ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m Int32
matchInfoGetMatchCount :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m Int32
matchInfoGetMatchCount MatchInfo
matchInfo = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
Ptr MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Int32
result <- Ptr MatchInfo -> IO Int32
g_match_info_get_match_count Ptr MatchInfo
matchInfo'
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data MatchInfoGetMatchCountMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod MatchInfoGetMatchCountMethodInfo MatchInfo signature where
overloadedMethod = matchInfoGetMatchCount
instance O.OverloadedMethodInfo MatchInfoGetMatchCountMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoGetMatchCount",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoGetMatchCount"
})
#endif
foreign import ccall "g_match_info_get_regex" g_match_info_get_regex ::
Ptr MatchInfo ->
IO (Ptr GLib.Regex.Regex)
matchInfoGetRegex ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m GLib.Regex.Regex
matchInfoGetRegex :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m Regex
matchInfoGetRegex MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Ptr Regex
result <- Ptr MatchInfo -> IO (Ptr Regex)
g_match_info_get_regex Ptr MatchInfo
matchInfo'
Text -> Ptr Regex -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matchInfoGetRegex" 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
GLib.Regex.Regex) Ptr Regex
result
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Regex -> IO Regex
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
result'
#if defined(ENABLE_OVERLOADING)
data MatchInfoGetRegexMethodInfo
instance (signature ~ (m GLib.Regex.Regex), MonadIO m) => O.OverloadedMethod MatchInfoGetRegexMethodInfo MatchInfo signature where
overloadedMethod = matchInfoGetRegex
instance O.OverloadedMethodInfo MatchInfoGetRegexMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoGetRegex",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoGetRegex"
})
#endif
foreign import ccall "g_match_info_get_string" g_match_info_get_string ::
Ptr MatchInfo ->
IO CString
matchInfoGetString ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m T.Text
matchInfoGetString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m Text
matchInfoGetString MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CString
result <- Ptr MatchInfo -> IO CString
g_match_info_get_string Ptr MatchInfo
matchInfo'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matchInfoGetString" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data MatchInfoGetStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod MatchInfoGetStringMethodInfo MatchInfo signature where
overloadedMethod = matchInfoGetString
instance O.OverloadedMethodInfo MatchInfoGetStringMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoGetString",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoGetString"
})
#endif
foreign import ccall "g_match_info_is_partial_match" g_match_info_is_partial_match ::
Ptr MatchInfo ->
IO CInt
matchInfoIsPartialMatch ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m Bool
matchInfoIsPartialMatch :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m Bool
matchInfoIsPartialMatch MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CInt
result <- Ptr MatchInfo -> IO CInt
g_match_info_is_partial_match Ptr MatchInfo
matchInfo'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data MatchInfoIsPartialMatchMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod MatchInfoIsPartialMatchMethodInfo MatchInfo signature where
overloadedMethod = matchInfoIsPartialMatch
instance O.OverloadedMethodInfo MatchInfoIsPartialMatchMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoIsPartialMatch",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoIsPartialMatch"
})
#endif
foreign import ccall "g_match_info_matches" g_match_info_matches ::
Ptr MatchInfo ->
IO CInt
matchInfoMatches ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m Bool
matchInfoMatches :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m Bool
matchInfoMatches MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
CInt
result <- Ptr MatchInfo -> IO CInt
g_match_info_matches Ptr MatchInfo
matchInfo'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data MatchInfoMatchesMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod MatchInfoMatchesMethodInfo MatchInfo signature where
overloadedMethod = matchInfoMatches
instance O.OverloadedMethodInfo MatchInfoMatchesMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoMatches",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoMatches"
})
#endif
foreign import ccall "g_match_info_next" g_match_info_next ::
Ptr MatchInfo ->
Ptr (Ptr GError) ->
IO CInt
matchInfoNext ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m ()
matchInfoNext :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m ()
matchInfoNext MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
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 MatchInfo -> Ptr (Ptr GError) -> IO CInt
g_match_info_next Ptr MatchInfo
matchInfo'
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
() -> 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 MatchInfoNextMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MatchInfoNextMethodInfo MatchInfo signature where
overloadedMethod = matchInfoNext
instance O.OverloadedMethodInfo MatchInfoNextMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoNext",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoNext"
})
#endif
foreign import ccall "g_match_info_ref" g_match_info_ref ::
Ptr MatchInfo ->
IO (Ptr MatchInfo)
matchInfoRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m MatchInfo
matchInfoRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m MatchInfo
matchInfoRef MatchInfo
matchInfo = IO MatchInfo -> m MatchInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MatchInfo -> m MatchInfo) -> IO MatchInfo -> m MatchInfo
forall a b. (a -> b) -> a -> b
$ do
Ptr MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Ptr MatchInfo
result <- Ptr MatchInfo -> IO (Ptr MatchInfo)
g_match_info_ref Ptr MatchInfo
matchInfo'
Text -> Ptr MatchInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"matchInfoRef" Ptr MatchInfo
result
MatchInfo
result' <- ((ManagedPtr MatchInfo -> MatchInfo)
-> Ptr MatchInfo -> IO MatchInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MatchInfo -> MatchInfo
MatchInfo) Ptr MatchInfo
result
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
MatchInfo -> IO MatchInfo
forall (m :: * -> *) a. Monad m => a -> m a
return MatchInfo
result'
#if defined(ENABLE_OVERLOADING)
data MatchInfoRefMethodInfo
instance (signature ~ (m MatchInfo), MonadIO m) => O.OverloadedMethod MatchInfoRefMethodInfo MatchInfo signature where
overloadedMethod = matchInfoRef
instance O.OverloadedMethodInfo MatchInfoRefMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoRef",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoRef"
})
#endif
foreign import ccall "g_match_info_unref" g_match_info_unref ::
Ptr MatchInfo ->
IO ()
matchInfoUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
MatchInfo
-> m ()
matchInfoUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MatchInfo -> m ()
matchInfoUnref MatchInfo
matchInfo = 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 MatchInfo
matchInfo' <- MatchInfo -> IO (Ptr MatchInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MatchInfo
matchInfo
Ptr MatchInfo -> IO ()
g_match_info_unref Ptr MatchInfo
matchInfo'
MatchInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MatchInfo
matchInfo
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data MatchInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MatchInfoUnrefMethodInfo MatchInfo signature where
overloadedMethod = matchInfoUnref
instance O.OverloadedMethodInfo MatchInfoUnrefMethodInfo MatchInfo where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.GLib.Structs.MatchInfo.matchInfoUnref",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-glib-2.0.26/docs/GI-GLib-Structs-MatchInfo.html#v:matchInfoUnref"
})
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveMatchInfoMethod (t :: Symbol) (o :: *) :: * where
ResolveMatchInfoMethod "expandReferences" o = MatchInfoExpandReferencesMethodInfo
ResolveMatchInfoMethod "fetch" o = MatchInfoFetchMethodInfo
ResolveMatchInfoMethod "fetchAll" o = MatchInfoFetchAllMethodInfo
ResolveMatchInfoMethod "fetchNamed" o = MatchInfoFetchNamedMethodInfo
ResolveMatchInfoMethod "fetchNamedPos" o = MatchInfoFetchNamedPosMethodInfo
ResolveMatchInfoMethod "fetchPos" o = MatchInfoFetchPosMethodInfo
ResolveMatchInfoMethod "free" o = MatchInfoFreeMethodInfo
ResolveMatchInfoMethod "isPartialMatch" o = MatchInfoIsPartialMatchMethodInfo
ResolveMatchInfoMethod "matches" o = MatchInfoMatchesMethodInfo
ResolveMatchInfoMethod "next" o = MatchInfoNextMethodInfo
ResolveMatchInfoMethod "ref" o = MatchInfoRefMethodInfo
ResolveMatchInfoMethod "unref" o = MatchInfoUnrefMethodInfo
ResolveMatchInfoMethod "getMatchCount" o = MatchInfoGetMatchCountMethodInfo
ResolveMatchInfoMethod "getRegex" o = MatchInfoGetRegexMethodInfo
ResolveMatchInfoMethod "getString" o = MatchInfoGetStringMethodInfo
ResolveMatchInfoMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveMatchInfoMethod t MatchInfo, O.OverloadedMethod info MatchInfo p) => OL.IsLabel t (MatchInfo -> 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 ~ ResolveMatchInfoMethod t MatchInfo, O.OverloadedMethod info MatchInfo p, R.HasField t MatchInfo p) => R.HasField t MatchInfo p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveMatchInfoMethod t MatchInfo, O.OverloadedMethodInfo info MatchInfo) => OL.IsLabel t (O.MethodProxy info MatchInfo) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif