{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Bridge Port Settings

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.NM.Objects.SettingBridgePort
    ( 

-- * Exported types
    SettingBridgePort(..)                   ,
    IsSettingBridgePort                     ,
    toSettingBridgePort                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addVlan]("GI.NM.Objects.SettingBridgePort#g:method:addVlan"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearVlans]("GI.NM.Objects.SettingBridgePort#g:method:clearVlans"), [compare]("GI.NM.Objects.Setting#g:method:compare"), [diff]("GI.NM.Objects.Setting#g:method:diff"), [duplicate]("GI.NM.Objects.Setting#g:method:duplicate"), [enumerateValues]("GI.NM.Objects.Setting#g:method:enumerateValues"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [optionClearByName]("GI.NM.Objects.Setting#g:method:optionClearByName"), [optionGet]("GI.NM.Objects.Setting#g:method:optionGet"), [optionGetAllNames]("GI.NM.Objects.Setting#g:method:optionGetAllNames"), [optionGetBoolean]("GI.NM.Objects.Setting#g:method:optionGetBoolean"), [optionGetUint32]("GI.NM.Objects.Setting#g:method:optionGetUint32"), [optionSet]("GI.NM.Objects.Setting#g:method:optionSet"), [optionSetBoolean]("GI.NM.Objects.Setting#g:method:optionSetBoolean"), [optionSetUint32]("GI.NM.Objects.Setting#g:method:optionSetUint32"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeVlan]("GI.NM.Objects.SettingBridgePort#g:method:removeVlan"), [removeVlanByVid]("GI.NM.Objects.SettingBridgePort#g:method:removeVlanByVid"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toString]("GI.NM.Objects.Setting#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [verify]("GI.NM.Objects.Setting#g:method:verify"), [verifySecrets]("GI.NM.Objects.Setting#g:method:verifySecrets"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDbusPropertyType]("GI.NM.Objects.Setting#g:method:getDbusPropertyType"), [getHairpinMode]("GI.NM.Objects.SettingBridgePort#g:method:getHairpinMode"), [getName]("GI.NM.Objects.Setting#g:method:getName"), [getNumVlans]("GI.NM.Objects.SettingBridgePort#g:method:getNumVlans"), [getPathCost]("GI.NM.Objects.SettingBridgePort#g:method:getPathCost"), [getPriority]("GI.NM.Objects.SettingBridgePort#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSecretFlags]("GI.NM.Objects.Setting#g:method:getSecretFlags"), [getVlan]("GI.NM.Objects.SettingBridgePort#g:method:getVlan").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSecretFlags]("GI.NM.Objects.Setting#g:method:setSecretFlags").

#if defined(ENABLE_OVERLOADING)
    ResolveSettingBridgePortMethod          ,
#endif

-- ** addVlan #method:addVlan#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortAddVlanMethodInfo      ,
#endif
    settingBridgePortAddVlan                ,


-- ** clearVlans #method:clearVlans#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortClearVlansMethodInfo   ,
#endif
    settingBridgePortClearVlans             ,


-- ** getHairpinMode #method:getHairpinMode#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortGetHairpinModeMethodInfo,
#endif
    settingBridgePortGetHairpinMode         ,


-- ** getNumVlans #method:getNumVlans#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortGetNumVlansMethodInfo  ,
#endif
    settingBridgePortGetNumVlans            ,


-- ** getPathCost #method:getPathCost#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortGetPathCostMethodInfo  ,
#endif
    settingBridgePortGetPathCost            ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortGetPriorityMethodInfo  ,
#endif
    settingBridgePortGetPriority            ,


-- ** getVlan #method:getVlan#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortGetVlanMethodInfo      ,
#endif
    settingBridgePortGetVlan                ,


-- ** new #method:new#

    settingBridgePortNew                    ,


-- ** removeVlan #method:removeVlan#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortRemoveVlanMethodInfo   ,
#endif
    settingBridgePortRemoveVlan             ,


-- ** removeVlanByVid #method:removeVlanByVid#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortRemoveVlanByVidMethodInfo,
#endif
    settingBridgePortRemoveVlanByVid        ,




 -- * Properties


-- ** hairpinMode #attr:hairpinMode#
-- | Enables or disables \"hairpin mode\" for the port, which allows frames to
-- be sent back out through the port the frame was received on.

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortHairpinModePropertyInfo,
#endif
    constructSettingBridgePortHairpinMode   ,
    getSettingBridgePortHairpinMode         ,
    setSettingBridgePortHairpinMode         ,
#if defined(ENABLE_OVERLOADING)
    settingBridgePortHairpinMode            ,
#endif


-- ** pathCost #attr:pathCost#
-- | The Spanning Tree Protocol (STP) port cost for destinations via this
-- port.

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortPathCostPropertyInfo   ,
#endif
    constructSettingBridgePortPathCost      ,
    getSettingBridgePortPathCost            ,
    setSettingBridgePortPathCost            ,
#if defined(ENABLE_OVERLOADING)
    settingBridgePortPathCost               ,
#endif


-- ** priority #attr:priority#
-- | The Spanning Tree Protocol (STP) priority of this bridge port.

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortPriorityPropertyInfo   ,
#endif
    constructSettingBridgePortPriority      ,
    getSettingBridgePortPriority            ,
    setSettingBridgePortPriority            ,
#if defined(ENABLE_OVERLOADING)
    settingBridgePortPriority               ,
#endif


-- ** vlans #attr:vlans#

#if defined(ENABLE_OVERLOADING)
    SettingBridgePortVlansPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    settingBridgePortVlans                  ,
#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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#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.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.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.Objects.Setting as NM.Setting
import {-# SOURCE #-} qualified GI.NM.Structs.BridgeVlan as NM.BridgeVlan

#endif

-- | Memory-managed wrapper type.
newtype SettingBridgePort = SettingBridgePort (SP.ManagedPtr SettingBridgePort)
    deriving (SettingBridgePort -> SettingBridgePort -> Bool
(SettingBridgePort -> SettingBridgePort -> Bool)
-> (SettingBridgePort -> SettingBridgePort -> Bool)
-> Eq SettingBridgePort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingBridgePort -> SettingBridgePort -> Bool
== :: SettingBridgePort -> SettingBridgePort -> Bool
$c/= :: SettingBridgePort -> SettingBridgePort -> Bool
/= :: SettingBridgePort -> SettingBridgePort -> Bool
Eq)

instance SP.ManagedPtrNewtype SettingBridgePort where
    toManagedPtr :: SettingBridgePort -> ManagedPtr SettingBridgePort
toManagedPtr (SettingBridgePort ManagedPtr SettingBridgePort
p) = ManagedPtr SettingBridgePort
p

foreign import ccall "nm_setting_bridge_port_get_type"
    c_nm_setting_bridge_port_get_type :: IO B.Types.GType

instance B.Types.TypedObject SettingBridgePort where
    glibType :: IO GType
glibType = IO GType
c_nm_setting_bridge_port_get_type

instance B.Types.GObject SettingBridgePort

-- | Type class for types which can be safely cast to t'SettingBridgePort', for instance with `toSettingBridgePort`.
class (SP.GObject o, O.IsDescendantOf SettingBridgePort o) => IsSettingBridgePort o
instance (SP.GObject o, O.IsDescendantOf SettingBridgePort o) => IsSettingBridgePort o

instance O.HasParentTypes SettingBridgePort
type instance O.ParentTypes SettingBridgePort = '[NM.Setting.Setting, GObject.Object.Object]

-- | Cast to t'SettingBridgePort', for types for which this is known to be safe. For general casts, use 'Data.GI.Base.ManagedPtr.castTo'.
toSettingBridgePort :: (MIO.MonadIO m, IsSettingBridgePort o) => o -> m SettingBridgePort
toSettingBridgePort :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> m SettingBridgePort
toSettingBridgePort = IO SettingBridgePort -> m SettingBridgePort
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SettingBridgePort -> m SettingBridgePort)
-> (o -> IO SettingBridgePort) -> o -> m SettingBridgePort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SettingBridgePort -> SettingBridgePort)
-> o -> IO SettingBridgePort
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SettingBridgePort -> SettingBridgePort
SettingBridgePort

-- | Convert t'SettingBridgePort' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SettingBridgePort) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_setting_bridge_port_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SettingBridgePort -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SettingBridgePort
P.Nothing = Ptr GValue -> Ptr SettingBridgePort -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SettingBridgePort
forall a. Ptr a
FP.nullPtr :: FP.Ptr SettingBridgePort)
    gvalueSet_ Ptr GValue
gv (P.Just SettingBridgePort
obj) = SettingBridgePort -> (Ptr SettingBridgePort -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SettingBridgePort
obj (Ptr GValue -> Ptr SettingBridgePort -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SettingBridgePort)
gvalueGet_ Ptr GValue
gv = do
        Ptr SettingBridgePort
ptr <- Ptr GValue -> IO (Ptr SettingBridgePort)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SettingBridgePort)
        if Ptr SettingBridgePort
ptr Ptr SettingBridgePort -> Ptr SettingBridgePort -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SettingBridgePort
forall a. Ptr a
FP.nullPtr
        then SettingBridgePort -> Maybe SettingBridgePort
forall a. a -> Maybe a
P.Just (SettingBridgePort -> Maybe SettingBridgePort)
-> IO SettingBridgePort -> IO (Maybe SettingBridgePort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SettingBridgePort -> SettingBridgePort)
-> Ptr SettingBridgePort -> IO SettingBridgePort
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SettingBridgePort -> SettingBridgePort
SettingBridgePort Ptr SettingBridgePort
ptr
        else Maybe SettingBridgePort -> IO (Maybe SettingBridgePort)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SettingBridgePort
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveSettingBridgePortMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSettingBridgePortMethod "addVlan" o = SettingBridgePortAddVlanMethodInfo
    ResolveSettingBridgePortMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSettingBridgePortMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSettingBridgePortMethod "clearVlans" o = SettingBridgePortClearVlansMethodInfo
    ResolveSettingBridgePortMethod "compare" o = NM.Setting.SettingCompareMethodInfo
    ResolveSettingBridgePortMethod "diff" o = NM.Setting.SettingDiffMethodInfo
    ResolveSettingBridgePortMethod "duplicate" o = NM.Setting.SettingDuplicateMethodInfo
    ResolveSettingBridgePortMethod "enumerateValues" o = NM.Setting.SettingEnumerateValuesMethodInfo
    ResolveSettingBridgePortMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSettingBridgePortMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSettingBridgePortMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSettingBridgePortMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSettingBridgePortMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSettingBridgePortMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSettingBridgePortMethod "optionClearByName" o = NM.Setting.SettingOptionClearByNameMethodInfo
    ResolveSettingBridgePortMethod "optionGet" o = NM.Setting.SettingOptionGetMethodInfo
    ResolveSettingBridgePortMethod "optionGetAllNames" o = NM.Setting.SettingOptionGetAllNamesMethodInfo
    ResolveSettingBridgePortMethod "optionGetBoolean" o = NM.Setting.SettingOptionGetBooleanMethodInfo
    ResolveSettingBridgePortMethod "optionGetUint32" o = NM.Setting.SettingOptionGetUint32MethodInfo
    ResolveSettingBridgePortMethod "optionSet" o = NM.Setting.SettingOptionSetMethodInfo
    ResolveSettingBridgePortMethod "optionSetBoolean" o = NM.Setting.SettingOptionSetBooleanMethodInfo
    ResolveSettingBridgePortMethod "optionSetUint32" o = NM.Setting.SettingOptionSetUint32MethodInfo
    ResolveSettingBridgePortMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSettingBridgePortMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSettingBridgePortMethod "removeVlan" o = SettingBridgePortRemoveVlanMethodInfo
    ResolveSettingBridgePortMethod "removeVlanByVid" o = SettingBridgePortRemoveVlanByVidMethodInfo
    ResolveSettingBridgePortMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSettingBridgePortMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSettingBridgePortMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSettingBridgePortMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSettingBridgePortMethod "toString" o = NM.Setting.SettingToStringMethodInfo
    ResolveSettingBridgePortMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSettingBridgePortMethod "verify" o = NM.Setting.SettingVerifyMethodInfo
    ResolveSettingBridgePortMethod "verifySecrets" o = NM.Setting.SettingVerifySecretsMethodInfo
    ResolveSettingBridgePortMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSettingBridgePortMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSettingBridgePortMethod "getDbusPropertyType" o = NM.Setting.SettingGetDbusPropertyTypeMethodInfo
    ResolveSettingBridgePortMethod "getHairpinMode" o = SettingBridgePortGetHairpinModeMethodInfo
    ResolveSettingBridgePortMethod "getName" o = NM.Setting.SettingGetNameMethodInfo
    ResolveSettingBridgePortMethod "getNumVlans" o = SettingBridgePortGetNumVlansMethodInfo
    ResolveSettingBridgePortMethod "getPathCost" o = SettingBridgePortGetPathCostMethodInfo
    ResolveSettingBridgePortMethod "getPriority" o = SettingBridgePortGetPriorityMethodInfo
    ResolveSettingBridgePortMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSettingBridgePortMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSettingBridgePortMethod "getSecretFlags" o = NM.Setting.SettingGetSecretFlagsMethodInfo
    ResolveSettingBridgePortMethod "getVlan" o = SettingBridgePortGetVlanMethodInfo
    ResolveSettingBridgePortMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSettingBridgePortMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSettingBridgePortMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSettingBridgePortMethod "setSecretFlags" o = NM.Setting.SettingSetSecretFlagsMethodInfo
    ResolveSettingBridgePortMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSettingBridgePortMethod t SettingBridgePort, O.OverloadedMethod info SettingBridgePort p) => OL.IsLabel t (SettingBridgePort -> 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 ~ ResolveSettingBridgePortMethod t SettingBridgePort, O.OverloadedMethod info SettingBridgePort p, R.HasField t SettingBridgePort p) => R.HasField t SettingBridgePort p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveSettingBridgePortMethod t SettingBridgePort, O.OverloadedMethodInfo info SettingBridgePort) => OL.IsLabel t (O.MethodProxy info SettingBridgePort) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "hairpin-mode"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@hairpin-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' settingBridgePort #hairpinMode
-- @
getSettingBridgePortHairpinMode :: (MonadIO m, IsSettingBridgePort o) => o -> m Bool
getSettingBridgePortHairpinMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> m Bool
getSettingBridgePortHairpinMode o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"hairpin-mode"

-- | Set the value of the “@hairpin-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' settingBridgePort [ #hairpinMode 'Data.GI.Base.Attributes.:=' value ]
-- @
setSettingBridgePortHairpinMode :: (MonadIO m, IsSettingBridgePort o) => o -> Bool -> m ()
setSettingBridgePortHairpinMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> Bool -> m ()
setSettingBridgePortHairpinMode o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"hairpin-mode" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@hairpin-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSettingBridgePortHairpinMode :: (IsSettingBridgePort o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSettingBridgePortHairpinMode :: forall o (m :: * -> *).
(IsSettingBridgePort o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSettingBridgePortHairpinMode Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"hairpin-mode" Bool
val

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortHairpinModePropertyInfo
instance AttrInfo SettingBridgePortHairpinModePropertyInfo where
    type AttrAllowedOps SettingBridgePortHairpinModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SettingBridgePortHairpinModePropertyInfo = IsSettingBridgePort
    type AttrSetTypeConstraint SettingBridgePortHairpinModePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SettingBridgePortHairpinModePropertyInfo = (~) Bool
    type AttrTransferType SettingBridgePortHairpinModePropertyInfo = Bool
    type AttrGetType SettingBridgePortHairpinModePropertyInfo = Bool
    type AttrLabel SettingBridgePortHairpinModePropertyInfo = "hairpin-mode"
    type AttrOrigin SettingBridgePortHairpinModePropertyInfo = SettingBridgePort
    attrGet = getSettingBridgePortHairpinMode
    attrSet = setSettingBridgePortHairpinMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructSettingBridgePortHairpinMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.hairpinMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#g:attr:hairpinMode"
        })
#endif

-- VVV Prop "path-cost"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@path-cost@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' settingBridgePort #pathCost
-- @
getSettingBridgePortPathCost :: (MonadIO m, IsSettingBridgePort o) => o -> m Word32
getSettingBridgePortPathCost :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> m Word32
getSettingBridgePortPathCost 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
"path-cost"

-- | Set the value of the “@path-cost@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' settingBridgePort [ #pathCost 'Data.GI.Base.Attributes.:=' value ]
-- @
setSettingBridgePortPathCost :: (MonadIO m, IsSettingBridgePort o) => o -> Word32 -> m ()
setSettingBridgePortPathCost :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> Word32 -> m ()
setSettingBridgePortPathCost 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
"path-cost" Word32
val

-- | Construct a t'GValueConstruct' with valid value for the “@path-cost@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSettingBridgePortPathCost :: (IsSettingBridgePort o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingBridgePortPathCost :: forall o (m :: * -> *).
(IsSettingBridgePort o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingBridgePortPathCost 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
"path-cost" Word32
val

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortPathCostPropertyInfo
instance AttrInfo SettingBridgePortPathCostPropertyInfo where
    type AttrAllowedOps SettingBridgePortPathCostPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SettingBridgePortPathCostPropertyInfo = IsSettingBridgePort
    type AttrSetTypeConstraint SettingBridgePortPathCostPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SettingBridgePortPathCostPropertyInfo = (~) Word32
    type AttrTransferType SettingBridgePortPathCostPropertyInfo = Word32
    type AttrGetType SettingBridgePortPathCostPropertyInfo = Word32
    type AttrLabel SettingBridgePortPathCostPropertyInfo = "path-cost"
    type AttrOrigin SettingBridgePortPathCostPropertyInfo = SettingBridgePort
    attrGet = getSettingBridgePortPathCost
    attrSet = setSettingBridgePortPathCost
    attrTransfer _ v = do
        return v
    attrConstruct = constructSettingBridgePortPathCost
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.pathCost"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#g:attr:pathCost"
        })
#endif

-- VVV Prop "priority"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' settingBridgePort #priority
-- @
getSettingBridgePortPriority :: (MonadIO m, IsSettingBridgePort o) => o -> m Word32
getSettingBridgePortPriority :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> m Word32
getSettingBridgePortPriority 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
"priority"

-- | Set the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' settingBridgePort [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setSettingBridgePortPriority :: (MonadIO m, IsSettingBridgePort o) => o -> Word32 -> m ()
setSettingBridgePortPriority :: forall (m :: * -> *) o.
(MonadIO m, IsSettingBridgePort o) =>
o -> Word32 -> m ()
setSettingBridgePortPriority 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
"priority" Word32
val

-- | Construct a t'GValueConstruct' with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSettingBridgePortPriority :: (IsSettingBridgePort o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingBridgePortPriority :: forall o (m :: * -> *).
(IsSettingBridgePort o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingBridgePortPriority 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
"priority" Word32
val

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortPriorityPropertyInfo
instance AttrInfo SettingBridgePortPriorityPropertyInfo where
    type AttrAllowedOps SettingBridgePortPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SettingBridgePortPriorityPropertyInfo = IsSettingBridgePort
    type AttrSetTypeConstraint SettingBridgePortPriorityPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint SettingBridgePortPriorityPropertyInfo = (~) Word32
    type AttrTransferType SettingBridgePortPriorityPropertyInfo = Word32
    type AttrGetType SettingBridgePortPriorityPropertyInfo = Word32
    type AttrLabel SettingBridgePortPriorityPropertyInfo = "priority"
    type AttrOrigin SettingBridgePortPriorityPropertyInfo = SettingBridgePort
    attrGet = getSettingBridgePortPriority
    attrSet = setSettingBridgePortPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructSettingBridgePortPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#g:attr:priority"
        })
#endif

-- XXX Generation of property "vlans" of object "SettingBridgePort" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "BridgeVlan"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data SettingBridgePortVlansPropertyInfo
instance AttrInfo SettingBridgePortVlansPropertyInfo where
    type AttrAllowedOps SettingBridgePortVlansPropertyInfo = '[]
    type AttrSetTypeConstraint SettingBridgePortVlansPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SettingBridgePortVlansPropertyInfo = (~) ()
    type AttrTransferType SettingBridgePortVlansPropertyInfo = ()
    type AttrBaseTypeConstraint SettingBridgePortVlansPropertyInfo = (~) ()
    type AttrGetType SettingBridgePortVlansPropertyInfo = ()
    type AttrLabel SettingBridgePortVlansPropertyInfo = ""
    type AttrOrigin SettingBridgePortVlansPropertyInfo = SettingBridgePort
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SettingBridgePort
type instance O.AttributeList SettingBridgePort = SettingBridgePortAttributeList
type SettingBridgePortAttributeList = ('[ '("hairpinMode", SettingBridgePortHairpinModePropertyInfo), '("name", NM.Setting.SettingNamePropertyInfo), '("pathCost", SettingBridgePortPathCostPropertyInfo), '("priority", SettingBridgePortPriorityPropertyInfo), '("vlans", SettingBridgePortVlansPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
settingBridgePortHairpinMode :: AttrLabelProxy "hairpinMode"
settingBridgePortHairpinMode = AttrLabelProxy

settingBridgePortPathCost :: AttrLabelProxy "pathCost"
settingBridgePortPathCost = AttrLabelProxy

settingBridgePortPriority :: AttrLabelProxy "priority"
settingBridgePortPriority = AttrLabelProxy

settingBridgePortVlans :: AttrLabelProxy "vlans"
settingBridgePortVlans = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SettingBridgePort = SettingBridgePortSignalList
type SettingBridgePortSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method SettingBridgePort::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "SettingBridgePort" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_new" nm_setting_bridge_port_new :: 
    IO (Ptr SettingBridgePort)

-- | Creates a new t'GI.NM.Objects.SettingBridgePort.SettingBridgePort' object with default values.
settingBridgePortNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SettingBridgePort
    -- ^ __Returns:__ the new empty t'GI.NM.Objects.SettingBridgePort.SettingBridgePort' object
settingBridgePortNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m SettingBridgePort
settingBridgePortNew  = IO SettingBridgePort -> m SettingBridgePort
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingBridgePort -> m SettingBridgePort)
-> IO SettingBridgePort -> m SettingBridgePort
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBridgePort
result <- IO (Ptr SettingBridgePort)
nm_setting_bridge_port_new
    Text -> Ptr SettingBridgePort -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingBridgePortNew" Ptr SettingBridgePort
result
    SettingBridgePort
result' <- ((ManagedPtr SettingBridgePort -> SettingBridgePort)
-> Ptr SettingBridgePort -> IO SettingBridgePort
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SettingBridgePort -> SettingBridgePort
SettingBridgePort) Ptr SettingBridgePort
result
    SettingBridgePort -> IO SettingBridgePort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingBridgePort
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SettingBridgePort::add_vlan
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vlan to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_add_vlan" nm_setting_bridge_port_add_vlan :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    Ptr NM.BridgeVlan.BridgeVlan ->         -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO ()

-- | Appends a new vlan and associated information to the setting.  The
-- given vlan gets sealed and a reference to it is added.
-- 
-- /Since: 1.18/
settingBridgePortAddVlan ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> NM.BridgeVlan.BridgeVlan
    -- ^ /@vlan@/: the vlan to add
    -> m ()
settingBridgePortAddVlan :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> BridgeVlan -> m ()
settingBridgePortAddVlan a
setting BridgeVlan
vlan = 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Ptr BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    Ptr SettingBridgePort -> Ptr BridgeVlan -> IO ()
nm_setting_bridge_port_add_vlan Ptr SettingBridgePort
setting' Ptr BridgeVlan
vlan'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortAddVlanMethodInfo
instance (signature ~ (NM.BridgeVlan.BridgeVlan -> m ()), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortAddVlanMethodInfo a signature where
    overloadedMethod = settingBridgePortAddVlan

instance O.OverloadedMethodInfo SettingBridgePortAddVlanMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortAddVlan",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortAddVlan"
        })


#endif

-- method SettingBridgePort::clear_vlans
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_clear_vlans" nm_setting_bridge_port_clear_vlans :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    IO ()

-- | Removes all configured VLANs.
-- 
-- /Since: 1.18/
settingBridgePortClearVlans ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> m ()
settingBridgePortClearVlans :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> m ()
settingBridgePortClearVlans 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Ptr SettingBridgePort -> IO ()
nm_setting_bridge_port_clear_vlans Ptr SettingBridgePort
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 SettingBridgePortClearVlansMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortClearVlansMethodInfo a signature where
    overloadedMethod = settingBridgePortClearVlans

instance O.OverloadedMethodInfo SettingBridgePortClearVlansMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortClearVlans",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortClearVlans"
        })


#endif

-- method SettingBridgePort::get_hairpin_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_get_hairpin_mode" nm_setting_bridge_port_get_hairpin_mode :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    IO CInt

-- | /No description available in the introspection data./
settingBridgePortGetHairpinMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> m Bool
    -- ^ __Returns:__ the [SettingBridgePort:hairpinMode]("GI.NM.Objects.SettingBridgePort#g:attr:hairpinMode") property of the setting
settingBridgePortGetHairpinMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> m Bool
settingBridgePortGetHairpinMode a
setting = 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CInt
result <- Ptr SettingBridgePort -> IO CInt
nm_setting_bridge_port_get_hairpin_mode Ptr SettingBridgePort
setting'
    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 SettingBridgePortGetHairpinModeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortGetHairpinModeMethodInfo a signature where
    overloadedMethod = settingBridgePortGetHairpinMode

instance O.OverloadedMethodInfo SettingBridgePortGetHairpinModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortGetHairpinMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortGetHairpinMode"
        })


#endif

-- method SettingBridgePort::get_num_vlans
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_get_num_vlans" nm_setting_bridge_port_get_num_vlans :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    IO Word32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
settingBridgePortGetNumVlans ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> m Word32
    -- ^ __Returns:__ the number of VLANs
settingBridgePortGetNumVlans :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> m Word32
settingBridgePortGetNumVlans 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Word32
result <- Ptr SettingBridgePort -> IO Word32
nm_setting_bridge_port_get_num_vlans Ptr SettingBridgePort
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 SettingBridgePortGetNumVlansMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortGetNumVlansMethodInfo a signature where
    overloadedMethod = settingBridgePortGetNumVlans

instance O.OverloadedMethodInfo SettingBridgePortGetNumVlansMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortGetNumVlans",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortGetNumVlans"
        })


#endif

-- method SettingBridgePort::get_path_cost
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt16)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_get_path_cost" nm_setting_bridge_port_get_path_cost :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    IO Word16

-- | /No description available in the introspection data./
settingBridgePortGetPathCost ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> m Word16
    -- ^ __Returns:__ the [SettingBridgePort:pathCost]("GI.NM.Objects.SettingBridgePort#g:attr:pathCost") property of the setting
settingBridgePortGetPathCost :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> m Word16
settingBridgePortGetPathCost a
setting = 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Word16
result <- Ptr SettingBridgePort -> IO Word16
nm_setting_bridge_port_get_path_cost Ptr SettingBridgePort
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortGetPathCostMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortGetPathCostMethodInfo a signature where
    overloadedMethod = settingBridgePortGetPathCost

instance O.OverloadedMethodInfo SettingBridgePortGetPathCostMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortGetPathCost",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortGetPathCost"
        })


#endif

-- method SettingBridgePort::get_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt16)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_get_priority" nm_setting_bridge_port_get_priority :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    IO Word16

-- | /No description available in the introspection data./
settingBridgePortGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> m Word16
    -- ^ __Returns:__ the [SettingBridgePort:priority]("GI.NM.Objects.SettingBridgePort#g:attr:priority") property of the setting
settingBridgePortGetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> m Word16
settingBridgePortGetPriority a
setting = 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Word16
result <- Ptr SettingBridgePort -> IO Word16
nm_setting_bridge_port_get_priority Ptr SettingBridgePort
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortGetPriorityMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortGetPriorityMethodInfo a signature where
    overloadedMethod = settingBridgePortGetPriority

instance O.OverloadedMethodInfo SettingBridgePortGetPriorityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortGetPriority",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortGetPriority"
        })


#endif

-- method SettingBridgePort::get_vlan
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index number of the VLAN to return"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "BridgeVlan" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_get_vlan" nm_setting_bridge_port_get_vlan :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr NM.BridgeVlan.BridgeVlan)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
settingBridgePortGetVlan ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> Word32
    -- ^ /@idx@/: index number of the VLAN to return
    -> m NM.BridgeVlan.BridgeVlan
    -- ^ __Returns:__ the VLAN at index /@idx@/
settingBridgePortGetVlan :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> Word32 -> m BridgeVlan
settingBridgePortGetVlan a
setting Word32
idx = IO BridgeVlan -> m BridgeVlan
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BridgeVlan -> m BridgeVlan) -> IO BridgeVlan -> m BridgeVlan
forall a b. (a -> b) -> a -> b
$ do
    Ptr SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Ptr BridgeVlan
result <- Ptr SettingBridgePort -> Word32 -> IO (Ptr BridgeVlan)
nm_setting_bridge_port_get_vlan Ptr SettingBridgePort
setting' Word32
idx
    Text -> Ptr BridgeVlan -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingBridgePortGetVlan" Ptr BridgeVlan
result
    BridgeVlan
result' <- ((ManagedPtr BridgeVlan -> BridgeVlan)
-> Ptr BridgeVlan -> IO BridgeVlan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr BridgeVlan -> BridgeVlan
NM.BridgeVlan.BridgeVlan) Ptr BridgeVlan
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
    BridgeVlan -> IO BridgeVlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeVlan
result'

#if defined(ENABLE_OVERLOADING)
data SettingBridgePortGetVlanMethodInfo
instance (signature ~ (Word32 -> m NM.BridgeVlan.BridgeVlan), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortGetVlanMethodInfo a signature where
    overloadedMethod = settingBridgePortGetVlan

instance O.OverloadedMethodInfo SettingBridgePortGetVlanMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortGetVlan",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortGetVlan"
        })


#endif

-- method SettingBridgePort::remove_vlan
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index number of the VLAN."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_remove_vlan" nm_setting_bridge_port_remove_vlan :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO ()

-- | Removes the vlan at index /@idx@/.
-- 
-- /Since: 1.18/
settingBridgePortRemoveVlan ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> Word32
    -- ^ /@idx@/: index number of the VLAN.
    -> m ()
settingBridgePortRemoveVlan :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> Word32 -> m ()
settingBridgePortRemoveVlan 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    Ptr SettingBridgePort -> Word32 -> IO ()
nm_setting_bridge_port_remove_vlan Ptr SettingBridgePort
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 SettingBridgePortRemoveVlanMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortRemoveVlanMethodInfo a signature where
    overloadedMethod = settingBridgePortRemoveVlan

instance O.OverloadedMethodInfo SettingBridgePortRemoveVlanMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortRemoveVlan",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortRemoveVlan"
        })


#endif

-- method SettingBridgePort::remove_vlan_by_vid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "setting"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingBridgePort" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSettingBridgePort"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vid_start"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vlan start index"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vid_end"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the vlan end index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_setting_bridge_port_remove_vlan_by_vid" nm_setting_bridge_port_remove_vlan_by_vid :: 
    Ptr SettingBridgePort ->                -- setting : TInterface (Name {namespace = "NM", name = "SettingBridgePort"})
    Word16 ->                               -- vid_start : TBasicType TUInt16
    Word16 ->                               -- vid_end : TBasicType TUInt16
    IO CInt

-- | Remove the VLAN with range /@vidStart@/ to /@vidEnd@/.
-- If /@vidEnd@/ is zero, it is assumed to be equal to /@vidStart@/
-- and so the single-id VLAN with id /@vidStart@/ is removed.
-- 
-- /Since: 1.18/
settingBridgePortRemoveVlanByVid ::
    (B.CallStack.HasCallStack, MonadIO m, IsSettingBridgePort a) =>
    a
    -- ^ /@setting@/: the t'GI.NM.Objects.SettingBridgePort.SettingBridgePort'
    -> Word16
    -- ^ /@vidStart@/: the vlan start index
    -> Word16
    -- ^ /@vidEnd@/: the vlan end index
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the vlan was found and removed; 'P.False' otherwise
settingBridgePortRemoveVlanByVid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingBridgePort a) =>
a -> Word16 -> Word16 -> m Bool
settingBridgePortRemoveVlanByVid a
setting Word16
vidStart Word16
vidEnd = 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 SettingBridgePort
setting' <- a -> IO (Ptr SettingBridgePort)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
    CInt
result <- Ptr SettingBridgePort -> Word16 -> Word16 -> IO CInt
nm_setting_bridge_port_remove_vlan_by_vid Ptr SettingBridgePort
setting' Word16
vidStart Word16
vidEnd
    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 SettingBridgePortRemoveVlanByVidMethodInfo
instance (signature ~ (Word16 -> Word16 -> m Bool), MonadIO m, IsSettingBridgePort a) => O.OverloadedMethod SettingBridgePortRemoveVlanByVidMethodInfo a signature where
    overloadedMethod = settingBridgePortRemoveVlanByVid

instance O.OverloadedMethodInfo SettingBridgePortRemoveVlanByVidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.SettingBridgePort.settingBridgePortRemoveVlanByVid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingBridgePort.html#v:settingBridgePortRemoveVlanByVid"
        })


#endif