{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.NM.Structs.BridgeVlan
    ( 

-- * Exported types
    BridgeVlan(..)                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [cmp]("GI.NM.Structs.BridgeVlan#g:method:cmp"), [isPvid]("GI.NM.Structs.BridgeVlan#g:method:isPvid"), [isSealed]("GI.NM.Structs.BridgeVlan#g:method:isSealed"), [isUntagged]("GI.NM.Structs.BridgeVlan#g:method:isUntagged"), [newClone]("GI.NM.Structs.BridgeVlan#g:method:newClone"), [ref]("GI.NM.Structs.BridgeVlan#g:method:ref"), [seal]("GI.NM.Structs.BridgeVlan#g:method:seal"), [toStr]("GI.NM.Structs.BridgeVlan#g:method:toStr"), [unref]("GI.NM.Structs.BridgeVlan#g:method:unref").
-- 
-- ==== Getters
-- [getVidRange]("GI.NM.Structs.BridgeVlan#g:method:getVidRange").
-- 
-- ==== Setters
-- [setPvid]("GI.NM.Structs.BridgeVlan#g:method:setPvid"), [setUntagged]("GI.NM.Structs.BridgeVlan#g:method:setUntagged").

#if defined(ENABLE_OVERLOADING)
    ResolveBridgeVlanMethod                 ,
#endif

-- ** cmp #method:cmp#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanCmpMethodInfo                 ,
#endif
    bridgeVlanCmp                           ,


-- ** fromStr #method:fromStr#

    bridgeVlanFromStr                       ,


-- ** getVidRange #method:getVidRange#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanGetVidRangeMethodInfo         ,
#endif
    bridgeVlanGetVidRange                   ,


-- ** isPvid #method:isPvid#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanIsPvidMethodInfo              ,
#endif
    bridgeVlanIsPvid                        ,


-- ** isSealed #method:isSealed#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanIsSealedMethodInfo            ,
#endif
    bridgeVlanIsSealed                      ,


-- ** isUntagged #method:isUntagged#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanIsUntaggedMethodInfo          ,
#endif
    bridgeVlanIsUntagged                    ,


-- ** new #method:new#

    bridgeVlanNew                           ,


-- ** newClone #method:newClone#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanNewCloneMethodInfo            ,
#endif
    bridgeVlanNewClone                      ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanRefMethodInfo                 ,
#endif
    bridgeVlanRef                           ,


-- ** seal #method:seal#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanSealMethodInfo                ,
#endif
    bridgeVlanSeal                          ,


-- ** setPvid #method:setPvid#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanSetPvidMethodInfo             ,
#endif
    bridgeVlanSetPvid                       ,


-- ** setUntagged #method:setUntagged#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanSetUntaggedMethodInfo         ,
#endif
    bridgeVlanSetUntagged                   ,


-- ** toStr #method:toStr#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanToStrMethodInfo               ,
#endif
    bridgeVlanToStr                         ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    BridgeVlanUnrefMethodInfo               ,
#endif
    bridgeVlanUnref                         ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)

#else

#endif

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

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

foreign import ccall "nm_bridge_vlan_get_type" c_nm_bridge_vlan_get_type :: 
    IO GType

type instance O.ParentTypes BridgeVlan = '[]
instance O.HasParentTypes BridgeVlan

instance B.Types.TypedObject BridgeVlan where
    glibType :: IO GType
glibType = IO GType
c_nm_bridge_vlan_get_type

instance B.Types.GBoxed BridgeVlan

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BridgeVlan
type instance O.AttributeList BridgeVlan = BridgeVlanAttributeList
type BridgeVlanAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method BridgeVlan::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "vid_start"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the start VLAN id, must be between 1 and 4094."
--                 , 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 end VLAN id, must be 0 or between @vid_start and 4094."
--                 , 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_bridge_vlan_new" nm_bridge_vlan_new :: 
    Word16 ->                               -- vid_start : TBasicType TUInt16
    Word16 ->                               -- vid_end : TBasicType TUInt16
    IO (Ptr BridgeVlan)

-- | Creates a new t'GI.NM.Structs.BridgeVlan.BridgeVlan' object for the given VLAN id range.
-- Setting /@vidEnd@/ to 0 is equivalent to setting it to /@vidStart@/
-- and creates a single-id VLAN.
-- 
-- Since 1.42, ref-counting of t'GI.NM.Structs.BridgeVlan.BridgeVlan' is thread-safe.
-- 
-- /Since: 1.18/
bridgeVlanNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word16
    -- ^ /@vidStart@/: the start VLAN id, must be between 1 and 4094.
    -> Word16
    -- ^ /@vidEnd@/: the end VLAN id, must be 0 or between /@vidStart@/ and 4094.
    -> m BridgeVlan
    -- ^ __Returns:__ the new t'GI.NM.Structs.BridgeVlan.BridgeVlan' object.
bridgeVlanNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word16 -> Word16 -> m BridgeVlan
bridgeVlanNew Word16
vidStart Word16
vidEnd = 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 BridgeVlan
result <- Word16 -> Word16 -> IO (Ptr BridgeVlan)
nm_bridge_vlan_new Word16
vidStart Word16
vidEnd
    Text -> Ptr BridgeVlan -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bridgeVlanNew" Ptr BridgeVlan
result
    BridgeVlan
result' <- ((ManagedPtr BridgeVlan -> BridgeVlan)
-> Ptr BridgeVlan -> IO BridgeVlan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BridgeVlan -> BridgeVlan
BridgeVlan) Ptr BridgeVlan
result
    BridgeVlan -> IO BridgeVlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeVlan
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method BridgeVlan::cmp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMBridgeVlan" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #NMBridgeVlan"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "nm_bridge_vlan_cmp" nm_bridge_vlan_cmp :: 
    Ptr BridgeVlan ->                       -- a : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    Ptr BridgeVlan ->                       -- b : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO Int32

-- | Compare two bridge VLAN objects.
-- 
-- /Since: 1.18/
bridgeVlanCmp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@a@/: a t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> BridgeVlan
    -- ^ /@b@/: another t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> m Int32
    -- ^ __Returns:__ zero of the two instances are equivalent or
    --   a non-zero integer otherwise. This defines a total ordering
    --   over the VLANs. Whether a VLAN is sealed or not does not
    --   affect the comparison.
bridgeVlanCmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> BridgeVlan -> m Int32
bridgeVlanCmp BridgeVlan
a BridgeVlan
b = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr BridgeVlan
a' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
a
    Ptr BridgeVlan
b' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
b
    Int32
result <- Ptr BridgeVlan -> Ptr BridgeVlan -> IO Int32
nm_bridge_vlan_cmp Ptr BridgeVlan
a' Ptr BridgeVlan
b'
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
a
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
b
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data BridgeVlanCmpMethodInfo
instance (signature ~ (BridgeVlan -> m Int32), MonadIO m) => O.OverloadedMethod BridgeVlanCmpMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanCmp

instance O.OverloadedMethodInfo BridgeVlanCmpMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanCmp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanCmp"
        })


#endif

-- method BridgeVlan::get_vid_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vid_start"
--           , argType = TBasicType TUInt16
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the VLAN id range start."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "vid_end"
--           , argType = TBasicType TUInt16
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the VLAN id range end"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | Gets the VLAN id range.
-- 
-- /Since: 1.18/
bridgeVlanGetVidRange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> m ((Bool, Word16, Word16))
    -- ^ __Returns:__ 'P.True' is the VLAN specifies a range, 'P.False' if it is
    -- a single-id VLAN.
bridgeVlanGetVidRange :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m (Bool, Word16, Word16)
bridgeVlanGetVidRange BridgeVlan
vlan = IO (Bool, Word16, Word16) -> m (Bool, Word16, Word16)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word16, Word16) -> m (Bool, Word16, Word16))
-> IO (Bool, Word16, Word16) -> m (Bool, Word16, Word16)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    Ptr Word16
vidStart <- IO (Ptr Word16)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word16)
    Ptr Word16
vidEnd <- IO (Ptr Word16)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word16)
    CInt
result <- Ptr BridgeVlan -> Ptr Word16 -> Ptr Word16 -> IO CInt
nm_bridge_vlan_get_vid_range Ptr BridgeVlan
vlan' Ptr Word16
vidStart Ptr Word16
vidEnd
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word16
vidStart' <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
vidStart
    Word16
vidEnd' <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek Ptr Word16
vidEnd
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
vidStart
    Ptr Word16 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word16
vidEnd
    (Bool, Word16, Word16) -> IO (Bool, Word16, Word16)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word16
vidStart', Word16
vidEnd')

#if defined(ENABLE_OVERLOADING)
data BridgeVlanGetVidRangeMethodInfo
instance (signature ~ (m ((Bool, Word16, Word16))), MonadIO m) => O.OverloadedMethod BridgeVlanGetVidRangeMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanGetVidRange

instance O.OverloadedMethodInfo BridgeVlanGetVidRangeMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanGetVidRange",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanGetVidRange"
        })


#endif

-- method BridgeVlan::is_pvid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , 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_bridge_vlan_is_pvid" nm_bridge_vlan_is_pvid :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO CInt

-- | Returns whether the VLAN is the PVID for the port.
-- 
-- /Since: 1.18/
bridgeVlanIsPvid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the VLAN is the PVID
bridgeVlanIsPvid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m Bool
bridgeVlanIsPvid BridgeVlan
vlan = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    CInt
result <- Ptr BridgeVlan -> IO CInt
nm_bridge_vlan_is_pvid Ptr BridgeVlan
vlan'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BridgeVlanIsPvidMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BridgeVlanIsPvidMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanIsPvid

instance O.OverloadedMethodInfo BridgeVlanIsPvidMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanIsPvid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanIsPvid"
        })


#endif

-- method BridgeVlan::is_sealed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan instance"
--                 , 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_bridge_vlan_is_sealed" nm_bridge_vlan_is_sealed :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
bridgeVlanIsSealed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan' instance
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is sealed or not.
bridgeVlanIsSealed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m Bool
bridgeVlanIsSealed BridgeVlan
vlan = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    CInt
result <- Ptr BridgeVlan -> IO CInt
nm_bridge_vlan_is_sealed Ptr BridgeVlan
vlan'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BridgeVlanIsSealedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BridgeVlanIsSealedMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanIsSealed

instance O.OverloadedMethodInfo BridgeVlanIsSealedMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanIsSealed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanIsSealed"
        })


#endif

-- method BridgeVlan::is_untagged
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , 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_bridge_vlan_is_untagged" nm_bridge_vlan_is_untagged :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO CInt

-- | Returns whether the VLAN is untagged.
-- 
-- /Since: 1.18/
bridgeVlanIsUntagged ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the VLAN is untagged, 'P.False' otherwise
bridgeVlanIsUntagged :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m Bool
bridgeVlanIsUntagged BridgeVlan
vlan = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    CInt
result <- Ptr BridgeVlan -> IO CInt
nm_bridge_vlan_is_untagged Ptr BridgeVlan
vlan'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data BridgeVlanIsUntaggedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod BridgeVlanIsUntaggedMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanIsUntagged

instance O.OverloadedMethodInfo BridgeVlanIsUntaggedMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanIsUntagged",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanIsUntagged"
        })


#endif

-- method BridgeVlan::new_clone
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan instance to copy"
--                 , 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_bridge_vlan_new_clone" nm_bridge_vlan_new_clone :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO (Ptr BridgeVlan)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.18/
bridgeVlanNewClone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan' instance to copy
    -> m BridgeVlan
    -- ^ __Returns:__ a clone of /@vlan@/. This instance
    --   is always unsealed.
bridgeVlanNewClone :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m BridgeVlan
bridgeVlanNewClone BridgeVlan
vlan = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    Ptr BridgeVlan
result <- Ptr BridgeVlan -> IO (Ptr BridgeVlan)
nm_bridge_vlan_new_clone Ptr BridgeVlan
vlan'
    Text -> Ptr BridgeVlan -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bridgeVlanNewClone" Ptr BridgeVlan
result
    BridgeVlan
result' <- ((ManagedPtr BridgeVlan -> BridgeVlan)
-> Ptr BridgeVlan -> IO BridgeVlan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BridgeVlan -> BridgeVlan
BridgeVlan) Ptr BridgeVlan
result
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    BridgeVlan -> IO BridgeVlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeVlan
result'

#if defined(ENABLE_OVERLOADING)
data BridgeVlanNewCloneMethodInfo
instance (signature ~ (m BridgeVlan), MonadIO m) => O.OverloadedMethod BridgeVlanNewCloneMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanNewClone

instance O.OverloadedMethodInfo BridgeVlanNewCloneMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanNewClone",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanNewClone"
        })


#endif

-- method BridgeVlan::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , 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_bridge_vlan_ref" nm_bridge_vlan_ref :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO (Ptr BridgeVlan)

-- | Increases the reference count of the object.
-- 
-- /Since: 1.18/
bridgeVlanRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> m BridgeVlan
    -- ^ __Returns:__ the input argument /@vlan@/ object.
    -- 
    -- Since 1.42, ref-counting of t'GI.NM.Structs.BridgeVlan.BridgeVlan' is thread-safe.
bridgeVlanRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m BridgeVlan
bridgeVlanRef BridgeVlan
vlan = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    Ptr BridgeVlan
result <- Ptr BridgeVlan -> IO (Ptr BridgeVlan)
nm_bridge_vlan_ref Ptr BridgeVlan
vlan'
    Text -> Ptr BridgeVlan -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bridgeVlanRef" Ptr BridgeVlan
result
    BridgeVlan
result' <- ((ManagedPtr BridgeVlan -> BridgeVlan)
-> Ptr BridgeVlan -> IO BridgeVlan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BridgeVlan -> BridgeVlan
BridgeVlan) Ptr BridgeVlan
result
    BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
    BridgeVlan -> IO BridgeVlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeVlan
result'

#if defined(ENABLE_OVERLOADING)
data BridgeVlanRefMethodInfo
instance (signature ~ (m BridgeVlan), MonadIO m) => O.OverloadedMethod BridgeVlanRefMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanRef

instance O.OverloadedMethodInfo BridgeVlanRefMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanRef"
        })


#endif

-- method BridgeVlan::seal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan instance"
--                 , 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_bridge_vlan_seal" nm_bridge_vlan_seal :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO ()

-- | Seal the t'GI.NM.Structs.BridgeVlan.BridgeVlan' instance. Afterwards, it is a bug
-- to call all functions that modify the instance (except ref\/unref).
-- A sealed instance cannot be unsealed again, but you can create
-- an unsealed copy with 'GI.NM.Structs.BridgeVlan.bridgeVlanNewClone'.
-- 
-- /Since: 1.18/
bridgeVlanSeal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan' instance
    -> m ()
bridgeVlanSeal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m ()
bridgeVlanSeal 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    Ptr BridgeVlan -> IO ()
nm_bridge_vlan_seal Ptr BridgeVlan
vlan'
    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 BridgeVlanSealMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BridgeVlanSealMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanSeal

instance O.OverloadedMethodInfo BridgeVlanSealMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanSeal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanSeal"
        })


#endif

-- method BridgeVlan::set_pvid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , 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_bridge_vlan_set_pvid" nm_bridge_vlan_set_pvid :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()

-- | Change the value of the PVID property of the VLAN. It
-- is invalid to set the value to 'P.True' for non-single-id
-- VLANs.
-- 
-- /Since: 1.18/
bridgeVlanSetPvid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> Bool
    -- ^ /@value@/: the new value
    -> m ()
bridgeVlanSetPvid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> Bool -> m ()
bridgeVlanSetPvid BridgeVlan
vlan Bool
value = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    let value' :: CInt
value' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
value
    Ptr BridgeVlan -> CInt -> IO ()
nm_bridge_vlan_set_pvid Ptr BridgeVlan
vlan' CInt
value'
    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 BridgeVlanSetPvidMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod BridgeVlanSetPvidMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanSetPvid

instance O.OverloadedMethodInfo BridgeVlanSetPvidMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanSetPvid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanSetPvid"
        })


#endif

-- method BridgeVlan::set_untagged
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , 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_bridge_vlan_set_untagged" nm_bridge_vlan_set_untagged :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()

-- | Change the value of the untagged property of the VLAN.
-- 
-- /Since: 1.18/
bridgeVlanSetUntagged ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> Bool
    -- ^ /@value@/: the new value
    -> m ()
bridgeVlanSetUntagged :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> Bool -> m ()
bridgeVlanSetUntagged BridgeVlan
vlan Bool
value = 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    let value' :: CInt
value' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
value
    Ptr BridgeVlan -> CInt -> IO ()
nm_bridge_vlan_set_untagged Ptr BridgeVlan
vlan' CInt
value'
    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 BridgeVlanSetUntaggedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod BridgeVlanSetUntaggedMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanSetUntagged

instance O.OverloadedMethodInfo BridgeVlanSetUntaggedMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanSetUntagged",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanSetUntagged"
        })


#endif

-- method BridgeVlan::to_str
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMBridgeVlan" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "nm_bridge_vlan_to_str" nm_bridge_vlan_to_str :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Convert a @/NMBridgeVlan/@ to a string.
-- 
-- /Since: 1.18/
bridgeVlanToStr ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the @/NMBridgeVlan/@
    -> m T.Text
    -- ^ __Returns:__ formatted string or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
bridgeVlanToStr :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m Text
bridgeVlanToStr BridgeVlan
vlan = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr BridgeVlan -> Ptr (Ptr GError) -> IO CString
nm_bridge_vlan_to_str Ptr BridgeVlan
vlan'
        Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bridgeVlanToStr" CString
result
        Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
        BridgeVlan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BridgeVlan
vlan
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data BridgeVlanToStrMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod BridgeVlanToStrMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanToStr

instance O.OverloadedMethodInfo BridgeVlanToStrMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanToStr",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanToStr"
        })


#endif

-- method BridgeVlan::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vlan"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "BridgeVlan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMBridgeVlan" , 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_bridge_vlan_unref" nm_bridge_vlan_unref :: 
    Ptr BridgeVlan ->                       -- vlan : TInterface (Name {namespace = "NM", name = "BridgeVlan"})
    IO ()

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero the object will be destroyed.
-- 
-- Since 1.42, ref-counting of t'GI.NM.Structs.BridgeVlan.BridgeVlan' is thread-safe.
-- 
-- /Since: 1.18/
bridgeVlanUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BridgeVlan
    -- ^ /@vlan@/: the t'GI.NM.Structs.BridgeVlan.BridgeVlan'
    -> m ()
bridgeVlanUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BridgeVlan -> m ()
bridgeVlanUnref 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 BridgeVlan
vlan' <- BridgeVlan -> IO (Ptr BridgeVlan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BridgeVlan
vlan
    Ptr BridgeVlan -> IO ()
nm_bridge_vlan_unref Ptr BridgeVlan
vlan'
    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 BridgeVlanUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod BridgeVlanUnrefMethodInfo BridgeVlan signature where
    overloadedMethod = bridgeVlanUnref

instance O.OverloadedMethodInfo BridgeVlanUnrefMethodInfo BridgeVlan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.BridgeVlan.bridgeVlanUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-BridgeVlan.html#v:bridgeVlanUnref"
        })


#endif

-- method BridgeVlan::from_str
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string representation of a bridge VLAN"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "BridgeVlan" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_bridge_vlan_from_str" nm_bridge_vlan_from_str :: 
    CString ->                              -- str : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr BridgeVlan)

-- | Parses the string representation of the queueing
-- discipline to a @/NMBridgeVlan/@ instance.
-- 
-- /Since: 1.18/
bridgeVlanFromStr ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@str@/: the string representation of a bridge VLAN
    -> m BridgeVlan
    -- ^ __Returns:__ the @/NMBridgeVlan/@ or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
bridgeVlanFromStr :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m BridgeVlan
bridgeVlanFromStr Text
str = 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
    CString
str' <- Text -> IO CString
textToCString Text
str
    IO BridgeVlan -> IO () -> IO BridgeVlan
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr BridgeVlan
result <- (Ptr (Ptr GError) -> IO (Ptr BridgeVlan)) -> IO (Ptr BridgeVlan)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr BridgeVlan)) -> IO (Ptr BridgeVlan))
-> (Ptr (Ptr GError) -> IO (Ptr BridgeVlan)) -> IO (Ptr BridgeVlan)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr BridgeVlan)
nm_bridge_vlan_from_str CString
str'
        Text -> Ptr BridgeVlan -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"bridgeVlanFromStr" Ptr BridgeVlan
result
        BridgeVlan
result' <- ((ManagedPtr BridgeVlan -> BridgeVlan)
-> Ptr BridgeVlan -> IO BridgeVlan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr BridgeVlan -> BridgeVlan
BridgeVlan) Ptr BridgeVlan
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
        BridgeVlan -> IO BridgeVlan
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BridgeVlan
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
     )

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBridgeVlanMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveBridgeVlanMethod "cmp" o = BridgeVlanCmpMethodInfo
    ResolveBridgeVlanMethod "isPvid" o = BridgeVlanIsPvidMethodInfo
    ResolveBridgeVlanMethod "isSealed" o = BridgeVlanIsSealedMethodInfo
    ResolveBridgeVlanMethod "isUntagged" o = BridgeVlanIsUntaggedMethodInfo
    ResolveBridgeVlanMethod "newClone" o = BridgeVlanNewCloneMethodInfo
    ResolveBridgeVlanMethod "ref" o = BridgeVlanRefMethodInfo
    ResolveBridgeVlanMethod "seal" o = BridgeVlanSealMethodInfo
    ResolveBridgeVlanMethod "toStr" o = BridgeVlanToStrMethodInfo
    ResolveBridgeVlanMethod "unref" o = BridgeVlanUnrefMethodInfo
    ResolveBridgeVlanMethod "getVidRange" o = BridgeVlanGetVidRangeMethodInfo
    ResolveBridgeVlanMethod "setPvid" o = BridgeVlanSetPvidMethodInfo
    ResolveBridgeVlanMethod "setUntagged" o = BridgeVlanSetUntaggedMethodInfo
    ResolveBridgeVlanMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif