{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.SettingSriov
(
SettingSriov(..) ,
IsSettingSriov ,
toSettingSriov ,
#if defined(ENABLE_OVERLOADING)
ResolveSettingSriovMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingSriovAddVfMethodInfo ,
#endif
settingSriovAddVf ,
#if defined(ENABLE_OVERLOADING)
SettingSriovClearVfsMethodInfo ,
#endif
settingSriovClearVfs ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetAutoprobeDriversMethodInfo,
#endif
settingSriovGetAutoprobeDrivers ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetEswitchEncapModeMethodInfo,
#endif
settingSriovGetEswitchEncapMode ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetEswitchInlineModeMethodInfo,
#endif
settingSriovGetEswitchInlineMode ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetEswitchModeMethodInfo ,
#endif
settingSriovGetEswitchMode ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetNumVfsMethodInfo ,
#endif
settingSriovGetNumVfs ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetTotalVfsMethodInfo ,
#endif
settingSriovGetTotalVfs ,
#if defined(ENABLE_OVERLOADING)
SettingSriovGetVfMethodInfo ,
#endif
settingSriovGetVf ,
settingSriovNew ,
#if defined(ENABLE_OVERLOADING)
SettingSriovRemoveVfMethodInfo ,
#endif
settingSriovRemoveVf ,
#if defined(ENABLE_OVERLOADING)
SettingSriovRemoveVfByIndexMethodInfo ,
#endif
settingSriovRemoveVfByIndex ,
#if defined(ENABLE_OVERLOADING)
SettingSriovAutoprobeDriversPropertyInfo,
#endif
constructSettingSriovAutoprobeDrivers ,
getSettingSriovAutoprobeDrivers ,
setSettingSriovAutoprobeDrivers ,
#if defined(ENABLE_OVERLOADING)
settingSriovAutoprobeDrivers ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingSriovEswitchEncapModePropertyInfo,
#endif
constructSettingSriovEswitchEncapMode ,
getSettingSriovEswitchEncapMode ,
setSettingSriovEswitchEncapMode ,
#if defined(ENABLE_OVERLOADING)
settingSriovEswitchEncapMode ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingSriovEswitchInlineModePropertyInfo,
#endif
constructSettingSriovEswitchInlineMode ,
getSettingSriovEswitchInlineMode ,
setSettingSriovEswitchInlineMode ,
#if defined(ENABLE_OVERLOADING)
settingSriovEswitchInlineMode ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingSriovEswitchModePropertyInfo ,
#endif
constructSettingSriovEswitchMode ,
getSettingSriovEswitchMode ,
setSettingSriovEswitchMode ,
#if defined(ENABLE_OVERLOADING)
settingSriovEswitchMode ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingSriovTotalVfsPropertyInfo ,
#endif
constructSettingSriovTotalVfs ,
getSettingSriovTotalVfs ,
setSettingSriovTotalVfs ,
#if defined(ENABLE_OVERLOADING)
settingSriovTotalVfs ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingSriovVfsPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
settingSriovVfs ,
#endif
) 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 qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.NM.Callbacks as NM.Callbacks
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Interfaces.Connection as NM.Connection
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting
import {-# SOURCE #-} qualified GI.NM.Objects.Setting8021x as NM.Setting8021x
import {-# SOURCE #-} qualified GI.NM.Objects.SettingAdsl as NM.SettingAdsl
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBluetooth as NM.SettingBluetooth
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBond as NM.SettingBond
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBridge as NM.SettingBridge
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBridgePort as NM.SettingBridgePort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingCdma as NM.SettingCdma
import {-# SOURCE #-} qualified GI.NM.Objects.SettingConnection as NM.SettingConnection
import {-# SOURCE #-} qualified GI.NM.Objects.SettingDcb as NM.SettingDcb
import {-# SOURCE #-} qualified GI.NM.Objects.SettingDummy as NM.SettingDummy
import {-# SOURCE #-} qualified GI.NM.Objects.SettingGeneric as NM.SettingGeneric
import {-# SOURCE #-} qualified GI.NM.Objects.SettingGsm as NM.SettingGsm
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIP4Config as NM.SettingIP4Config
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIP6Config as NM.SettingIP6Config
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIPConfig as NM.SettingIPConfig
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIPTunnel as NM.SettingIPTunnel
import {-# SOURCE #-} qualified GI.NM.Objects.SettingInfiniband as NM.SettingInfiniband
import {-# SOURCE #-} qualified GI.NM.Objects.SettingMacsec as NM.SettingMacsec
import {-# SOURCE #-} qualified GI.NM.Objects.SettingMacvlan as NM.SettingMacvlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOlpcMesh as NM.SettingOlpcMesh
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsBridge as NM.SettingOvsBridge
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsInterface as NM.SettingOvsInterface
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsPatch as NM.SettingOvsPatch
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsPort as NM.SettingOvsPort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingPpp as NM.SettingPpp
import {-# SOURCE #-} qualified GI.NM.Objects.SettingPppoe as NM.SettingPppoe
import {-# SOURCE #-} qualified GI.NM.Objects.SettingProxy as NM.SettingProxy
import {-# SOURCE #-} qualified GI.NM.Objects.SettingSerial as NM.SettingSerial
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTCConfig as NM.SettingTCConfig
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTeam as NM.SettingTeam
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTeamPort as NM.SettingTeamPort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTun as NM.SettingTun
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVlan as NM.SettingVlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVpn as NM.SettingVpn
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVxlan as NM.SettingVxlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWimax as NM.SettingWimax
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWired as NM.SettingWired
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWireless as NM.SettingWireless
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWirelessSecurity as NM.SettingWirelessSecurity
import {-# SOURCE #-} qualified GI.NM.Structs.BridgeVlan as NM.BridgeVlan
import {-# SOURCE #-} qualified GI.NM.Structs.IPAddress as NM.IPAddress
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoute as NM.IPRoute
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoutingRule as NM.IPRoutingRule
import {-# SOURCE #-} qualified GI.NM.Structs.Range as NM.Range
import {-# SOURCE #-} qualified GI.NM.Structs.SriovVF as NM.SriovVF
import {-# SOURCE #-} qualified GI.NM.Structs.TCAction as NM.TCAction
import {-# SOURCE #-} qualified GI.NM.Structs.TCQdisc as NM.TCQdisc
import {-# SOURCE #-} qualified GI.NM.Structs.TCTfilter as NM.TCTfilter
import {-# SOURCE #-} qualified GI.NM.Structs.TeamLinkWatcher as NM.TeamLinkWatcher
import {-# SOURCE #-} qualified GI.NM.Structs.VariantAttributeSpec as NM.VariantAttributeSpec
#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting
import {-# SOURCE #-} qualified GI.NM.Structs.SriovVF as NM.SriovVF
#endif
newtype SettingSriov = SettingSriov (SP.ManagedPtr SettingSriov)
deriving (SettingSriov -> SettingSriov -> Bool
(SettingSriov -> SettingSriov -> Bool)
-> (SettingSriov -> SettingSriov -> Bool) -> Eq SettingSriov
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingSriov -> SettingSriov -> Bool
== :: SettingSriov -> SettingSriov -> Bool
$c/= :: SettingSriov -> SettingSriov -> Bool
/= :: SettingSriov -> SettingSriov -> Bool
Eq)
instance SP.ManagedPtrNewtype SettingSriov where
toManagedPtr :: SettingSriov -> ManagedPtr SettingSriov
toManagedPtr (SettingSriov ManagedPtr SettingSriov
p) = ManagedPtr SettingSriov
p
foreign import ccall "nm_setting_sriov_get_type"
c_nm_setting_sriov_get_type :: IO B.Types.GType
instance B.Types.TypedObject SettingSriov where
glibType :: IO GType
glibType = IO GType
c_nm_setting_sriov_get_type
instance B.Types.GObject SettingSriov
class (SP.GObject o, O.IsDescendantOf SettingSriov o) => IsSettingSriov o
instance (SP.GObject o, O.IsDescendantOf SettingSriov o) => IsSettingSriov o
instance O.HasParentTypes SettingSriov
type instance O.ParentTypes SettingSriov = '[NM.Setting.Setting, GObject.Object.Object]
toSettingSriov :: (MIO.MonadIO m, IsSettingSriov o) => o -> m SettingSriov
toSettingSriov :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> m SettingSriov
toSettingSriov = IO SettingSriov -> m SettingSriov
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SettingSriov -> m SettingSriov)
-> (o -> IO SettingSriov) -> o -> m SettingSriov
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SettingSriov -> SettingSriov) -> o -> IO SettingSriov
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SettingSriov -> SettingSriov
SettingSriov
instance B.GValue.IsGValue (Maybe SettingSriov) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_setting_sriov_get_type
gvalueSet_ :: Ptr GValue -> Maybe SettingSriov -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SettingSriov
P.Nothing = Ptr GValue -> Ptr SettingSriov -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SettingSriov
forall a. Ptr a
FP.nullPtr :: FP.Ptr SettingSriov)
gvalueSet_ Ptr GValue
gv (P.Just SettingSriov
obj) = SettingSriov -> (Ptr SettingSriov -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SettingSriov
obj (Ptr GValue -> Ptr SettingSriov -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe SettingSriov)
gvalueGet_ Ptr GValue
gv = do
Ptr SettingSriov
ptr <- Ptr GValue -> IO (Ptr SettingSriov)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SettingSriov)
if Ptr SettingSriov
ptr Ptr SettingSriov -> Ptr SettingSriov -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SettingSriov
forall a. Ptr a
FP.nullPtr
then SettingSriov -> Maybe SettingSriov
forall a. a -> Maybe a
P.Just (SettingSriov -> Maybe SettingSriov)
-> IO SettingSriov -> IO (Maybe SettingSriov)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SettingSriov -> SettingSriov)
-> Ptr SettingSriov -> IO SettingSriov
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SettingSriov -> SettingSriov
SettingSriov Ptr SettingSriov
ptr
else Maybe SettingSriov -> IO (Maybe SettingSriov)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SettingSriov
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveSettingSriovMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveSettingSriovMethod "addVf" o = SettingSriovAddVfMethodInfo
ResolveSettingSriovMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveSettingSriovMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveSettingSriovMethod "clearVfs" o = SettingSriovClearVfsMethodInfo
ResolveSettingSriovMethod "compare" o = NM.Setting.SettingCompareMethodInfo
ResolveSettingSriovMethod "diff" o = NM.Setting.SettingDiffMethodInfo
ResolveSettingSriovMethod "duplicate" o = NM.Setting.SettingDuplicateMethodInfo
ResolveSettingSriovMethod "enumerateValues" o = NM.Setting.SettingEnumerateValuesMethodInfo
ResolveSettingSriovMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveSettingSriovMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveSettingSriovMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveSettingSriovMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveSettingSriovMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveSettingSriovMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveSettingSriovMethod "optionClearByName" o = NM.Setting.SettingOptionClearByNameMethodInfo
ResolveSettingSriovMethod "optionGet" o = NM.Setting.SettingOptionGetMethodInfo
ResolveSettingSriovMethod "optionGetAllNames" o = NM.Setting.SettingOptionGetAllNamesMethodInfo
ResolveSettingSriovMethod "optionGetBoolean" o = NM.Setting.SettingOptionGetBooleanMethodInfo
ResolveSettingSriovMethod "optionGetUint32" o = NM.Setting.SettingOptionGetUint32MethodInfo
ResolveSettingSriovMethod "optionSet" o = NM.Setting.SettingOptionSetMethodInfo
ResolveSettingSriovMethod "optionSetBoolean" o = NM.Setting.SettingOptionSetBooleanMethodInfo
ResolveSettingSriovMethod "optionSetUint32" o = NM.Setting.SettingOptionSetUint32MethodInfo
ResolveSettingSriovMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveSettingSriovMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveSettingSriovMethod "removeVf" o = SettingSriovRemoveVfMethodInfo
ResolveSettingSriovMethod "removeVfByIndex" o = SettingSriovRemoveVfByIndexMethodInfo
ResolveSettingSriovMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveSettingSriovMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveSettingSriovMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveSettingSriovMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveSettingSriovMethod "toString" o = NM.Setting.SettingToStringMethodInfo
ResolveSettingSriovMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveSettingSriovMethod "verify" o = NM.Setting.SettingVerifyMethodInfo
ResolveSettingSriovMethod "verifySecrets" o = NM.Setting.SettingVerifySecretsMethodInfo
ResolveSettingSriovMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveSettingSriovMethod "getAutoprobeDrivers" o = SettingSriovGetAutoprobeDriversMethodInfo
ResolveSettingSriovMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveSettingSriovMethod "getDbusPropertyType" o = NM.Setting.SettingGetDbusPropertyTypeMethodInfo
ResolveSettingSriovMethod "getEswitchEncapMode" o = SettingSriovGetEswitchEncapModeMethodInfo
ResolveSettingSriovMethod "getEswitchInlineMode" o = SettingSriovGetEswitchInlineModeMethodInfo
ResolveSettingSriovMethod "getEswitchMode" o = SettingSriovGetEswitchModeMethodInfo
ResolveSettingSriovMethod "getName" o = NM.Setting.SettingGetNameMethodInfo
ResolveSettingSriovMethod "getNumVfs" o = SettingSriovGetNumVfsMethodInfo
ResolveSettingSriovMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveSettingSriovMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveSettingSriovMethod "getSecretFlags" o = NM.Setting.SettingGetSecretFlagsMethodInfo
ResolveSettingSriovMethod "getTotalVfs" o = SettingSriovGetTotalVfsMethodInfo
ResolveSettingSriovMethod "getVf" o = SettingSriovGetVfMethodInfo
ResolveSettingSriovMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveSettingSriovMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveSettingSriovMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveSettingSriovMethod "setSecretFlags" o = NM.Setting.SettingSetSecretFlagsMethodInfo
ResolveSettingSriovMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveSettingSriovMethod t SettingSriov, O.OverloadedMethod info SettingSriov p) => OL.IsLabel t (SettingSriov -> 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 ~ ResolveSettingSriovMethod t SettingSriov, O.OverloadedMethod info SettingSriov p, R.HasField t SettingSriov p) => R.HasField t SettingSriov p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveSettingSriovMethod t SettingSriov, O.OverloadedMethodInfo info SettingSriov) => OL.IsLabel t (O.MethodProxy info SettingSriov) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getSettingSriovAutoprobeDrivers :: (MonadIO m, IsSettingSriov o) => o -> m NM.Enums.Ternary
getSettingSriovAutoprobeDrivers :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> m Ternary
getSettingSriovAutoprobeDrivers o
obj = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Ternary
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"autoprobe-drivers"
setSettingSriovAutoprobeDrivers :: (MonadIO m, IsSettingSriov o) => o -> NM.Enums.Ternary -> m ()
setSettingSriovAutoprobeDrivers :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> Ternary -> m ()
setSettingSriovAutoprobeDrivers o
obj Ternary
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Ternary -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"autoprobe-drivers" Ternary
val
constructSettingSriovAutoprobeDrivers :: (IsSettingSriov o, MIO.MonadIO m) => NM.Enums.Ternary -> m (GValueConstruct o)
constructSettingSriovAutoprobeDrivers :: forall o (m :: * -> *).
(IsSettingSriov o, MonadIO m) =>
Ternary -> m (GValueConstruct o)
constructSettingSriovAutoprobeDrivers Ternary
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ternary -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"autoprobe-drivers" Ternary
val
#if defined(ENABLE_OVERLOADING)
data SettingSriovAutoprobeDriversPropertyInfo
instance AttrInfo SettingSriovAutoprobeDriversPropertyInfo where
type AttrAllowedOps SettingSriovAutoprobeDriversPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingSriovAutoprobeDriversPropertyInfo = IsSettingSriov
type AttrSetTypeConstraint SettingSriovAutoprobeDriversPropertyInfo = (~) NM.Enums.Ternary
type AttrTransferTypeConstraint SettingSriovAutoprobeDriversPropertyInfo = (~) NM.Enums.Ternary
type AttrTransferType SettingSriovAutoprobeDriversPropertyInfo = NM.Enums.Ternary
type AttrGetType SettingSriovAutoprobeDriversPropertyInfo = NM.Enums.Ternary
type AttrLabel SettingSriovAutoprobeDriversPropertyInfo = "autoprobe-drivers"
type AttrOrigin SettingSriovAutoprobeDriversPropertyInfo = SettingSriov
attrGet = getSettingSriovAutoprobeDrivers
attrSet = setSettingSriovAutoprobeDrivers
attrTransfer _ v = do
return v
attrConstruct = constructSettingSriovAutoprobeDrivers
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.autoprobeDrivers"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#g:attr:autoprobeDrivers"
})
#endif
getSettingSriovEswitchEncapMode :: (MonadIO m, IsSettingSriov o) => o -> m Int32
getSettingSriovEswitchEncapMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> m Int32
getSettingSriovEswitchEncapMode o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"eswitch-encap-mode"
setSettingSriovEswitchEncapMode :: (MonadIO m, IsSettingSriov o) => o -> Int32 -> m ()
setSettingSriovEswitchEncapMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> Int32 -> m ()
setSettingSriovEswitchEncapMode o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"eswitch-encap-mode" Int32
val
constructSettingSriovEswitchEncapMode :: (IsSettingSriov o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingSriovEswitchEncapMode :: forall o (m :: * -> *).
(IsSettingSriov o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingSriovEswitchEncapMode Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"eswitch-encap-mode" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingSriovEswitchEncapModePropertyInfo
instance AttrInfo SettingSriovEswitchEncapModePropertyInfo where
type AttrAllowedOps SettingSriovEswitchEncapModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingSriovEswitchEncapModePropertyInfo = IsSettingSriov
type AttrSetTypeConstraint SettingSriovEswitchEncapModePropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingSriovEswitchEncapModePropertyInfo = (~) Int32
type AttrTransferType SettingSriovEswitchEncapModePropertyInfo = Int32
type AttrGetType SettingSriovEswitchEncapModePropertyInfo = Int32
type AttrLabel SettingSriovEswitchEncapModePropertyInfo = "eswitch-encap-mode"
type AttrOrigin SettingSriovEswitchEncapModePropertyInfo = SettingSriov
attrGet = getSettingSriovEswitchEncapMode
attrSet = setSettingSriovEswitchEncapMode
attrTransfer _ v = do
return v
attrConstruct = constructSettingSriovEswitchEncapMode
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.eswitchEncapMode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#g:attr:eswitchEncapMode"
})
#endif
getSettingSriovEswitchInlineMode :: (MonadIO m, IsSettingSriov o) => o -> m Int32
getSettingSriovEswitchInlineMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> m Int32
getSettingSriovEswitchInlineMode o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"eswitch-inline-mode"
setSettingSriovEswitchInlineMode :: (MonadIO m, IsSettingSriov o) => o -> Int32 -> m ()
setSettingSriovEswitchInlineMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> Int32 -> m ()
setSettingSriovEswitchInlineMode o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"eswitch-inline-mode" Int32
val
constructSettingSriovEswitchInlineMode :: (IsSettingSriov o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingSriovEswitchInlineMode :: forall o (m :: * -> *).
(IsSettingSriov o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingSriovEswitchInlineMode Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"eswitch-inline-mode" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingSriovEswitchInlineModePropertyInfo
instance AttrInfo SettingSriovEswitchInlineModePropertyInfo where
type AttrAllowedOps SettingSriovEswitchInlineModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingSriovEswitchInlineModePropertyInfo = IsSettingSriov
type AttrSetTypeConstraint SettingSriovEswitchInlineModePropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingSriovEswitchInlineModePropertyInfo = (~) Int32
type AttrTransferType SettingSriovEswitchInlineModePropertyInfo = Int32
type AttrGetType SettingSriovEswitchInlineModePropertyInfo = Int32
type AttrLabel SettingSriovEswitchInlineModePropertyInfo = "eswitch-inline-mode"
type AttrOrigin SettingSriovEswitchInlineModePropertyInfo = SettingSriov
attrGet = getSettingSriovEswitchInlineMode
attrSet = setSettingSriovEswitchInlineMode
attrTransfer _ v = do
return v
attrConstruct = constructSettingSriovEswitchInlineMode
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.eswitchInlineMode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#g:attr:eswitchInlineMode"
})
#endif
getSettingSriovEswitchMode :: (MonadIO m, IsSettingSriov o) => o -> m Int32
getSettingSriovEswitchMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> m Int32
getSettingSriovEswitchMode o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"eswitch-mode"
setSettingSriovEswitchMode :: (MonadIO m, IsSettingSriov o) => o -> Int32 -> m ()
setSettingSriovEswitchMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> Int32 -> m ()
setSettingSriovEswitchMode o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"eswitch-mode" Int32
val
constructSettingSriovEswitchMode :: (IsSettingSriov o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingSriovEswitchMode :: forall o (m :: * -> *).
(IsSettingSriov o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingSriovEswitchMode Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"eswitch-mode" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingSriovEswitchModePropertyInfo
instance AttrInfo SettingSriovEswitchModePropertyInfo where
type AttrAllowedOps SettingSriovEswitchModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingSriovEswitchModePropertyInfo = IsSettingSriov
type AttrSetTypeConstraint SettingSriovEswitchModePropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingSriovEswitchModePropertyInfo = (~) Int32
type AttrTransferType SettingSriovEswitchModePropertyInfo = Int32
type AttrGetType SettingSriovEswitchModePropertyInfo = Int32
type AttrLabel SettingSriovEswitchModePropertyInfo = "eswitch-mode"
type AttrOrigin SettingSriovEswitchModePropertyInfo = SettingSriov
attrGet = getSettingSriovEswitchMode
attrSet = setSettingSriovEswitchMode
attrTransfer _ v = do
return v
attrConstruct = constructSettingSriovEswitchMode
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.eswitchMode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#g:attr:eswitchMode"
})
#endif
getSettingSriovTotalVfs :: (MonadIO m, IsSettingSriov o) => o -> m Word32
getSettingSriovTotalVfs :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> m Word32
getSettingSriovTotalVfs o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"total-vfs"
setSettingSriovTotalVfs :: (MonadIO m, IsSettingSriov o) => o -> Word32 -> m ()
setSettingSriovTotalVfs :: forall (m :: * -> *) o.
(MonadIO m, IsSettingSriov o) =>
o -> Word32 -> m ()
setSettingSriovTotalVfs o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"total-vfs" Word32
val
constructSettingSriovTotalVfs :: (IsSettingSriov o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingSriovTotalVfs :: forall o (m :: * -> *).
(IsSettingSriov o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingSriovTotalVfs Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"total-vfs" Word32
val
#if defined(ENABLE_OVERLOADING)
data SettingSriovTotalVfsPropertyInfo
instance AttrInfo SettingSriovTotalVfsPropertyInfo where
type AttrAllowedOps SettingSriovTotalVfsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingSriovTotalVfsPropertyInfo = IsSettingSriov
type AttrSetTypeConstraint SettingSriovTotalVfsPropertyInfo = (~) Word32
type AttrTransferTypeConstraint SettingSriovTotalVfsPropertyInfo = (~) Word32
type AttrTransferType SettingSriovTotalVfsPropertyInfo = Word32
type AttrGetType SettingSriovTotalVfsPropertyInfo = Word32
type AttrLabel SettingSriovTotalVfsPropertyInfo = "total-vfs"
type AttrOrigin SettingSriovTotalVfsPropertyInfo = SettingSriov
attrGet = getSettingSriovTotalVfs
attrSet = setSettingSriovTotalVfs
attrTransfer _ v = do
return v
attrConstruct = constructSettingSriovTotalVfs
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.totalVfs"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#g:attr:totalVfs"
})
#endif
#if defined(ENABLE_OVERLOADING)
data SettingSriovVfsPropertyInfo
instance AttrInfo SettingSriovVfsPropertyInfo where
type AttrAllowedOps SettingSriovVfsPropertyInfo = '[]
type AttrSetTypeConstraint SettingSriovVfsPropertyInfo = (~) ()
type AttrTransferTypeConstraint SettingSriovVfsPropertyInfo = (~) ()
type AttrTransferType SettingSriovVfsPropertyInfo = ()
type AttrBaseTypeConstraint SettingSriovVfsPropertyInfo = (~) ()
type AttrGetType SettingSriovVfsPropertyInfo = ()
type AttrLabel SettingSriovVfsPropertyInfo = ""
type AttrOrigin SettingSriovVfsPropertyInfo = SettingSriov
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SettingSriov
type instance O.AttributeList SettingSriov = SettingSriovAttributeList
type SettingSriovAttributeList = ('[ '("autoprobeDrivers", SettingSriovAutoprobeDriversPropertyInfo), '("eswitchEncapMode", SettingSriovEswitchEncapModePropertyInfo), '("eswitchInlineMode", SettingSriovEswitchInlineModePropertyInfo), '("eswitchMode", SettingSriovEswitchModePropertyInfo), '("name", NM.Setting.SettingNamePropertyInfo), '("totalVfs", SettingSriovTotalVfsPropertyInfo), '("vfs", SettingSriovVfsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
settingSriovAutoprobeDrivers :: AttrLabelProxy "autoprobeDrivers"
settingSriovAutoprobeDrivers = AttrLabelProxy
settingSriovEswitchEncapMode :: AttrLabelProxy "eswitchEncapMode"
settingSriovEswitchEncapMode = AttrLabelProxy
settingSriovEswitchInlineMode :: AttrLabelProxy "eswitchInlineMode"
settingSriovEswitchInlineMode = AttrLabelProxy
settingSriovEswitchMode :: AttrLabelProxy "eswitchMode"
settingSriovEswitchMode = AttrLabelProxy
settingSriovTotalVfs :: AttrLabelProxy "totalVfs"
settingSriovTotalVfs = AttrLabelProxy
settingSriovVfs :: AttrLabelProxy "vfs"
settingSriovVfs = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SettingSriov = SettingSriovSignalList
type SettingSriovSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_setting_sriov_new" nm_setting_sriov_new ::
IO (Ptr SettingSriov)
settingSriovNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m SettingSriov
settingSriovNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SettingSriov
settingSriovNew = IO SettingSriov -> m SettingSriov
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingSriov -> m SettingSriov)
-> IO SettingSriov -> m SettingSriov
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingSriov
result <- IO (Ptr SettingSriov)
nm_setting_sriov_new
Text -> Ptr SettingSriov -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingSriovNew" Ptr SettingSriov
result
SettingSriov
result' <- ((ManagedPtr SettingSriov -> SettingSriov)
-> Ptr SettingSriov -> IO SettingSriov
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SettingSriov -> SettingSriov
SettingSriov) Ptr SettingSriov
result
SettingSriov -> IO SettingSriov
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingSriov
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "nm_setting_sriov_add_vf" nm_setting_sriov_add_vf ::
Ptr SettingSriov ->
Ptr NM.SriovVF.SriovVF ->
IO ()
settingSriovAddVf ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> NM.SriovVF.SriovVF
-> m ()
settingSriovAddVf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> SriovVF -> m ()
settingSriovAddVf a
setting SriovVF
vf = 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 SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
Ptr SettingSriov -> Ptr SriovVF -> IO ()
nm_setting_sriov_add_vf Ptr SettingSriov
setting' Ptr SriovVF
vf'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data SettingSriovAddVfMethodInfo
instance (signature ~ (NM.SriovVF.SriovVF -> m ()), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovAddVfMethodInfo a signature where
overloadedMethod = settingSriovAddVf
instance O.OverloadedMethodInfo SettingSriovAddVfMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovAddVf",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovAddVf"
})
#endif
foreign import ccall "nm_setting_sriov_clear_vfs" nm_setting_sriov_clear_vfs ::
Ptr SettingSriov ->
IO ()
settingSriovClearVfs ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m ()
settingSriovClearVfs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m ()
settingSriovClearVfs a
setting = 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 SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Ptr SettingSriov -> IO ()
nm_setting_sriov_clear_vfs Ptr SettingSriov
setting'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data SettingSriovClearVfsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovClearVfsMethodInfo a signature where
overloadedMethod = settingSriovClearVfs
instance O.OverloadedMethodInfo SettingSriovClearVfsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovClearVfs",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovClearVfs"
})
#endif
foreign import ccall "nm_setting_sriov_get_autoprobe_drivers" nm_setting_sriov_get_autoprobe_drivers ::
Ptr SettingSriov ->
IO CInt
settingSriovGetAutoprobeDrivers ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m NM.Enums.Ternary
settingSriovGetAutoprobeDrivers :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m Ternary
settingSriovGetAutoprobeDrivers a
setting = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingSriov -> IO CInt
nm_setting_sriov_get_autoprobe_drivers Ptr SettingSriov
setting'
let result' :: Ternary
result' = (Int -> Ternary
forall a. Enum a => Int -> a
toEnum (Int -> Ternary) -> (CInt -> Int) -> CInt -> Ternary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Ternary -> IO Ternary
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ternary
result'
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetAutoprobeDriversMethodInfo
instance (signature ~ (m NM.Enums.Ternary), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetAutoprobeDriversMethodInfo a signature where
overloadedMethod = settingSriovGetAutoprobeDrivers
instance O.OverloadedMethodInfo SettingSriovGetAutoprobeDriversMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetAutoprobeDrivers",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetAutoprobeDrivers"
})
#endif
foreign import ccall "nm_setting_sriov_get_eswitch_encap_mode" nm_setting_sriov_get_eswitch_encap_mode ::
Ptr SettingSriov ->
IO CInt
settingSriovGetEswitchEncapMode ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m NM.Enums.SriovEswitchEncapMode
settingSriovGetEswitchEncapMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m SriovEswitchEncapMode
settingSriovGetEswitchEncapMode a
setting = IO SriovEswitchEncapMode -> m SriovEswitchEncapMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovEswitchEncapMode -> m SriovEswitchEncapMode)
-> IO SriovEswitchEncapMode -> m SriovEswitchEncapMode
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingSriov -> IO CInt
nm_setting_sriov_get_eswitch_encap_mode Ptr SettingSriov
setting'
let result' :: SriovEswitchEncapMode
result' = (Int -> SriovEswitchEncapMode
forall a. Enum a => Int -> a
toEnum (Int -> SriovEswitchEncapMode)
-> (CInt -> Int) -> CInt -> SriovEswitchEncapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
SriovEswitchEncapMode -> IO SriovEswitchEncapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovEswitchEncapMode
result'
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetEswitchEncapModeMethodInfo
instance (signature ~ (m NM.Enums.SriovEswitchEncapMode), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetEswitchEncapModeMethodInfo a signature where
overloadedMethod = settingSriovGetEswitchEncapMode
instance O.OverloadedMethodInfo SettingSriovGetEswitchEncapModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetEswitchEncapMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetEswitchEncapMode"
})
#endif
foreign import ccall "nm_setting_sriov_get_eswitch_inline_mode" nm_setting_sriov_get_eswitch_inline_mode ::
Ptr SettingSriov ->
IO CInt
settingSriovGetEswitchInlineMode ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m NM.Enums.SriovEswitchInlineMode
settingSriovGetEswitchInlineMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m SriovEswitchInlineMode
settingSriovGetEswitchInlineMode a
setting = IO SriovEswitchInlineMode -> m SriovEswitchInlineMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovEswitchInlineMode -> m SriovEswitchInlineMode)
-> IO SriovEswitchInlineMode -> m SriovEswitchInlineMode
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingSriov -> IO CInt
nm_setting_sriov_get_eswitch_inline_mode Ptr SettingSriov
setting'
let result' :: SriovEswitchInlineMode
result' = (Int -> SriovEswitchInlineMode
forall a. Enum a => Int -> a
toEnum (Int -> SriovEswitchInlineMode)
-> (CInt -> Int) -> CInt -> SriovEswitchInlineMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
SriovEswitchInlineMode -> IO SriovEswitchInlineMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovEswitchInlineMode
result'
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetEswitchInlineModeMethodInfo
instance (signature ~ (m NM.Enums.SriovEswitchInlineMode), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetEswitchInlineModeMethodInfo a signature where
overloadedMethod = settingSriovGetEswitchInlineMode
instance O.OverloadedMethodInfo SettingSriovGetEswitchInlineModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetEswitchInlineMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetEswitchInlineMode"
})
#endif
foreign import ccall "nm_setting_sriov_get_eswitch_mode" nm_setting_sriov_get_eswitch_mode ::
Ptr SettingSriov ->
IO CInt
settingSriovGetEswitchMode ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m NM.Enums.SriovEswitchMode
settingSriovGetEswitchMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m SriovEswitchMode
settingSriovGetEswitchMode a
setting = IO SriovEswitchMode -> m SriovEswitchMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovEswitchMode -> m SriovEswitchMode)
-> IO SriovEswitchMode -> m SriovEswitchMode
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingSriov -> IO CInt
nm_setting_sriov_get_eswitch_mode Ptr SettingSriov
setting'
let result' :: SriovEswitchMode
result' = (Int -> SriovEswitchMode
forall a. Enum a => Int -> a
toEnum (Int -> SriovEswitchMode)
-> (CInt -> Int) -> CInt -> SriovEswitchMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
SriovEswitchMode -> IO SriovEswitchMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovEswitchMode
result'
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetEswitchModeMethodInfo
instance (signature ~ (m NM.Enums.SriovEswitchMode), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetEswitchModeMethodInfo a signature where
overloadedMethod = settingSriovGetEswitchMode
instance O.OverloadedMethodInfo SettingSriovGetEswitchModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetEswitchMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetEswitchMode"
})
#endif
foreign import ccall "nm_setting_sriov_get_num_vfs" nm_setting_sriov_get_num_vfs ::
Ptr SettingSriov ->
IO Word32
settingSriovGetNumVfs ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m Word32
settingSriovGetNumVfs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m Word32
settingSriovGetNumVfs a
setting = 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 SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Word32
result <- Ptr SettingSriov -> IO Word32
nm_setting_sriov_get_num_vfs Ptr SettingSriov
setting'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetNumVfsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetNumVfsMethodInfo a signature where
overloadedMethod = settingSriovGetNumVfs
instance O.OverloadedMethodInfo SettingSriovGetNumVfsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetNumVfs",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetNumVfs"
})
#endif
foreign import ccall "nm_setting_sriov_get_total_vfs" nm_setting_sriov_get_total_vfs ::
Ptr SettingSriov ->
IO Word32
settingSriovGetTotalVfs ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> m Word32
settingSriovGetTotalVfs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> m Word32
settingSriovGetTotalVfs a
setting = 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 SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Word32
result <- Ptr SettingSriov -> IO Word32
nm_setting_sriov_get_total_vfs Ptr SettingSriov
setting'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetTotalVfsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetTotalVfsMethodInfo a signature where
overloadedMethod = settingSriovGetTotalVfs
instance O.OverloadedMethodInfo SettingSriovGetTotalVfsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetTotalVfs",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetTotalVfs"
})
#endif
foreign import ccall "nm_setting_sriov_get_vf" nm_setting_sriov_get_vf ::
Ptr SettingSriov ->
Word32 ->
IO (Ptr NM.SriovVF.SriovVF)
settingSriovGetVf ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> Word32
-> m NM.SriovVF.SriovVF
settingSriovGetVf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> Word32 -> m SriovVF
settingSriovGetVf a
setting Word32
idx = IO SriovVF -> m SriovVF
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovVF -> m SriovVF) -> IO SriovVF -> m SriovVF
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Ptr SriovVF
result <- Ptr SettingSriov -> Word32 -> IO (Ptr SriovVF)
nm_setting_sriov_get_vf Ptr SettingSriov
setting' Word32
idx
Text -> Ptr SriovVF -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingSriovGetVf" Ptr SriovVF
result
SriovVF
result' <- ((ManagedPtr SriovVF -> SriovVF) -> Ptr SriovVF -> IO SriovVF
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr SriovVF -> SriovVF
NM.SriovVF.SriovVF) Ptr SriovVF
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
SriovVF -> IO SriovVF
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovVF
result'
#if defined(ENABLE_OVERLOADING)
data SettingSriovGetVfMethodInfo
instance (signature ~ (Word32 -> m NM.SriovVF.SriovVF), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovGetVfMethodInfo a signature where
overloadedMethod = settingSriovGetVf
instance O.OverloadedMethodInfo SettingSriovGetVfMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovGetVf",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovGetVf"
})
#endif
foreign import ccall "nm_setting_sriov_remove_vf" nm_setting_sriov_remove_vf ::
Ptr SettingSriov ->
Word32 ->
IO ()
settingSriovRemoveVf ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> Word32
-> m ()
settingSriovRemoveVf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> Word32 -> m ()
settingSriovRemoveVf a
setting Word32
idx = 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 SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Ptr SettingSriov -> Word32 -> IO ()
nm_setting_sriov_remove_vf Ptr SettingSriov
setting' Word32
idx
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data SettingSriovRemoveVfMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovRemoveVfMethodInfo a signature where
overloadedMethod = settingSriovRemoveVf
instance O.OverloadedMethodInfo SettingSriovRemoveVfMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovRemoveVf",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovRemoveVf"
})
#endif
foreign import ccall "nm_setting_sriov_remove_vf_by_index" nm_setting_sriov_remove_vf_by_index ::
Ptr SettingSriov ->
Word32 ->
IO CInt
settingSriovRemoveVfByIndex ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingSriov a) =>
a
-> Word32
-> m Bool
settingSriovRemoveVfByIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingSriov a) =>
a -> Word32 -> m Bool
settingSriovRemoveVfByIndex a
setting Word32
index = 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 SettingSriov
setting' <- a -> IO (Ptr SettingSriov)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingSriov -> Word32 -> IO CInt
nm_setting_sriov_remove_vf_by_index Ptr SettingSriov
setting' Word32
index
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data SettingSriovRemoveVfByIndexMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsSettingSriov a) => O.OverloadedMethod SettingSriovRemoveVfByIndexMethodInfo a signature where
overloadedMethod = settingSriovRemoveVfByIndex
instance O.OverloadedMethodInfo SettingSriovRemoveVfByIndexMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingSriov.settingSriovRemoveVfByIndex",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingSriov.html#v:settingSriovRemoveVfByIndex"
})
#endif