{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Structs.IPRoutingRule
(
IPRoutingRule(..) ,
#if defined(ENABLE_OVERLOADING)
ResolveIPRoutingRuleMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleCmpMethodInfo ,
#endif
iPRoutingRuleCmp ,
iPRoutingRuleFromString ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetActionMethodInfo ,
#endif
iPRoutingRuleGetAction ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetAddrFamilyMethodInfo ,
#endif
iPRoutingRuleGetAddrFamily ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetDestinationPortEndMethodInfo,
#endif
iPRoutingRuleGetDestinationPortEnd ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetDestinationPortStartMethodInfo,
#endif
iPRoutingRuleGetDestinationPortStart ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetFromMethodInfo ,
#endif
iPRoutingRuleGetFrom ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetFromLenMethodInfo ,
#endif
iPRoutingRuleGetFromLen ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetFwmarkMethodInfo ,
#endif
iPRoutingRuleGetFwmark ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetFwmaskMethodInfo ,
#endif
iPRoutingRuleGetFwmask ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetIifnameMethodInfo ,
#endif
iPRoutingRuleGetIifname ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetInvertMethodInfo ,
#endif
iPRoutingRuleGetInvert ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetIpprotoMethodInfo ,
#endif
iPRoutingRuleGetIpproto ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetOifnameMethodInfo ,
#endif
iPRoutingRuleGetOifname ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetPriorityMethodInfo ,
#endif
iPRoutingRuleGetPriority ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetSourcePortEndMethodInfo ,
#endif
iPRoutingRuleGetSourcePortEnd ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetSourcePortStartMethodInfo,
#endif
iPRoutingRuleGetSourcePortStart ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetSuppressPrefixlengthMethodInfo,
#endif
iPRoutingRuleGetSuppressPrefixlength ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetTableMethodInfo ,
#endif
iPRoutingRuleGetTable ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetToMethodInfo ,
#endif
iPRoutingRuleGetTo ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetToLenMethodInfo ,
#endif
iPRoutingRuleGetToLen ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetTosMethodInfo ,
#endif
iPRoutingRuleGetTos ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleGetUidRangeMethodInfo ,
#endif
iPRoutingRuleGetUidRange ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleIsSealedMethodInfo ,
#endif
iPRoutingRuleIsSealed ,
iPRoutingRuleNew ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleNewCloneMethodInfo ,
#endif
iPRoutingRuleNewClone ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleRefMethodInfo ,
#endif
iPRoutingRuleRef ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSealMethodInfo ,
#endif
iPRoutingRuleSeal ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetActionMethodInfo ,
#endif
iPRoutingRuleSetAction ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetDestinationPortMethodInfo,
#endif
iPRoutingRuleSetDestinationPort ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetFromMethodInfo ,
#endif
iPRoutingRuleSetFrom ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetFwmarkMethodInfo ,
#endif
iPRoutingRuleSetFwmark ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetIifnameMethodInfo ,
#endif
iPRoutingRuleSetIifname ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetInvertMethodInfo ,
#endif
iPRoutingRuleSetInvert ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetIpprotoMethodInfo ,
#endif
iPRoutingRuleSetIpproto ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetOifnameMethodInfo ,
#endif
iPRoutingRuleSetOifname ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetPriorityMethodInfo ,
#endif
iPRoutingRuleSetPriority ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetSourcePortMethodInfo ,
#endif
iPRoutingRuleSetSourcePort ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetSuppressPrefixlengthMethodInfo,
#endif
iPRoutingRuleSetSuppressPrefixlength ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetTableMethodInfo ,
#endif
iPRoutingRuleSetTable ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetToMethodInfo ,
#endif
iPRoutingRuleSetTo ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetTosMethodInfo ,
#endif
iPRoutingRuleSetTos ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleSetUidRangeMethodInfo ,
#endif
iPRoutingRuleSetUidRange ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleToStringMethodInfo ,
#endif
iPRoutingRuleToString ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleUnrefMethodInfo ,
#endif
iPRoutingRuleUnref ,
#if defined(ENABLE_OVERLOADING)
IPRoutingRuleValidateMethodInfo ,
#endif
iPRoutingRuleValidate ,
) 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
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
#else
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
#endif
newtype IPRoutingRule = IPRoutingRule (SP.ManagedPtr IPRoutingRule)
deriving (IPRoutingRule -> IPRoutingRule -> Bool
(IPRoutingRule -> IPRoutingRule -> Bool)
-> (IPRoutingRule -> IPRoutingRule -> Bool) -> Eq IPRoutingRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPRoutingRule -> IPRoutingRule -> Bool
== :: IPRoutingRule -> IPRoutingRule -> Bool
$c/= :: IPRoutingRule -> IPRoutingRule -> Bool
/= :: IPRoutingRule -> IPRoutingRule -> Bool
Eq)
instance SP.ManagedPtrNewtype IPRoutingRule where
toManagedPtr :: IPRoutingRule -> ManagedPtr IPRoutingRule
toManagedPtr (IPRoutingRule ManagedPtr IPRoutingRule
p) = ManagedPtr IPRoutingRule
p
foreign import ccall "nm_ip_routing_rule_get_type" c_nm_ip_routing_rule_get_type ::
IO GType
type instance O.ParentTypes IPRoutingRule = '[]
instance O.HasParentTypes IPRoutingRule
instance B.Types.TypedObject IPRoutingRule where
glibType :: IO GType
glibType = IO GType
c_nm_ip_routing_rule_get_type
instance B.Types.GBoxed IPRoutingRule
instance B.GValue.IsGValue (Maybe IPRoutingRule) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_ip_routing_rule_get_type
gvalueSet_ :: Ptr GValue -> Maybe IPRoutingRule -> IO ()
gvalueSet_ Ptr GValue
gv Maybe IPRoutingRule
P.Nothing = Ptr GValue -> Ptr IPRoutingRule -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr IPRoutingRule
forall a. Ptr a
FP.nullPtr :: FP.Ptr IPRoutingRule)
gvalueSet_ Ptr GValue
gv (P.Just IPRoutingRule
obj) = IPRoutingRule -> (Ptr IPRoutingRule -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr IPRoutingRule
obj (Ptr GValue -> Ptr IPRoutingRule -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe IPRoutingRule)
gvalueGet_ Ptr GValue
gv = do
Ptr IPRoutingRule
ptr <- Ptr GValue -> IO (Ptr IPRoutingRule)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr IPRoutingRule)
if Ptr IPRoutingRule
ptr Ptr IPRoutingRule -> Ptr IPRoutingRule -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr IPRoutingRule
forall a. Ptr a
FP.nullPtr
then IPRoutingRule -> Maybe IPRoutingRule
forall a. a -> Maybe a
P.Just (IPRoutingRule -> Maybe IPRoutingRule)
-> IO IPRoutingRule -> IO (Maybe IPRoutingRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr IPRoutingRule -> IPRoutingRule)
-> Ptr IPRoutingRule -> IO IPRoutingRule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr IPRoutingRule -> IPRoutingRule
IPRoutingRule Ptr IPRoutingRule
ptr
else Maybe IPRoutingRule -> IO (Maybe IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IPRoutingRule
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IPRoutingRule
type instance O.AttributeList IPRoutingRule = IPRoutingRuleAttributeList
type IPRoutingRuleAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_ip_routing_rule_new" nm_ip_routing_rule_new ::
Int32 ->
IO (Ptr IPRoutingRule)
iPRoutingRuleNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
Int32
-> m IPRoutingRule
iPRoutingRuleNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m IPRoutingRule
iPRoutingRuleNew Int32
addrFamily = IO IPRoutingRule -> m IPRoutingRule
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoutingRule -> m IPRoutingRule)
-> IO IPRoutingRule -> m IPRoutingRule
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
result <- Int32 -> IO (Ptr IPRoutingRule)
nm_ip_routing_rule_new Int32
addrFamily
Text -> Ptr IPRoutingRule -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleNew" Ptr IPRoutingRule
result
IPRoutingRule
result' <- ((ManagedPtr IPRoutingRule -> IPRoutingRule)
-> Ptr IPRoutingRule -> IO IPRoutingRule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoutingRule -> IPRoutingRule
IPRoutingRule) Ptr IPRoutingRule
result
IPRoutingRule -> IO IPRoutingRule
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoutingRule
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "nm_ip_routing_rule_cmp" nm_ip_routing_rule_cmp ::
Ptr IPRoutingRule ->
Ptr IPRoutingRule ->
IO Int32
iPRoutingRuleCmp ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (IPRoutingRule)
-> Maybe (IPRoutingRule)
-> m Int32
iPRoutingRuleCmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe IPRoutingRule -> Maybe IPRoutingRule -> m Int32
iPRoutingRuleCmp Maybe IPRoutingRule
rule Maybe IPRoutingRule
other = IO Int32 -> m Int32
forall a. IO a -> m a
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 IPRoutingRule
maybeRule <- case Maybe IPRoutingRule
rule of
Maybe IPRoutingRule
Nothing -> Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
forall a. Ptr a
FP.nullPtr
Just IPRoutingRule
jRule -> do
Ptr IPRoutingRule
jRule' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
jRule
Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
jRule'
Ptr IPRoutingRule
maybeOther <- case Maybe IPRoutingRule
other of
Maybe IPRoutingRule
Nothing -> Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
forall a. Ptr a
FP.nullPtr
Just IPRoutingRule
jOther -> do
Ptr IPRoutingRule
jOther' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
jOther
Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
jOther'
Int32
result <- Ptr IPRoutingRule -> Ptr IPRoutingRule -> IO Int32
nm_ip_routing_rule_cmp Ptr IPRoutingRule
maybeRule Ptr IPRoutingRule
maybeOther
Maybe IPRoutingRule -> (IPRoutingRule -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe IPRoutingRule
rule IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
Maybe IPRoutingRule -> (IPRoutingRule -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe IPRoutingRule
other IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleCmpMethodInfo
instance (signature ~ (Maybe (IPRoutingRule) -> m Int32), MonadIO m) => O.OverloadedMethod IPRoutingRuleCmpMethodInfo IPRoutingRule signature where
overloadedMethod i = iPRoutingRuleCmp (Just i)
instance O.OverloadedMethodInfo IPRoutingRuleCmpMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleCmp",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleCmp"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_action" nm_ip_routing_rule_get_action ::
Ptr IPRoutingRule ->
IO Word8
iPRoutingRuleGetAction ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word8
iPRoutingRuleGetAction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word8
iPRoutingRuleGetAction IPRoutingRule
self = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word8
result <- Ptr IPRoutingRule -> IO Word8
nm_ip_routing_rule_get_action Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetActionMethodInfo
instance (signature ~ (m Word8), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetActionMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetAction
instance O.OverloadedMethodInfo IPRoutingRuleGetActionMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetAction",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetAction"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_addr_family" nm_ip_routing_rule_get_addr_family ::
Ptr IPRoutingRule ->
IO Int32
iPRoutingRuleGetAddrFamily ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Int32
iPRoutingRuleGetAddrFamily :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Int32
iPRoutingRuleGetAddrFamily IPRoutingRule
self = IO Int32 -> m Int32
forall a. IO a -> m a
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 IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Int32
result <- Ptr IPRoutingRule -> IO Int32
nm_ip_routing_rule_get_addr_family Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetAddrFamilyMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetAddrFamilyMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetAddrFamily
instance O.OverloadedMethodInfo IPRoutingRuleGetAddrFamilyMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetAddrFamily",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetAddrFamily"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_destination_port_end" nm_ip_routing_rule_get_destination_port_end ::
Ptr IPRoutingRule ->
IO Word16
iPRoutingRuleGetDestinationPortEnd ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word16
iPRoutingRuleGetDestinationPortEnd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word16
iPRoutingRuleGetDestinationPortEnd IPRoutingRule
self = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word16
result <- Ptr IPRoutingRule -> IO Word16
nm_ip_routing_rule_get_destination_port_end Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetDestinationPortEndMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetDestinationPortEndMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetDestinationPortEnd
instance O.OverloadedMethodInfo IPRoutingRuleGetDestinationPortEndMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetDestinationPortEnd",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetDestinationPortEnd"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_destination_port_start" nm_ip_routing_rule_get_destination_port_start ::
Ptr IPRoutingRule ->
IO Word16
iPRoutingRuleGetDestinationPortStart ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word16
iPRoutingRuleGetDestinationPortStart :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word16
iPRoutingRuleGetDestinationPortStart IPRoutingRule
self = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word16
result <- Ptr IPRoutingRule -> IO Word16
nm_ip_routing_rule_get_destination_port_start Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetDestinationPortStartMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetDestinationPortStartMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetDestinationPortStart
instance O.OverloadedMethodInfo IPRoutingRuleGetDestinationPortStartMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetDestinationPortStart",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetDestinationPortStart"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_from" nm_ip_routing_rule_get_from ::
Ptr IPRoutingRule ->
IO CString
iPRoutingRuleGetFrom ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m T.Text
iPRoutingRuleGetFrom :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Text
iPRoutingRuleGetFrom IPRoutingRule
self = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
result <- Ptr IPRoutingRule -> IO CString
nm_ip_routing_rule_get_from Ptr IPRoutingRule
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleGetFrom" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetFromMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetFromMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetFrom
instance O.OverloadedMethodInfo IPRoutingRuleGetFromMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetFrom",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetFrom"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_from_len" nm_ip_routing_rule_get_from_len ::
Ptr IPRoutingRule ->
IO Word8
iPRoutingRuleGetFromLen ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word8
iPRoutingRuleGetFromLen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word8
iPRoutingRuleGetFromLen IPRoutingRule
self = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word8
result <- Ptr IPRoutingRule -> IO Word8
nm_ip_routing_rule_get_from_len Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetFromLenMethodInfo
instance (signature ~ (m Word8), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetFromLenMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetFromLen
instance O.OverloadedMethodInfo IPRoutingRuleGetFromLenMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetFromLen",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetFromLen"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_fwmark" nm_ip_routing_rule_get_fwmark ::
Ptr IPRoutingRule ->
IO Word32
iPRoutingRuleGetFwmark ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word32
iPRoutingRuleGetFwmark :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word32
iPRoutingRuleGetFwmark IPRoutingRule
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word32
result <- Ptr IPRoutingRule -> IO Word32
nm_ip_routing_rule_get_fwmark Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetFwmarkMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetFwmarkMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetFwmark
instance O.OverloadedMethodInfo IPRoutingRuleGetFwmarkMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetFwmark",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetFwmark"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_fwmask" nm_ip_routing_rule_get_fwmask ::
Ptr IPRoutingRule ->
IO Word32
iPRoutingRuleGetFwmask ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word32
iPRoutingRuleGetFwmask :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word32
iPRoutingRuleGetFwmask IPRoutingRule
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word32
result <- Ptr IPRoutingRule -> IO Word32
nm_ip_routing_rule_get_fwmask Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetFwmaskMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetFwmaskMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetFwmask
instance O.OverloadedMethodInfo IPRoutingRuleGetFwmaskMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetFwmask",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetFwmask"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_iifname" nm_ip_routing_rule_get_iifname ::
Ptr IPRoutingRule ->
IO CString
iPRoutingRuleGetIifname ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m T.Text
iPRoutingRuleGetIifname :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Text
iPRoutingRuleGetIifname IPRoutingRule
self = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
result <- Ptr IPRoutingRule -> IO CString
nm_ip_routing_rule_get_iifname Ptr IPRoutingRule
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleGetIifname" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetIifnameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetIifnameMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetIifname
instance O.OverloadedMethodInfo IPRoutingRuleGetIifnameMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetIifname",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetIifname"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_invert" nm_ip_routing_rule_get_invert ::
Ptr IPRoutingRule ->
IO CInt
iPRoutingRuleGetInvert ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Bool
iPRoutingRuleGetInvert :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Bool
iPRoutingRuleGetInvert IPRoutingRule
self = IO Bool -> m Bool
forall a. IO a -> m a
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 IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CInt
result <- Ptr IPRoutingRule -> IO CInt
nm_ip_routing_rule_get_invert Ptr IPRoutingRule
self'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetInvertMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetInvertMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetInvert
instance O.OverloadedMethodInfo IPRoutingRuleGetInvertMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetInvert",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetInvert"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_ipproto" nm_ip_routing_rule_get_ipproto ::
Ptr IPRoutingRule ->
IO Word8
iPRoutingRuleGetIpproto ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word8
iPRoutingRuleGetIpproto :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word8
iPRoutingRuleGetIpproto IPRoutingRule
self = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word8
result <- Ptr IPRoutingRule -> IO Word8
nm_ip_routing_rule_get_ipproto Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetIpprotoMethodInfo
instance (signature ~ (m Word8), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetIpprotoMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetIpproto
instance O.OverloadedMethodInfo IPRoutingRuleGetIpprotoMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetIpproto",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetIpproto"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_oifname" nm_ip_routing_rule_get_oifname ::
Ptr IPRoutingRule ->
IO CString
iPRoutingRuleGetOifname ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m T.Text
iPRoutingRuleGetOifname :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Text
iPRoutingRuleGetOifname IPRoutingRule
self = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
result <- Ptr IPRoutingRule -> IO CString
nm_ip_routing_rule_get_oifname Ptr IPRoutingRule
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleGetOifname" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetOifnameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetOifnameMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetOifname
instance O.OverloadedMethodInfo IPRoutingRuleGetOifnameMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetOifname",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetOifname"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_priority" nm_ip_routing_rule_get_priority ::
Ptr IPRoutingRule ->
IO Int64
iPRoutingRuleGetPriority ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Int64
iPRoutingRuleGetPriority :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Int64
iPRoutingRuleGetPriority IPRoutingRule
self = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Int64
result <- Ptr IPRoutingRule -> IO Int64
nm_ip_routing_rule_get_priority Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetPriorityMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetPriorityMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetPriority
instance O.OverloadedMethodInfo IPRoutingRuleGetPriorityMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetPriority",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetPriority"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_source_port_end" nm_ip_routing_rule_get_source_port_end ::
Ptr IPRoutingRule ->
IO Word16
iPRoutingRuleGetSourcePortEnd ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word16
iPRoutingRuleGetSourcePortEnd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word16
iPRoutingRuleGetSourcePortEnd IPRoutingRule
self = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word16
result <- Ptr IPRoutingRule -> IO Word16
nm_ip_routing_rule_get_source_port_end Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetSourcePortEndMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetSourcePortEndMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetSourcePortEnd
instance O.OverloadedMethodInfo IPRoutingRuleGetSourcePortEndMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetSourcePortEnd",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetSourcePortEnd"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_source_port_start" nm_ip_routing_rule_get_source_port_start ::
Ptr IPRoutingRule ->
IO Word16
iPRoutingRuleGetSourcePortStart ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word16
iPRoutingRuleGetSourcePortStart :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word16
iPRoutingRuleGetSourcePortStart IPRoutingRule
self = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word16
result <- Ptr IPRoutingRule -> IO Word16
nm_ip_routing_rule_get_source_port_start Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetSourcePortStartMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetSourcePortStartMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetSourcePortStart
instance O.OverloadedMethodInfo IPRoutingRuleGetSourcePortStartMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetSourcePortStart",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetSourcePortStart"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_suppress_prefixlength" nm_ip_routing_rule_get_suppress_prefixlength ::
Ptr IPRoutingRule ->
IO Int32
iPRoutingRuleGetSuppressPrefixlength ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Int32
iPRoutingRuleGetSuppressPrefixlength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Int32
iPRoutingRuleGetSuppressPrefixlength IPRoutingRule
self = IO Int32 -> m Int32
forall a. IO a -> m a
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 IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Int32
result <- Ptr IPRoutingRule -> IO Int32
nm_ip_routing_rule_get_suppress_prefixlength Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetSuppressPrefixlengthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetSuppressPrefixlengthMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetSuppressPrefixlength
instance O.OverloadedMethodInfo IPRoutingRuleGetSuppressPrefixlengthMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetSuppressPrefixlength",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetSuppressPrefixlength"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_table" nm_ip_routing_rule_get_table ::
Ptr IPRoutingRule ->
IO Word32
iPRoutingRuleGetTable ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word32
iPRoutingRuleGetTable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word32
iPRoutingRuleGetTable IPRoutingRule
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word32
result <- Ptr IPRoutingRule -> IO Word32
nm_ip_routing_rule_get_table Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetTableMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetTableMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetTable
instance O.OverloadedMethodInfo IPRoutingRuleGetTableMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetTable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetTable"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_to" nm_ip_routing_rule_get_to ::
Ptr IPRoutingRule ->
IO CString
iPRoutingRuleGetTo ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m T.Text
iPRoutingRuleGetTo :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Text
iPRoutingRuleGetTo IPRoutingRule
self = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
result <- Ptr IPRoutingRule -> IO CString
nm_ip_routing_rule_get_to Ptr IPRoutingRule
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleGetTo" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetToMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetToMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetTo
instance O.OverloadedMethodInfo IPRoutingRuleGetToMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetTo",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetTo"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_to_len" nm_ip_routing_rule_get_to_len ::
Ptr IPRoutingRule ->
IO Word8
iPRoutingRuleGetToLen ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word8
iPRoutingRuleGetToLen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word8
iPRoutingRuleGetToLen IPRoutingRule
self = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word8
result <- Ptr IPRoutingRule -> IO Word8
nm_ip_routing_rule_get_to_len Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetToLenMethodInfo
instance (signature ~ (m Word8), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetToLenMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetToLen
instance O.OverloadedMethodInfo IPRoutingRuleGetToLenMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetToLen",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetToLen"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_tos" nm_ip_routing_rule_get_tos ::
Ptr IPRoutingRule ->
IO Word8
iPRoutingRuleGetTos ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Word8
iPRoutingRuleGetTos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Word8
iPRoutingRuleGetTos IPRoutingRule
self = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Word8
result <- Ptr IPRoutingRule -> IO Word8
nm_ip_routing_rule_get_tos Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetTosMethodInfo
instance (signature ~ (m Word8), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetTosMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetTos
instance O.OverloadedMethodInfo IPRoutingRuleGetTosMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetTos",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetTos"
})
#endif
foreign import ccall "nm_ip_routing_rule_get_uid_range" nm_ip_routing_rule_get_uid_range ::
Ptr IPRoutingRule ->
Ptr Word32 ->
Ptr Word32 ->
IO CInt
iPRoutingRuleGetUidRange ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m ((Bool, Word32, Word32))
iPRoutingRuleGetUidRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m (Bool, Word32, Word32)
iPRoutingRuleGetUidRange IPRoutingRule
self = IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32))
-> IO (Bool, Word32, Word32) -> m (Bool, Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr Word32
outRangeStart <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
Ptr Word32
outRangeEnd <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
CInt
result <- Ptr IPRoutingRule -> Ptr Word32 -> Ptr Word32 -> IO CInt
nm_ip_routing_rule_get_uid_range Ptr IPRoutingRule
self' Ptr Word32
outRangeStart Ptr Word32
outRangeEnd
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
Word32
outRangeStart' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outRangeStart
Word32
outRangeEnd' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outRangeEnd
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outRangeStart
Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outRangeEnd
(Bool, Word32, Word32) -> IO (Bool, Word32, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
outRangeStart', Word32
outRangeEnd')
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleGetUidRangeMethodInfo
instance (signature ~ (m ((Bool, Word32, Word32))), MonadIO m) => O.OverloadedMethod IPRoutingRuleGetUidRangeMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleGetUidRange
instance O.OverloadedMethodInfo IPRoutingRuleGetUidRangeMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleGetUidRange",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleGetUidRange"
})
#endif
foreign import ccall "nm_ip_routing_rule_is_sealed" nm_ip_routing_rule_is_sealed ::
Ptr IPRoutingRule ->
IO CInt
iPRoutingRuleIsSealed ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m Bool
iPRoutingRuleIsSealed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m Bool
iPRoutingRuleIsSealed IPRoutingRule
self = IO Bool -> m Bool
forall a. IO a -> m a
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 IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CInt
result <- Ptr IPRoutingRule -> IO CInt
nm_ip_routing_rule_is_sealed Ptr IPRoutingRule
self'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleIsSealedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod IPRoutingRuleIsSealedMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleIsSealed
instance O.OverloadedMethodInfo IPRoutingRuleIsSealedMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleIsSealed",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleIsSealed"
})
#endif
foreign import ccall "nm_ip_routing_rule_new_clone" nm_ip_routing_rule_new_clone ::
Ptr IPRoutingRule ->
IO (Ptr IPRoutingRule)
iPRoutingRuleNewClone ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m IPRoutingRule
iPRoutingRuleNewClone :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m IPRoutingRule
iPRoutingRuleNewClone IPRoutingRule
rule = IO IPRoutingRule -> m IPRoutingRule
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoutingRule -> m IPRoutingRule)
-> IO IPRoutingRule -> m IPRoutingRule
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
rule' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
rule
Ptr IPRoutingRule
result <- Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
nm_ip_routing_rule_new_clone Ptr IPRoutingRule
rule'
Text -> Ptr IPRoutingRule -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleNewClone" Ptr IPRoutingRule
result
IPRoutingRule
result' <- ((ManagedPtr IPRoutingRule -> IPRoutingRule)
-> Ptr IPRoutingRule -> IO IPRoutingRule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoutingRule -> IPRoutingRule
IPRoutingRule) Ptr IPRoutingRule
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
rule
IPRoutingRule -> IO IPRoutingRule
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoutingRule
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleNewCloneMethodInfo
instance (signature ~ (m IPRoutingRule), MonadIO m) => O.OverloadedMethod IPRoutingRuleNewCloneMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleNewClone
instance O.OverloadedMethodInfo IPRoutingRuleNewCloneMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleNewClone",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleNewClone"
})
#endif
foreign import ccall "nm_ip_routing_rule_ref" nm_ip_routing_rule_ref ::
Ptr IPRoutingRule ->
IO (Ptr IPRoutingRule)
iPRoutingRuleRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (IPRoutingRule)
-> m IPRoutingRule
iPRoutingRuleRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe IPRoutingRule -> m IPRoutingRule
iPRoutingRuleRef Maybe IPRoutingRule
self = IO IPRoutingRule -> m IPRoutingRule
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoutingRule -> m IPRoutingRule)
-> IO IPRoutingRule -> m IPRoutingRule
forall a b. (a -> b) -> a -> b
$ do
Ptr IPRoutingRule
maybeSelf <- case Maybe IPRoutingRule
self of
Maybe IPRoutingRule
Nothing -> Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
forall a. Ptr a
FP.nullPtr
Just IPRoutingRule
jSelf -> do
Ptr IPRoutingRule
jSelf' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
jSelf
Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
jSelf'
Ptr IPRoutingRule
result <- Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
nm_ip_routing_rule_ref Ptr IPRoutingRule
maybeSelf
Text -> Ptr IPRoutingRule -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleRef" Ptr IPRoutingRule
result
IPRoutingRule
result' <- ((ManagedPtr IPRoutingRule -> IPRoutingRule)
-> Ptr IPRoutingRule -> IO IPRoutingRule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoutingRule -> IPRoutingRule
IPRoutingRule) Ptr IPRoutingRule
result
Maybe IPRoutingRule -> (IPRoutingRule -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe IPRoutingRule
self IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
IPRoutingRule -> IO IPRoutingRule
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoutingRule
result'
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleRefMethodInfo
instance (signature ~ (m IPRoutingRule), MonadIO m) => O.OverloadedMethod IPRoutingRuleRefMethodInfo IPRoutingRule signature where
overloadedMethod i = iPRoutingRuleRef (Just i)
instance O.OverloadedMethodInfo IPRoutingRuleRefMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleRef",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleRef"
})
#endif
foreign import ccall "nm_ip_routing_rule_seal" nm_ip_routing_rule_seal ::
Ptr IPRoutingRule ->
IO ()
iPRoutingRuleSeal ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m ()
iPRoutingRuleSeal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m ()
iPRoutingRuleSeal IPRoutingRule
self = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> IO ()
nm_ip_routing_rule_seal Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSealMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSealMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSeal
instance O.OverloadedMethodInfo IPRoutingRuleSealMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSeal",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSeal"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_action" nm_ip_routing_rule_set_action ::
Ptr IPRoutingRule ->
Word8 ->
IO ()
iPRoutingRuleSetAction ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word8
-> m ()
iPRoutingRuleSetAction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word8 -> m ()
iPRoutingRuleSetAction IPRoutingRule
self Word8
action = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word8 -> IO ()
nm_ip_routing_rule_set_action Ptr IPRoutingRule
self' Word8
action
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetActionMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetActionMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetAction
instance O.OverloadedMethodInfo IPRoutingRuleSetActionMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetAction",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetAction"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_destination_port" nm_ip_routing_rule_set_destination_port ::
Ptr IPRoutingRule ->
Word16 ->
Word16 ->
IO ()
iPRoutingRuleSetDestinationPort ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word16
-> Word16
-> m ()
iPRoutingRuleSetDestinationPort :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word16 -> Word16 -> m ()
iPRoutingRuleSetDestinationPort IPRoutingRule
self Word16
start Word16
end = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word16 -> Word16 -> IO ()
nm_ip_routing_rule_set_destination_port Ptr IPRoutingRule
self' Word16
start Word16
end
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetDestinationPortMethodInfo
instance (signature ~ (Word16 -> Word16 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetDestinationPortMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetDestinationPort
instance O.OverloadedMethodInfo IPRoutingRuleSetDestinationPortMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetDestinationPort",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetDestinationPort"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_from" nm_ip_routing_rule_set_from ::
Ptr IPRoutingRule ->
CString ->
Word8 ->
IO ()
iPRoutingRuleSetFrom ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Maybe (T.Text)
-> Word8
-> m ()
iPRoutingRuleSetFrom :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Maybe Text -> Word8 -> m ()
iPRoutingRuleSetFrom IPRoutingRule
self Maybe Text
from Word8
len = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
maybeFrom <- case Maybe Text
from of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jFrom -> do
CString
jFrom' <- Text -> IO CString
textToCString Text
jFrom
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jFrom'
Ptr IPRoutingRule -> CString -> Word8 -> IO ()
nm_ip_routing_rule_set_from Ptr IPRoutingRule
self' CString
maybeFrom Word8
len
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeFrom
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetFromMethodInfo
instance (signature ~ (Maybe (T.Text) -> Word8 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetFromMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetFrom
instance O.OverloadedMethodInfo IPRoutingRuleSetFromMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetFrom",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetFrom"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_fwmark" nm_ip_routing_rule_set_fwmark ::
Ptr IPRoutingRule ->
Word32 ->
Word32 ->
IO ()
iPRoutingRuleSetFwmark ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word32
-> Word32
-> m ()
iPRoutingRuleSetFwmark :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word32 -> Word32 -> m ()
iPRoutingRuleSetFwmark IPRoutingRule
self Word32
fwmark Word32
fwmask = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word32 -> Word32 -> IO ()
nm_ip_routing_rule_set_fwmark Ptr IPRoutingRule
self' Word32
fwmark Word32
fwmask
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetFwmarkMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetFwmarkMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetFwmark
instance O.OverloadedMethodInfo IPRoutingRuleSetFwmarkMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetFwmark",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetFwmark"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_iifname" nm_ip_routing_rule_set_iifname ::
Ptr IPRoutingRule ->
CString ->
IO ()
iPRoutingRuleSetIifname ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Maybe (T.Text)
-> m ()
iPRoutingRuleSetIifname :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Maybe Text -> m ()
iPRoutingRuleSetIifname IPRoutingRule
self Maybe Text
iifname = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
maybeIifname <- case Maybe Text
iifname of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jIifname -> do
CString
jIifname' <- Text -> IO CString
textToCString Text
jIifname
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIifname'
Ptr IPRoutingRule -> CString -> IO ()
nm_ip_routing_rule_set_iifname Ptr IPRoutingRule
self' CString
maybeIifname
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIifname
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetIifnameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetIifnameMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetIifname
instance O.OverloadedMethodInfo IPRoutingRuleSetIifnameMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetIifname",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetIifname"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_invert" nm_ip_routing_rule_set_invert ::
Ptr IPRoutingRule ->
CInt ->
IO ()
iPRoutingRuleSetInvert ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Bool
-> m ()
iPRoutingRuleSetInvert :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Bool -> m ()
iPRoutingRuleSetInvert IPRoutingRule
self Bool
invert = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
let invert' :: CInt
invert' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
invert
Ptr IPRoutingRule -> CInt -> IO ()
nm_ip_routing_rule_set_invert Ptr IPRoutingRule
self' CInt
invert'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetInvertMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetInvertMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetInvert
instance O.OverloadedMethodInfo IPRoutingRuleSetInvertMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetInvert",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetInvert"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_ipproto" nm_ip_routing_rule_set_ipproto ::
Ptr IPRoutingRule ->
Word8 ->
IO ()
iPRoutingRuleSetIpproto ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word8
-> m ()
iPRoutingRuleSetIpproto :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word8 -> m ()
iPRoutingRuleSetIpproto IPRoutingRule
self Word8
ipproto = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word8 -> IO ()
nm_ip_routing_rule_set_ipproto Ptr IPRoutingRule
self' Word8
ipproto
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetIpprotoMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetIpprotoMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetIpproto
instance O.OverloadedMethodInfo IPRoutingRuleSetIpprotoMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetIpproto",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetIpproto"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_oifname" nm_ip_routing_rule_set_oifname ::
Ptr IPRoutingRule ->
CString ->
IO ()
iPRoutingRuleSetOifname ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Maybe (T.Text)
-> m ()
iPRoutingRuleSetOifname :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Maybe Text -> m ()
iPRoutingRuleSetOifname IPRoutingRule
self Maybe Text
oifname = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
maybeOifname <- case Maybe Text
oifname of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jOifname -> do
CString
jOifname' <- Text -> IO CString
textToCString Text
jOifname
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOifname'
Ptr IPRoutingRule -> CString -> IO ()
nm_ip_routing_rule_set_oifname Ptr IPRoutingRule
self' CString
maybeOifname
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOifname
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetOifnameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetOifnameMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetOifname
instance O.OverloadedMethodInfo IPRoutingRuleSetOifnameMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetOifname",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetOifname"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_priority" nm_ip_routing_rule_set_priority ::
Ptr IPRoutingRule ->
Int64 ->
IO ()
iPRoutingRuleSetPriority ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Int64
-> m ()
iPRoutingRuleSetPriority :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Int64 -> m ()
iPRoutingRuleSetPriority IPRoutingRule
self Int64
priority = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Int64 -> IO ()
nm_ip_routing_rule_set_priority Ptr IPRoutingRule
self' Int64
priority
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetPriorityMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetPriorityMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetPriority
instance O.OverloadedMethodInfo IPRoutingRuleSetPriorityMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetPriority",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetPriority"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_source_port" nm_ip_routing_rule_set_source_port ::
Ptr IPRoutingRule ->
Word16 ->
Word16 ->
IO ()
iPRoutingRuleSetSourcePort ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word16
-> Word16
-> m ()
iPRoutingRuleSetSourcePort :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word16 -> Word16 -> m ()
iPRoutingRuleSetSourcePort IPRoutingRule
self Word16
start Word16
end = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word16 -> Word16 -> IO ()
nm_ip_routing_rule_set_source_port Ptr IPRoutingRule
self' Word16
start Word16
end
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetSourcePortMethodInfo
instance (signature ~ (Word16 -> Word16 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetSourcePortMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetSourcePort
instance O.OverloadedMethodInfo IPRoutingRuleSetSourcePortMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetSourcePort",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetSourcePort"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_suppress_prefixlength" nm_ip_routing_rule_set_suppress_prefixlength ::
Ptr IPRoutingRule ->
Int32 ->
IO ()
iPRoutingRuleSetSuppressPrefixlength ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Int32
-> m ()
iPRoutingRuleSetSuppressPrefixlength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Int32 -> m ()
iPRoutingRuleSetSuppressPrefixlength IPRoutingRule
self Int32
suppressPrefixlength = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Int32 -> IO ()
nm_ip_routing_rule_set_suppress_prefixlength Ptr IPRoutingRule
self' Int32
suppressPrefixlength
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetSuppressPrefixlengthMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetSuppressPrefixlengthMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetSuppressPrefixlength
instance O.OverloadedMethodInfo IPRoutingRuleSetSuppressPrefixlengthMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetSuppressPrefixlength",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetSuppressPrefixlength"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_table" nm_ip_routing_rule_set_table ::
Ptr IPRoutingRule ->
Word32 ->
IO ()
iPRoutingRuleSetTable ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word32
-> m ()
iPRoutingRuleSetTable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word32 -> m ()
iPRoutingRuleSetTable IPRoutingRule
self Word32
table = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word32 -> IO ()
nm_ip_routing_rule_set_table Ptr IPRoutingRule
self' Word32
table
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetTableMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetTableMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetTable
instance O.OverloadedMethodInfo IPRoutingRuleSetTableMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetTable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetTable"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_to" nm_ip_routing_rule_set_to ::
Ptr IPRoutingRule ->
CString ->
Word8 ->
IO ()
iPRoutingRuleSetTo ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Maybe (T.Text)
-> Word8
-> m ()
iPRoutingRuleSetTo :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Maybe Text -> Word8 -> m ()
iPRoutingRuleSetTo IPRoutingRule
self Maybe Text
to Word8
len = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
CString
maybeTo <- case Maybe Text
to of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
Just Text
jTo -> do
CString
jTo' <- Text -> IO CString
textToCString Text
jTo
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTo'
Ptr IPRoutingRule -> CString -> Word8 -> IO ()
nm_ip_routing_rule_set_to Ptr IPRoutingRule
self' CString
maybeTo Word8
len
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTo
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetToMethodInfo
instance (signature ~ (Maybe (T.Text) -> Word8 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetToMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetTo
instance O.OverloadedMethodInfo IPRoutingRuleSetToMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetTo",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetTo"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_tos" nm_ip_routing_rule_set_tos ::
Ptr IPRoutingRule ->
Word8 ->
IO ()
iPRoutingRuleSetTos ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word8
-> m ()
iPRoutingRuleSetTos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word8 -> m ()
iPRoutingRuleSetTos IPRoutingRule
self Word8
tos = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word8 -> IO ()
nm_ip_routing_rule_set_tos Ptr IPRoutingRule
self' Word8
tos
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetTosMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetTosMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetTos
instance O.OverloadedMethodInfo IPRoutingRuleSetTosMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetTos",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetTos"
})
#endif
foreign import ccall "nm_ip_routing_rule_set_uid_range" nm_ip_routing_rule_set_uid_range ::
Ptr IPRoutingRule ->
Word32 ->
Word32 ->
IO ()
iPRoutingRuleSetUidRange ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> Word32
-> Word32
-> m ()
iPRoutingRuleSetUidRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> Word32 -> Word32 -> m ()
iPRoutingRuleSetUidRange IPRoutingRule
self Word32
uidRangeStart Word32
uidRangeEnd = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
Ptr IPRoutingRule -> Word32 -> Word32 -> IO ()
nm_ip_routing_rule_set_uid_range Ptr IPRoutingRule
self' Word32
uidRangeStart Word32
uidRangeEnd
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleSetUidRangeMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleSetUidRangeMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleSetUidRange
instance O.OverloadedMethodInfo IPRoutingRuleSetUidRangeMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleSetUidRange",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleSetUidRange"
})
#endif
foreign import ccall "nm_ip_routing_rule_to_string" nm_ip_routing_rule_to_string ::
Ptr IPRoutingRule ->
CUInt ->
Ptr (GHashTable (Ptr ()) (Ptr ())) ->
Ptr (Ptr GError) ->
IO CString
iPRoutingRuleToString ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> [NM.Flags.IPRoutingRuleAsStringFlags]
-> Maybe (Map.Map (Ptr ()) (Ptr ()))
-> m T.Text
iPRoutingRuleToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule
-> [IPRoutingRuleAsStringFlags]
-> Maybe (Map (Ptr ()) (Ptr ()))
-> m Text
iPRoutingRuleToString IPRoutingRule
self [IPRoutingRuleAsStringFlags]
toStringFlags Maybe (Map (Ptr ()) (Ptr ()))
extraArgs = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
let toStringFlags' :: CUInt
toStringFlags' = [IPRoutingRuleAsStringFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IPRoutingRuleAsStringFlags]
toStringFlags
Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs <- case Maybe (Map (Ptr ()) (Ptr ()))
extraArgs of
Maybe (Map (Ptr ()) (Ptr ()))
Nothing -> Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable (Ptr ()) (Ptr ()))
forall a. Ptr a
FP.nullPtr
Just Map (Ptr ()) (Ptr ())
jExtraArgs -> do
let jExtraArgs' :: [(Ptr (), Ptr ())]
jExtraArgs' = Map (Ptr ()) (Ptr ()) -> [(Ptr (), Ptr ())]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Ptr ()) (Ptr ())
jExtraArgs
let jExtraArgs'' :: [(PtrWrapped (Ptr ()), Ptr ())]
jExtraArgs'' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(Ptr (), Ptr ())] -> [(PtrWrapped (Ptr ()), Ptr ())]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(Ptr (), Ptr ())]
jExtraArgs'
let jExtraArgs''' :: [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
jExtraArgs''' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(PtrWrapped (Ptr ()), Ptr ())]
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(PtrWrapped (Ptr ()), Ptr ())]
jExtraArgs''
Ptr (GHashTable (Ptr ()) (Ptr ()))
jExtraArgs'''' <- GHashFunc (Ptr ())
-> GEqualFunc (Ptr ())
-> Maybe (GDestroyNotify (Ptr ()))
-> Maybe (GDestroyNotify (Ptr ()))
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr ())
forall a. GHashFunc (Ptr a)
gDirectHash GEqualFunc (Ptr ())
forall a. GEqualFunc (Ptr a)
gDirectEqual Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
jExtraArgs'''
Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable (Ptr ()) (Ptr ()))
jExtraArgs''''
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 IPRoutingRule
-> CUInt
-> Ptr (GHashTable (Ptr ()) (Ptr ()))
-> Ptr (Ptr GError)
-> IO CString
nm_ip_routing_rule_to_string Ptr IPRoutingRule
self' CUInt
toStringFlags' Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleToString" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
) (do
Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs
)
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleToStringMethodInfo
instance (signature ~ ([NM.Flags.IPRoutingRuleAsStringFlags] -> Maybe (Map.Map (Ptr ()) (Ptr ())) -> m T.Text), MonadIO m) => O.OverloadedMethod IPRoutingRuleToStringMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleToString
instance O.OverloadedMethodInfo IPRoutingRuleToStringMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleToString",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleToString"
})
#endif
foreign import ccall "nm_ip_routing_rule_unref" nm_ip_routing_rule_unref ::
Ptr IPRoutingRule ->
IO ()
iPRoutingRuleUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (IPRoutingRule)
-> m ()
iPRoutingRuleUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe IPRoutingRule -> m ()
iPRoutingRuleUnref Maybe IPRoutingRule
self = 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
Ptr IPRoutingRule
maybeSelf <- case Maybe IPRoutingRule
self of
Maybe IPRoutingRule
Nothing -> Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
forall a. Ptr a
FP.nullPtr
Just IPRoutingRule
jSelf -> do
Ptr IPRoutingRule
jSelf' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
jSelf
Ptr IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr IPRoutingRule
jSelf'
Ptr IPRoutingRule -> IO ()
nm_ip_routing_rule_unref Ptr IPRoutingRule
maybeSelf
Maybe IPRoutingRule -> (IPRoutingRule -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe IPRoutingRule
self IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleUnrefMethodInfo IPRoutingRule signature where
overloadedMethod i = iPRoutingRuleUnref (Just i)
instance O.OverloadedMethodInfo IPRoutingRuleUnrefMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleUnref",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleUnref"
})
#endif
foreign import ccall "nm_ip_routing_rule_validate" nm_ip_routing_rule_validate ::
Ptr IPRoutingRule ->
Ptr (Ptr GError) ->
IO CInt
iPRoutingRuleValidate ::
(B.CallStack.HasCallStack, MonadIO m) =>
IPRoutingRule
-> m ()
iPRoutingRuleValidate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoutingRule -> m ()
iPRoutingRuleValidate IPRoutingRule
self = 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
Ptr IPRoutingRule
self' <- IPRoutingRule -> IO (Ptr IPRoutingRule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoutingRule
self
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 IPRoutingRule -> Ptr (Ptr GError) -> IO CInt
nm_ip_routing_rule_validate Ptr IPRoutingRule
self'
IPRoutingRule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoutingRule
self
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data IPRoutingRuleValidateMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPRoutingRuleValidateMethodInfo IPRoutingRule signature where
overloadedMethod = iPRoutingRuleValidate
instance O.OverloadedMethodInfo IPRoutingRuleValidateMethodInfo IPRoutingRule where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Structs.IPRoutingRule.iPRoutingRuleValidate",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-IPRoutingRule.html#v:iPRoutingRuleValidate"
})
#endif
foreign import ccall "nm_ip_routing_rule_from_string" nm_ip_routing_rule_from_string ::
CString ->
CUInt ->
Ptr (GHashTable (Ptr ()) (Ptr ())) ->
Ptr (Ptr GError) ->
IO (Ptr IPRoutingRule)
iPRoutingRuleFromString ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> [NM.Flags.IPRoutingRuleAsStringFlags]
-> Maybe (Map.Map (Ptr ()) (Ptr ()))
-> m IPRoutingRule
iPRoutingRuleFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text
-> [IPRoutingRuleAsStringFlags]
-> Maybe (Map (Ptr ()) (Ptr ()))
-> m IPRoutingRule
iPRoutingRuleFromString Text
str [IPRoutingRuleAsStringFlags]
toStringFlags Maybe (Map (Ptr ()) (Ptr ()))
extraArgs = IO IPRoutingRule -> m IPRoutingRule
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoutingRule -> m IPRoutingRule)
-> IO IPRoutingRule -> m IPRoutingRule
forall a b. (a -> b) -> a -> b
$ do
CString
str' <- Text -> IO CString
textToCString Text
str
let toStringFlags' :: CUInt
toStringFlags' = [IPRoutingRuleAsStringFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IPRoutingRuleAsStringFlags]
toStringFlags
Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs <- case Maybe (Map (Ptr ()) (Ptr ()))
extraArgs of
Maybe (Map (Ptr ()) (Ptr ()))
Nothing -> Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable (Ptr ()) (Ptr ()))
forall a. Ptr a
FP.nullPtr
Just Map (Ptr ()) (Ptr ())
jExtraArgs -> do
let jExtraArgs' :: [(Ptr (), Ptr ())]
jExtraArgs' = Map (Ptr ()) (Ptr ()) -> [(Ptr (), Ptr ())]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Ptr ()) (Ptr ())
jExtraArgs
let jExtraArgs'' :: [(PtrWrapped (Ptr ()), Ptr ())]
jExtraArgs'' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(Ptr (), Ptr ())] -> [(PtrWrapped (Ptr ()), Ptr ())]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(Ptr (), Ptr ())]
jExtraArgs'
let jExtraArgs''' :: [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
jExtraArgs''' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(PtrWrapped (Ptr ()), Ptr ())]
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(PtrWrapped (Ptr ()), Ptr ())]
jExtraArgs''
Ptr (GHashTable (Ptr ()) (Ptr ()))
jExtraArgs'''' <- GHashFunc (Ptr ())
-> GEqualFunc (Ptr ())
-> Maybe (GDestroyNotify (Ptr ()))
-> Maybe (GDestroyNotify (Ptr ()))
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr ())
forall a. GHashFunc (Ptr a)
gDirectHash GEqualFunc (Ptr ())
forall a. GEqualFunc (Ptr a)
gDirectEqual Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
jExtraArgs'''
Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable (Ptr ()) (Ptr ()))
jExtraArgs''''
IO IPRoutingRule -> IO () -> IO IPRoutingRule
forall a b. IO a -> IO b -> IO a
onException (do
Ptr IPRoutingRule
result <- (Ptr (Ptr GError) -> IO (Ptr IPRoutingRule))
-> IO (Ptr IPRoutingRule)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr IPRoutingRule))
-> IO (Ptr IPRoutingRule))
-> (Ptr (Ptr GError) -> IO (Ptr IPRoutingRule))
-> IO (Ptr IPRoutingRule)
forall a b. (a -> b) -> a -> b
$ CString
-> CUInt
-> Ptr (GHashTable (Ptr ()) (Ptr ()))
-> Ptr (Ptr GError)
-> IO (Ptr IPRoutingRule)
nm_ip_routing_rule_from_string CString
str' CUInt
toStringFlags' Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs
Text -> Ptr IPRoutingRule -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRoutingRuleFromString" Ptr IPRoutingRule
result
IPRoutingRule
result' <- ((ManagedPtr IPRoutingRule -> IPRoutingRule)
-> Ptr IPRoutingRule -> IO IPRoutingRule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoutingRule -> IPRoutingRule
IPRoutingRule) Ptr IPRoutingRule
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs
IPRoutingRule -> IO IPRoutingRule
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoutingRule
result'
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
maybeExtraArgs
)
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveIPRoutingRuleMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveIPRoutingRuleMethod "cmp" o = IPRoutingRuleCmpMethodInfo
ResolveIPRoutingRuleMethod "isSealed" o = IPRoutingRuleIsSealedMethodInfo
ResolveIPRoutingRuleMethod "newClone" o = IPRoutingRuleNewCloneMethodInfo
ResolveIPRoutingRuleMethod "ref" o = IPRoutingRuleRefMethodInfo
ResolveIPRoutingRuleMethod "seal" o = IPRoutingRuleSealMethodInfo
ResolveIPRoutingRuleMethod "toString" o = IPRoutingRuleToStringMethodInfo
ResolveIPRoutingRuleMethod "unref" o = IPRoutingRuleUnrefMethodInfo
ResolveIPRoutingRuleMethod "validate" o = IPRoutingRuleValidateMethodInfo
ResolveIPRoutingRuleMethod "getAction" o = IPRoutingRuleGetActionMethodInfo
ResolveIPRoutingRuleMethod "getAddrFamily" o = IPRoutingRuleGetAddrFamilyMethodInfo
ResolveIPRoutingRuleMethod "getDestinationPortEnd" o = IPRoutingRuleGetDestinationPortEndMethodInfo
ResolveIPRoutingRuleMethod "getDestinationPortStart" o = IPRoutingRuleGetDestinationPortStartMethodInfo
ResolveIPRoutingRuleMethod "getFrom" o = IPRoutingRuleGetFromMethodInfo
ResolveIPRoutingRuleMethod "getFromLen" o = IPRoutingRuleGetFromLenMethodInfo
ResolveIPRoutingRuleMethod "getFwmark" o = IPRoutingRuleGetFwmarkMethodInfo
ResolveIPRoutingRuleMethod "getFwmask" o = IPRoutingRuleGetFwmaskMethodInfo
ResolveIPRoutingRuleMethod "getIifname" o = IPRoutingRuleGetIifnameMethodInfo
ResolveIPRoutingRuleMethod "getInvert" o = IPRoutingRuleGetInvertMethodInfo
ResolveIPRoutingRuleMethod "getIpproto" o = IPRoutingRuleGetIpprotoMethodInfo
ResolveIPRoutingRuleMethod "getOifname" o = IPRoutingRuleGetOifnameMethodInfo
ResolveIPRoutingRuleMethod "getPriority" o = IPRoutingRuleGetPriorityMethodInfo
ResolveIPRoutingRuleMethod "getSourcePortEnd" o = IPRoutingRuleGetSourcePortEndMethodInfo
ResolveIPRoutingRuleMethod "getSourcePortStart" o = IPRoutingRuleGetSourcePortStartMethodInfo
ResolveIPRoutingRuleMethod "getSuppressPrefixlength" o = IPRoutingRuleGetSuppressPrefixlengthMethodInfo
ResolveIPRoutingRuleMethod "getTable" o = IPRoutingRuleGetTableMethodInfo
ResolveIPRoutingRuleMethod "getTo" o = IPRoutingRuleGetToMethodInfo
ResolveIPRoutingRuleMethod "getToLen" o = IPRoutingRuleGetToLenMethodInfo
ResolveIPRoutingRuleMethod "getTos" o = IPRoutingRuleGetTosMethodInfo
ResolveIPRoutingRuleMethod "getUidRange" o = IPRoutingRuleGetUidRangeMethodInfo
ResolveIPRoutingRuleMethod "setAction" o = IPRoutingRuleSetActionMethodInfo
ResolveIPRoutingRuleMethod "setDestinationPort" o = IPRoutingRuleSetDestinationPortMethodInfo
ResolveIPRoutingRuleMethod "setFrom" o = IPRoutingRuleSetFromMethodInfo
ResolveIPRoutingRuleMethod "setFwmark" o = IPRoutingRuleSetFwmarkMethodInfo
ResolveIPRoutingRuleMethod "setIifname" o = IPRoutingRuleSetIifnameMethodInfo
ResolveIPRoutingRuleMethod "setInvert" o = IPRoutingRuleSetInvertMethodInfo
ResolveIPRoutingRuleMethod "setIpproto" o = IPRoutingRuleSetIpprotoMethodInfo
ResolveIPRoutingRuleMethod "setOifname" o = IPRoutingRuleSetOifnameMethodInfo
ResolveIPRoutingRuleMethod "setPriority" o = IPRoutingRuleSetPriorityMethodInfo
ResolveIPRoutingRuleMethod "setSourcePort" o = IPRoutingRuleSetSourcePortMethodInfo
ResolveIPRoutingRuleMethod "setSuppressPrefixlength" o = IPRoutingRuleSetSuppressPrefixlengthMethodInfo
ResolveIPRoutingRuleMethod "setTable" o = IPRoutingRuleSetTableMethodInfo
ResolveIPRoutingRuleMethod "setTo" o = IPRoutingRuleSetToMethodInfo
ResolveIPRoutingRuleMethod "setTos" o = IPRoutingRuleSetTosMethodInfo
ResolveIPRoutingRuleMethod "setUidRange" o = IPRoutingRuleSetUidRangeMethodInfo
ResolveIPRoutingRuleMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveIPRoutingRuleMethod t IPRoutingRule, O.OverloadedMethod info IPRoutingRule p) => OL.IsLabel t (IPRoutingRule -> 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 ~ ResolveIPRoutingRuleMethod t IPRoutingRule, O.OverloadedMethod info IPRoutingRule p, R.HasField t IPRoutingRule p) => R.HasField t IPRoutingRule p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveIPRoutingRuleMethod t IPRoutingRule, O.OverloadedMethodInfo info IPRoutingRule) => OL.IsLabel t (O.MethodProxy info IPRoutingRule) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif