{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Supported attributes are:
-- 
-- * 'GI.NM.Constants.LLDP_ATTR_CHASSIS_ID_TYPE' (type: \'u\')
-- * 'GI.NM.Constants.LLDP_ATTR_CHASSIS_ID' (type: \'s\')
-- * 'GI.NM.Constants.LLDP_ATTR_DESTINATION' (type: \'s\')
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_PPVID' (type: \'u\'). This attribute only reports the first PPVID
--   and therefore it is deprecated in favor of NM_LLDP_ATTR_IEEE_802_1_PPVIDS which reports
--   all the PPVID.
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_PPVID_FLAGS' (type: \'u\'). This attribute only reports the first PPVID
--   and therefore it is deprecated in favor of NM_LLDP_ATTR_IEEE_802_1_PPVIDS which reports
--   all the PPVID.
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_PPVIDS' (type: \'aa{sv}\')
--   
--   An array of dictionaries where each element has keys:
-- 
-- * flags (type: \'u\')
-- * ppvid (type: \'u\')
-- 
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_PVID' (type: \'u\')
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_VID' (type: \'u\'). This attribute only reports the first VLAN
--   and therefore it is deprecated in favor of NM_LLDP_ATTR_IEEE_802_1_VLANS which reports
--   all the VLANs.
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_VLAN_NAME' (type: \'s\'). This attribute only reports the first VLAN
--   and therefore it is deprecated in favor of NM_LLDP_ATTR_IEEE_802_1_VLANS which reports
--   all the VLANs.
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_1_VLANS' (type: \'aa{sv}\')
--   
--   An array of dictionaries where each element has keys:
-- 
-- * name (type: \'s\')
-- * vid (type: \'u\')
-- 
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_3_MAC_PHY_CONF' (type: \'a{sv}\')
-- 
-- 
--   Dictionary where each element has keys:
-- * autoneg (type: \'u\')
-- * operational-mau-type (type: \'u\')
-- * pmd-autoneg-cap (type: \'u\')
-- 
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_3_MAX_FRAME_SIZE' (type: \'u\')
-- * 'GI.NM.Constants.LLDP_ATTR_IEEE_802_3_POWER_VIA_MDI' (type: \'a{sv}\')
-- 
-- 
--   Dictionary where each element has keys:
-- * mdi-power-support (type: \'u\')
-- * power-class (type: \'u\')
-- * pse-power-pair (type: \'u\')
-- 
-- * 'GI.NM.Constants.LLDP_ATTR_MANAGEMENT_ADDRESSES' (type: \'aa{sv}\')
-- 
-- 
--   An array of dictionaries where each element has keys:
-- * address (type: \'ay\')
-- * address-subtype (type: \'u\')
-- * interface-number (type: \'u\')
-- * interface-number-subtype (type: \'u\')
-- * object-id (type: \'ay\')
-- 
-- * 'GI.NM.Constants.LLDP_ATTR_PORT_DESCRIPTION' (type: \'s\')
-- * 'GI.NM.Constants.LLDP_ATTR_PORT_ID_TYPE' (type: \'u\')
-- * 'GI.NM.Constants.LLDP_ATTR_PORT_ID' (type: \'s\')
-- * 'GI.NM.Constants.LLDP_ATTR_RAW' (type: \'ay\')
-- * 'GI.NM.Constants.LLDP_ATTR_SYSTEM_CAPABILITIES' (type: \'u\')
-- * 'GI.NM.Constants.LLDP_ATTR_SYSTEM_DESCRIPTION' (type: \'s\')
-- * 'GI.NM.Constants.LLDP_ATTR_SYSTEM_NAME' (type: \'s\')
-- 

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

module GI.NM.Structs.LldpNeighbor
    ( 

-- * Exported types
    LldpNeighbor(..)                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [ref]("GI.NM.Structs.LldpNeighbor#g:method:ref"), [unref]("GI.NM.Structs.LldpNeighbor#g:method:unref").
-- 
-- ==== Getters
-- [getAttrNames]("GI.NM.Structs.LldpNeighbor#g:method:getAttrNames"), [getAttrStringValue]("GI.NM.Structs.LldpNeighbor#g:method:getAttrStringValue"), [getAttrType]("GI.NM.Structs.LldpNeighbor#g:method:getAttrType"), [getAttrUintValue]("GI.NM.Structs.LldpNeighbor#g:method:getAttrUintValue"), [getAttrValue]("GI.NM.Structs.LldpNeighbor#g:method:getAttrValue").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveLldpNeighborMethod               ,
#endif

-- ** getAttrNames #method:getAttrNames#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborGetAttrNamesMethodInfo      ,
#endif
    lldpNeighborGetAttrNames                ,


-- ** getAttrStringValue #method:getAttrStringValue#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborGetAttrStringValueMethodInfo,
#endif
    lldpNeighborGetAttrStringValue          ,


-- ** getAttrType #method:getAttrType#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborGetAttrTypeMethodInfo       ,
#endif
    lldpNeighborGetAttrType                 ,


-- ** getAttrUintValue #method:getAttrUintValue#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborGetAttrUintValueMethodInfo  ,
#endif
    lldpNeighborGetAttrUintValue            ,


-- ** getAttrValue #method:getAttrValue#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborGetAttrValueMethodInfo      ,
#endif
    lldpNeighborGetAttrValue                ,


-- ** new #method:new#

    lldpNeighborNew                         ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborRefMethodInfo               ,
#endif
    lldpNeighborRef                         ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    LldpNeighborUnrefMethodInfo             ,
#endif
    lldpNeighborUnref                       ,




    ) 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.VariantType as GLib.VariantType

#else
import qualified GI.GLib.Structs.VariantType as GLib.VariantType

#endif

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

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

foreign import ccall "nm_lldp_neighbor_get_type" c_nm_lldp_neighbor_get_type :: 
    IO GType

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

instance B.Types.TypedObject LldpNeighbor where
    glibType :: IO GType
glibType = IO GType
c_nm_lldp_neighbor_get_type

instance B.Types.GBoxed LldpNeighbor

-- | Convert t'LldpNeighbor' 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 LldpNeighbor) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_lldp_neighbor_get_type
    gvalueSet_ :: Ptr GValue -> Maybe LldpNeighbor -> IO ()
gvalueSet_ Ptr GValue
gv Maybe LldpNeighbor
P.Nothing = Ptr GValue -> Ptr LldpNeighbor -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr LldpNeighbor
forall a. Ptr a
FP.nullPtr :: FP.Ptr LldpNeighbor)
    gvalueSet_ Ptr GValue
gv (P.Just LldpNeighbor
obj) = LldpNeighbor -> (Ptr LldpNeighbor -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr LldpNeighbor
obj (Ptr GValue -> Ptr LldpNeighbor -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe LldpNeighbor)
gvalueGet_ Ptr GValue
gv = do
        Ptr LldpNeighbor
ptr <- Ptr GValue -> IO (Ptr LldpNeighbor)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr LldpNeighbor)
        if Ptr LldpNeighbor
ptr Ptr LldpNeighbor -> Ptr LldpNeighbor -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr LldpNeighbor
forall a. Ptr a
FP.nullPtr
        then LldpNeighbor -> Maybe LldpNeighbor
forall a. a -> Maybe a
P.Just (LldpNeighbor -> Maybe LldpNeighbor)
-> IO LldpNeighbor -> IO (Maybe LldpNeighbor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr LldpNeighbor -> LldpNeighbor)
-> Ptr LldpNeighbor -> IO LldpNeighbor
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr LldpNeighbor -> LldpNeighbor
LldpNeighbor Ptr LldpNeighbor
ptr
        else Maybe LldpNeighbor -> IO (Maybe LldpNeighbor)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LldpNeighbor
forall a. Maybe a
P.Nothing
        
    


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

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

foreign import ccall "nm_lldp_neighbor_new" nm_lldp_neighbor_new :: 
    IO (Ptr LldpNeighbor)

-- | Creates a new t'GI.NM.Structs.LldpNeighbor.LldpNeighbor' object.
-- 
-- Note that t'GI.NM.Structs.LldpNeighbor.LldpNeighbor' has no public API for mutating
-- an instance. Also, libnm will not internally mutate a
-- once exposed object. They are guaranteed to be immutable.
-- 
-- Since 1.32, ref-counting of t'GI.NM.Structs.LldpNeighbor.LldpNeighbor' is thread-safe.
-- 
-- This function is not useful, as there is no public API to
-- actually modify the (empty) instance.
-- 
-- /Since: 1.2/
lldpNeighborNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m LldpNeighbor
    -- ^ __Returns:__ the new t'GI.NM.Structs.LldpNeighbor.LldpNeighbor' object.
lldpNeighborNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m LldpNeighbor
lldpNeighborNew  = IO LldpNeighbor -> m LldpNeighbor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LldpNeighbor -> m LldpNeighbor)
-> IO LldpNeighbor -> m LldpNeighbor
forall a b. (a -> b) -> a -> b
$ do
    Ptr LldpNeighbor
result <- IO (Ptr LldpNeighbor)
nm_lldp_neighbor_new
    Text -> Ptr LldpNeighbor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lldpNeighborNew" Ptr LldpNeighbor
result
    LldpNeighbor
result' <- ((ManagedPtr LldpNeighbor -> LldpNeighbor)
-> Ptr LldpNeighbor -> IO LldpNeighbor
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr LldpNeighbor -> LldpNeighbor
LldpNeighbor) Ptr LldpNeighbor
result
    LldpNeighbor -> IO LldpNeighbor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LldpNeighbor
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "nm_lldp_neighbor_get_attr_names" nm_lldp_neighbor_get_attr_names :: 
    Ptr LldpNeighbor ->                     -- neighbor : TInterface (Name {namespace = "NM", name = "LldpNeighbor"})
    IO (Ptr CString)

-- | Gets an array of attribute names available for /@neighbor@/.
-- 
-- /Since: 1.2/
lldpNeighborGetAttrNames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of attribute names.
lldpNeighborGetAttrNames :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> m [Text]
lldpNeighborGetAttrNames LldpNeighbor
neighbor = 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 LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    Ptr CString
result <- Ptr LldpNeighbor -> IO (Ptr CString)
nm_lldp_neighbor_get_attr_names Ptr LldpNeighbor
neighbor'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lldpNeighborGetAttrNames" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data LldpNeighborGetAttrNamesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod LldpNeighborGetAttrNamesMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborGetAttrNames

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


#endif

-- method LldpNeighbor::get_attr_string_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "neighbor"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "LldpNeighbor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMLldpNeighbor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "on return, the\n  attribute value"
--                 , 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_lldp_neighbor_get_attr_string_value" nm_lldp_neighbor_get_attr_string_value :: 
    Ptr LldpNeighbor ->                     -- neighbor : TInterface (Name {namespace = "NM", name = "LldpNeighbor"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CString ->                          -- out_value : TBasicType TUTF8
    IO CInt

-- | Gets the string value of attribute with name /@name@/ on /@neighbor@/
-- 
-- /Since: 1.2/
lldpNeighborGetAttrStringValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> T.Text
    -- ^ /@name@/: the attribute name
    -> m ((Bool, Maybe T.Text))
    -- ^ __Returns:__ 'P.True' if a string attribute with name /@name@/ was found, 'P.False' otherwise
lldpNeighborGetAttrStringValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> Text -> m (Bool, Maybe Text)
lldpNeighborGetAttrStringValue LldpNeighbor
neighbor Text
name = IO (Bool, Maybe Text) -> m (Bool, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Maybe Text) -> m (Bool, Maybe Text))
-> IO (Bool, Maybe Text) -> m (Bool, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CString
outValue <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr LldpNeighbor -> CString -> Ptr CString -> IO CInt
nm_lldp_neighbor_get_attr_string_value Ptr LldpNeighbor
neighbor' CString
name' Ptr CString
outValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString
outValue' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outValue
    Maybe Text
maybeOutValue' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
outValue' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
outValue'' -> do
        Text
outValue''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outValue''
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outValue'''
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outValue
    (Bool, Maybe Text) -> IO (Bool, Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Maybe Text
maybeOutValue')

#if defined(ENABLE_OVERLOADING)
data LldpNeighborGetAttrStringValueMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Maybe T.Text))), MonadIO m) => O.OverloadedMethod LldpNeighborGetAttrStringValueMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborGetAttrStringValue

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


#endif

-- method LldpNeighbor::get_attr_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "neighbor"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "LldpNeighbor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMLldpNeighbor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GLib" , name = "VariantType" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_lldp_neighbor_get_attr_type" nm_lldp_neighbor_get_attr_type :: 
    Ptr LldpNeighbor ->                     -- neighbor : TInterface (Name {namespace = "NM", name = "LldpNeighbor"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GLib.VariantType.VariantType)

-- | Get the type of an attribute.
-- 
-- /Since: 1.2/
lldpNeighborGetAttrType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> T.Text
    -- ^ /@name@/: the attribute name
    -> m GLib.VariantType.VariantType
    -- ^ __Returns:__ the t'GI.GLib.Structs.VariantType.VariantType' of the attribute with name /@name@/
lldpNeighborGetAttrType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> Text -> m VariantType
lldpNeighborGetAttrType LldpNeighbor
neighbor Text
name = IO VariantType -> m VariantType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VariantType -> m VariantType)
-> IO VariantType -> m VariantType
forall a b. (a -> b) -> a -> b
$ do
    Ptr LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr VariantType
result <- Ptr LldpNeighbor -> CString -> IO (Ptr VariantType)
nm_lldp_neighbor_get_attr_type Ptr LldpNeighbor
neighbor' CString
name'
    Text -> Ptr VariantType -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lldpNeighborGetAttrType" Ptr VariantType
result
    VariantType
result' <- ((ManagedPtr VariantType -> VariantType)
-> Ptr VariantType -> IO VariantType
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr VariantType -> VariantType
GLib.VariantType.VariantType) Ptr VariantType
result
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    VariantType -> IO VariantType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VariantType
result'

#if defined(ENABLE_OVERLOADING)
data LldpNeighborGetAttrTypeMethodInfo
instance (signature ~ (T.Text -> m GLib.VariantType.VariantType), MonadIO m) => O.OverloadedMethod LldpNeighborGetAttrTypeMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborGetAttrType

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


#endif

-- method LldpNeighbor::get_attr_uint_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "neighbor"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "LldpNeighbor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMLldpNeighbor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_value"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "on return, the attribute value"
--                 , 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_lldp_neighbor_get_attr_uint_value" nm_lldp_neighbor_get_attr_uint_value :: 
    Ptr LldpNeighbor ->                     -- neighbor : TInterface (Name {namespace = "NM", name = "LldpNeighbor"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Word32 ->                           -- out_value : TBasicType TUInt
    IO CInt

-- | Gets the uint32 value of attribute with name /@name@/ on /@neighbor@/
-- 
-- /Since: 1.2/
lldpNeighborGetAttrUintValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> T.Text
    -- ^ /@name@/: the attribute name
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if a uint32 attribute with name /@name@/ was found, 'P.False' otherwise
lldpNeighborGetAttrUintValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> Text -> m (Bool, Word32)
lldpNeighborGetAttrUintValue LldpNeighbor
neighbor Text
name = IO (Bool, Word32) -> m (Bool, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Word32
outValue <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr LldpNeighbor -> CString -> Ptr Word32 -> IO CInt
nm_lldp_neighbor_get_attr_uint_value Ptr LldpNeighbor
neighbor' CString
name' Ptr Word32
outValue
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
outValue' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outValue
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outValue
    (Bool, Word32) -> IO (Bool, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
outValue')

#if defined(ENABLE_OVERLOADING)
data LldpNeighborGetAttrUintValueMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word32))), MonadIO m) => O.OverloadedMethod LldpNeighborGetAttrUintValueMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborGetAttrUintValue

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


#endif

-- method LldpNeighbor::get_attr_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "neighbor"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "LldpNeighbor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMLldpNeighbor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "nm_lldp_neighbor_get_attr_value" nm_lldp_neighbor_get_attr_value :: 
    Ptr LldpNeighbor ->                     -- neighbor : TInterface (Name {namespace = "NM", name = "LldpNeighbor"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Gets the value (as a GVariant) of attribute with name /@name@/ on /@neighbor@/
-- 
-- /Since: 1.18/
lldpNeighborGetAttrValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> T.Text
    -- ^ /@name@/: the attribute name
    -> m GVariant
    -- ^ __Returns:__ the value or 'P.Nothing' if the attribute with /@name@/ was
    -- not found.
lldpNeighborGetAttrValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> Text -> m GVariant
lldpNeighborGetAttrValue LldpNeighbor
neighbor Text
name = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
result <- Ptr LldpNeighbor -> CString -> IO (Ptr GVariant)
nm_lldp_neighbor_get_attr_value Ptr LldpNeighbor
neighbor' CString
name'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lldpNeighborGetAttrValue" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data LldpNeighborGetAttrValueMethodInfo
instance (signature ~ (T.Text -> m GVariant), MonadIO m) => O.OverloadedMethod LldpNeighborGetAttrValueMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborGetAttrValue

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


#endif

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

-- | Increases the reference count of the object.
-- 
-- Since 1.32, ref-counting of t'GI.NM.Structs.LldpNeighbor.LldpNeighbor' is thread-safe.
-- 
-- /Since: 1.2/
lldpNeighborRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> m ()
lldpNeighborRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> m ()
lldpNeighborRef LldpNeighbor
neighbor = 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 LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    Ptr LldpNeighbor -> IO ()
nm_lldp_neighbor_ref Ptr LldpNeighbor
neighbor'
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LldpNeighborRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod LldpNeighborRefMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborRef

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


#endif

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

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero, the object will be destroyed.
-- 
-- Since 1.32, ref-counting of t'GI.NM.Structs.LldpNeighbor.LldpNeighbor' is thread-safe.
-- 
-- /Since: 1.2/
lldpNeighborUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    LldpNeighbor
    -- ^ /@neighbor@/: the t'GI.NM.Structs.LldpNeighbor.LldpNeighbor'
    -> m ()
lldpNeighborUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
LldpNeighbor -> m ()
lldpNeighborUnref LldpNeighbor
neighbor = 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 LldpNeighbor
neighbor' <- LldpNeighbor -> IO (Ptr LldpNeighbor)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr LldpNeighbor
neighbor
    Ptr LldpNeighbor -> IO ()
nm_lldp_neighbor_unref Ptr LldpNeighbor
neighbor'
    LldpNeighbor -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr LldpNeighbor
neighbor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LldpNeighborUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod LldpNeighborUnrefMethodInfo LldpNeighbor signature where
    overloadedMethod = lldpNeighborUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveLldpNeighborMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveLldpNeighborMethod "ref" o = LldpNeighborRefMethodInfo
    ResolveLldpNeighborMethod "unref" o = LldpNeighborUnrefMethodInfo
    ResolveLldpNeighborMethod "getAttrNames" o = LldpNeighborGetAttrNamesMethodInfo
    ResolveLldpNeighborMethod "getAttrStringValue" o = LldpNeighborGetAttrStringValueMethodInfo
    ResolveLldpNeighborMethod "getAttrType" o = LldpNeighborGetAttrTypeMethodInfo
    ResolveLldpNeighborMethod "getAttrUintValue" o = LldpNeighborGetAttrUintValueMethodInfo
    ResolveLldpNeighborMethod "getAttrValue" o = LldpNeighborGetAttrValueMethodInfo
    ResolveLldpNeighborMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif