{-# 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.TeamLinkWatcher
    ( 

-- * Exported types
    TeamLinkWatcher(..)                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [dup]("GI.NM.Structs.TeamLinkWatcher#g:method:dup"), [equal]("GI.NM.Structs.TeamLinkWatcher#g:method:equal"), [ref]("GI.NM.Structs.TeamLinkWatcher#g:method:ref"), [unref]("GI.NM.Structs.TeamLinkWatcher#g:method:unref").
-- 
-- ==== Getters
-- [getDelayDown]("GI.NM.Structs.TeamLinkWatcher#g:method:getDelayDown"), [getDelayUp]("GI.NM.Structs.TeamLinkWatcher#g:method:getDelayUp"), [getFlags]("GI.NM.Structs.TeamLinkWatcher#g:method:getFlags"), [getInitWait]("GI.NM.Structs.TeamLinkWatcher#g:method:getInitWait"), [getInterval]("GI.NM.Structs.TeamLinkWatcher#g:method:getInterval"), [getMissedMax]("GI.NM.Structs.TeamLinkWatcher#g:method:getMissedMax"), [getName]("GI.NM.Structs.TeamLinkWatcher#g:method:getName"), [getSourceHost]("GI.NM.Structs.TeamLinkWatcher#g:method:getSourceHost"), [getTargetHost]("GI.NM.Structs.TeamLinkWatcher#g:method:getTargetHost"), [getVlanid]("GI.NM.Structs.TeamLinkWatcher#g:method:getVlanid").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveTeamLinkWatcherMethod            ,
#endif

-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherDupMethodInfo            ,
#endif
    teamLinkWatcherDup                      ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherEqualMethodInfo          ,
#endif
    teamLinkWatcherEqual                    ,


-- ** getDelayDown #method:getDelayDown#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetDelayDownMethodInfo   ,
#endif
    teamLinkWatcherGetDelayDown             ,


-- ** getDelayUp #method:getDelayUp#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetDelayUpMethodInfo     ,
#endif
    teamLinkWatcherGetDelayUp               ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetFlagsMethodInfo       ,
#endif
    teamLinkWatcherGetFlags                 ,


-- ** getInitWait #method:getInitWait#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetInitWaitMethodInfo    ,
#endif
    teamLinkWatcherGetInitWait              ,


-- ** getInterval #method:getInterval#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetIntervalMethodInfo    ,
#endif
    teamLinkWatcherGetInterval              ,


-- ** getMissedMax #method:getMissedMax#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetMissedMaxMethodInfo   ,
#endif
    teamLinkWatcherGetMissedMax             ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetNameMethodInfo        ,
#endif
    teamLinkWatcherGetName                  ,


-- ** getSourceHost #method:getSourceHost#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetSourceHostMethodInfo  ,
#endif
    teamLinkWatcherGetSourceHost            ,


-- ** getTargetHost #method:getTargetHost#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetTargetHostMethodInfo  ,
#endif
    teamLinkWatcherGetTargetHost            ,


-- ** getVlanid #method:getVlanid#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherGetVlanidMethodInfo      ,
#endif
    teamLinkWatcherGetVlanid                ,


-- ** newArpPing #method:newArpPing#

    teamLinkWatcherNewArpPing               ,


-- ** newArpPing2 #method:newArpPing2#

    teamLinkWatcherNewArpPing2              ,


-- ** newEthtool #method:newEthtool#

    teamLinkWatcherNewEthtool               ,


-- ** newNsnaPing #method:newNsnaPing#

    teamLinkWatcherNewNsnaPing              ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherRefMethodInfo            ,
#endif
    teamLinkWatcherRef                      ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TeamLinkWatcherUnrefMethodInfo          ,
#endif
    teamLinkWatcherUnref                    ,




    ) 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 {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags

#else
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags

#endif

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

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

foreign import ccall "nm_team_link_watcher_get_type" c_nm_team_link_watcher_get_type :: 
    IO GType

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

instance B.Types.TypedObject TeamLinkWatcher where
    glibType :: IO GType
glibType = IO GType
c_nm_team_link_watcher_get_type

instance B.Types.GBoxed TeamLinkWatcher

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


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

-- method TeamLinkWatcher::new_arp_ping
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "init_wait"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "init_wait value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "interval value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "missed_max"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "missed_max value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the host name or the ip address that will be used as destination\n  address in the arp request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the host name or the ip address that will be used as source\n  address in the arp request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "NM" , name = "TeamLinkWatcherArpPingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the watcher #NMTeamLinkWatcherArpPingFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_team_link_watcher_new_arp_ping" nm_team_link_watcher_new_arp_ping :: 
    Int32 ->                                -- init_wait : TBasicType TInt
    Int32 ->                                -- interval : TBasicType TInt
    Int32 ->                                -- missed_max : TBasicType TInt
    CString ->                              -- target_host : TBasicType TUTF8
    CString ->                              -- source_host : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "NM", name = "TeamLinkWatcherArpPingFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TeamLinkWatcher)

-- | Creates a new arp_ping t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object
-- 
-- /Since: 1.12/
teamLinkWatcherNewArpPing ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@initWait@/: init_wait value
    -> Int32
    -- ^ /@interval@/: interval value
    -> Int32
    -- ^ /@missedMax@/: missed_max value
    -> T.Text
    -- ^ /@targetHost@/: the host name or the ip address that will be used as destination
    --   address in the arp request
    -> T.Text
    -- ^ /@sourceHost@/: the host name or the ip address that will be used as source
    --   address in the arp request
    -> [NM.Flags.TeamLinkWatcherArpPingFlags]
    -- ^ /@flags@/: the watcher t'GI.NM.Flags.TeamLinkWatcherArpPingFlags'
    -> m TeamLinkWatcher
    -- ^ __Returns:__ the new t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
teamLinkWatcherNewArpPing :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32
-> Int32
-> Int32
-> Text
-> Text
-> [TeamLinkWatcherArpPingFlags]
-> m TeamLinkWatcher
teamLinkWatcherNewArpPing Int32
initWait Int32
interval Int32
missedMax Text
targetHost Text
sourceHost [TeamLinkWatcherArpPingFlags]
flags = IO TeamLinkWatcher -> m TeamLinkWatcher
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TeamLinkWatcher -> m TeamLinkWatcher)
-> IO TeamLinkWatcher -> m TeamLinkWatcher
forall a b. (a -> b) -> a -> b
$ do
    CString
targetHost' <- Text -> IO CString
textToCString Text
targetHost
    CString
sourceHost' <- Text -> IO CString
textToCString Text
sourceHost
    let flags' :: CUInt
flags' = [TeamLinkWatcherArpPingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TeamLinkWatcherArpPingFlags]
flags
    IO TeamLinkWatcher -> IO () -> IO TeamLinkWatcher
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TeamLinkWatcher
result <- (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
 -> IO (Ptr TeamLinkWatcher))
-> (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a b. (a -> b) -> a -> b
$ Int32
-> Int32
-> Int32
-> CString
-> CString
-> CUInt
-> Ptr (Ptr GError)
-> IO (Ptr TeamLinkWatcher)
nm_team_link_watcher_new_arp_ping Int32
initWait Int32
interval Int32
missedMax CString
targetHost' CString
sourceHost' CUInt
flags'
        Text -> Ptr TeamLinkWatcher -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherNewArpPing" Ptr TeamLinkWatcher
result
        TeamLinkWatcher
result' <- ((ManagedPtr TeamLinkWatcher -> TeamLinkWatcher)
-> Ptr TeamLinkWatcher -> IO TeamLinkWatcher
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TeamLinkWatcher -> TeamLinkWatcher
TeamLinkWatcher) Ptr TeamLinkWatcher
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetHost'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceHost'
        TeamLinkWatcher -> IO TeamLinkWatcher
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TeamLinkWatcher
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetHost'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceHost'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TeamLinkWatcher::new_arp_ping2
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "init_wait"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "init_wait value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "interval value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "missed_max"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "missed_max value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlanid"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vlanid value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the host name or the ip address that will be used as destination\n  address in the arp request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the host name or the ip address that will be used as source\n  address in the arp request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "NM" , name = "TeamLinkWatcherArpPingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the watcher #NMTeamLinkWatcherArpPingFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_team_link_watcher_new_arp_ping2" nm_team_link_watcher_new_arp_ping2 :: 
    Int32 ->                                -- init_wait : TBasicType TInt
    Int32 ->                                -- interval : TBasicType TInt
    Int32 ->                                -- missed_max : TBasicType TInt
    Int32 ->                                -- vlanid : TBasicType TInt
    CString ->                              -- target_host : TBasicType TUTF8
    CString ->                              -- source_host : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "NM", name = "TeamLinkWatcherArpPingFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TeamLinkWatcher)

-- | Creates a new arp_ping t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object
-- 
-- /Since: 1.16/
teamLinkWatcherNewArpPing2 ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@initWait@/: init_wait value
    -> Int32
    -- ^ /@interval@/: interval value
    -> Int32
    -- ^ /@missedMax@/: missed_max value
    -> Int32
    -- ^ /@vlanid@/: vlanid value
    -> T.Text
    -- ^ /@targetHost@/: the host name or the ip address that will be used as destination
    --   address in the arp request
    -> T.Text
    -- ^ /@sourceHost@/: the host name or the ip address that will be used as source
    --   address in the arp request
    -> [NM.Flags.TeamLinkWatcherArpPingFlags]
    -- ^ /@flags@/: the watcher t'GI.NM.Flags.TeamLinkWatcherArpPingFlags'
    -> m TeamLinkWatcher
    -- ^ __Returns:__ the new t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
teamLinkWatcherNewArpPing2 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32
-> Int32
-> Int32
-> Int32
-> Text
-> Text
-> [TeamLinkWatcherArpPingFlags]
-> m TeamLinkWatcher
teamLinkWatcherNewArpPing2 Int32
initWait Int32
interval Int32
missedMax Int32
vlanid Text
targetHost Text
sourceHost [TeamLinkWatcherArpPingFlags]
flags = IO TeamLinkWatcher -> m TeamLinkWatcher
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TeamLinkWatcher -> m TeamLinkWatcher)
-> IO TeamLinkWatcher -> m TeamLinkWatcher
forall a b. (a -> b) -> a -> b
$ do
    CString
targetHost' <- Text -> IO CString
textToCString Text
targetHost
    CString
sourceHost' <- Text -> IO CString
textToCString Text
sourceHost
    let flags' :: CUInt
flags' = [TeamLinkWatcherArpPingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TeamLinkWatcherArpPingFlags]
flags
    IO TeamLinkWatcher -> IO () -> IO TeamLinkWatcher
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TeamLinkWatcher
result <- (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
 -> IO (Ptr TeamLinkWatcher))
-> (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a b. (a -> b) -> a -> b
$ Int32
-> Int32
-> Int32
-> Int32
-> CString
-> CString
-> CUInt
-> Ptr (Ptr GError)
-> IO (Ptr TeamLinkWatcher)
nm_team_link_watcher_new_arp_ping2 Int32
initWait Int32
interval Int32
missedMax Int32
vlanid CString
targetHost' CString
sourceHost' CUInt
flags'
        Text -> Ptr TeamLinkWatcher -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherNewArpPing2" Ptr TeamLinkWatcher
result
        TeamLinkWatcher
result' <- ((ManagedPtr TeamLinkWatcher -> TeamLinkWatcher)
-> Ptr TeamLinkWatcher -> IO TeamLinkWatcher
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TeamLinkWatcher -> TeamLinkWatcher
TeamLinkWatcher) Ptr TeamLinkWatcher
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetHost'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceHost'
        TeamLinkWatcher -> IO TeamLinkWatcher
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TeamLinkWatcher
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetHost'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceHost'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TeamLinkWatcher::new_ethtool
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "delay_up"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "delay_up value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "delay_down"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "delay_down value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_team_link_watcher_new_ethtool" nm_team_link_watcher_new_ethtool :: 
    Int32 ->                                -- delay_up : TBasicType TInt
    Int32 ->                                -- delay_down : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TeamLinkWatcher)

-- | Creates a new ethtool t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object
-- 
-- /Since: 1.12/
teamLinkWatcherNewEthtool ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@delayUp@/: delay_up value
    -> Int32
    -- ^ /@delayDown@/: delay_down value
    -> m TeamLinkWatcher
    -- ^ __Returns:__ the new t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object /(Can throw 'Data.GI.Base.GError.GError')/
teamLinkWatcherNewEthtool :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Int32 -> m TeamLinkWatcher
teamLinkWatcherNewEthtool Int32
delayUp Int32
delayDown = IO TeamLinkWatcher -> m TeamLinkWatcher
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TeamLinkWatcher -> m TeamLinkWatcher)
-> IO TeamLinkWatcher -> m TeamLinkWatcher
forall a b. (a -> b) -> a -> b
$ do
    IO TeamLinkWatcher -> IO () -> IO TeamLinkWatcher
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TeamLinkWatcher
result <- (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
 -> IO (Ptr TeamLinkWatcher))
-> (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher)
nm_team_link_watcher_new_ethtool Int32
delayUp Int32
delayDown
        Text -> Ptr TeamLinkWatcher -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherNewEthtool" Ptr TeamLinkWatcher
result
        TeamLinkWatcher
result' <- ((ManagedPtr TeamLinkWatcher -> TeamLinkWatcher)
-> Ptr TeamLinkWatcher -> IO TeamLinkWatcher
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TeamLinkWatcher -> TeamLinkWatcher
TeamLinkWatcher) Ptr TeamLinkWatcher
result
        TeamLinkWatcher -> IO TeamLinkWatcher
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TeamLinkWatcher
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TeamLinkWatcher::new_nsna_ping
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "init_wait"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "init_wait value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "interval value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "missed_max"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "missed_max value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the host name or the ipv6 address that will be used as\n  target address in the NS packet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_team_link_watcher_new_nsna_ping" nm_team_link_watcher_new_nsna_ping :: 
    Int32 ->                                -- init_wait : TBasicType TInt
    Int32 ->                                -- interval : TBasicType TInt
    Int32 ->                                -- missed_max : TBasicType TInt
    CString ->                              -- target_host : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TeamLinkWatcher)

-- | Creates a new nsna_ping t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object
-- 
-- /Since: 1.12/
teamLinkWatcherNewNsnaPing ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@initWait@/: init_wait value
    -> Int32
    -- ^ /@interval@/: interval value
    -> Int32
    -- ^ /@missedMax@/: missed_max value
    -> T.Text
    -- ^ /@targetHost@/: the host name or the ipv6 address that will be used as
    --   target address in the NS packet
    -> m TeamLinkWatcher
    -- ^ __Returns:__ the new t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
teamLinkWatcherNewNsnaPing :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Int32 -> Int32 -> Text -> m TeamLinkWatcher
teamLinkWatcherNewNsnaPing Int32
initWait Int32
interval Int32
missedMax Text
targetHost = IO TeamLinkWatcher -> m TeamLinkWatcher
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TeamLinkWatcher -> m TeamLinkWatcher)
-> IO TeamLinkWatcher -> m TeamLinkWatcher
forall a b. (a -> b) -> a -> b
$ do
    CString
targetHost' <- Text -> IO CString
textToCString Text
targetHost
    IO TeamLinkWatcher -> IO () -> IO TeamLinkWatcher
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TeamLinkWatcher
result <- (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
 -> IO (Ptr TeamLinkWatcher))
-> (Ptr (Ptr GError) -> IO (Ptr TeamLinkWatcher))
-> IO (Ptr TeamLinkWatcher)
forall a b. (a -> b) -> a -> b
$ Int32
-> Int32
-> Int32
-> CString
-> Ptr (Ptr GError)
-> IO (Ptr TeamLinkWatcher)
nm_team_link_watcher_new_nsna_ping Int32
initWait Int32
interval Int32
missedMax CString
targetHost'
        Text -> Ptr TeamLinkWatcher -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherNewNsnaPing" Ptr TeamLinkWatcher
result
        TeamLinkWatcher
result' <- ((ManagedPtr TeamLinkWatcher -> TeamLinkWatcher)
-> Ptr TeamLinkWatcher -> IO TeamLinkWatcher
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TeamLinkWatcher -> TeamLinkWatcher
TeamLinkWatcher) Ptr TeamLinkWatcher
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetHost'
        TeamLinkWatcher -> IO TeamLinkWatcher
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TeamLinkWatcher
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetHost'
     )

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "nm_team_link_watcher_dup" nm_team_link_watcher_dup :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO (Ptr TeamLinkWatcher)

-- | Creates a copy of /@watcher@/
-- 
-- /Since: 1.12/
teamLinkWatcherDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m TeamLinkWatcher
    -- ^ __Returns:__ a copy of /@watcher@/
teamLinkWatcherDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m TeamLinkWatcher
teamLinkWatcherDup TeamLinkWatcher
watcher = IO TeamLinkWatcher -> m TeamLinkWatcher
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TeamLinkWatcher -> m TeamLinkWatcher)
-> IO TeamLinkWatcher -> m TeamLinkWatcher
forall a b. (a -> b) -> a -> b
$ do
    Ptr TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Ptr TeamLinkWatcher
result <- Ptr TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
nm_team_link_watcher_dup Ptr TeamLinkWatcher
watcher'
    Text -> Ptr TeamLinkWatcher -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherDup" Ptr TeamLinkWatcher
result
    TeamLinkWatcher
result' <- ((ManagedPtr TeamLinkWatcher -> TeamLinkWatcher)
-> Ptr TeamLinkWatcher -> IO TeamLinkWatcher
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TeamLinkWatcher -> TeamLinkWatcher
TeamLinkWatcher) Ptr TeamLinkWatcher
result
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    TeamLinkWatcher -> IO TeamLinkWatcher
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TeamLinkWatcher
result'

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherDupMethodInfo
instance (signature ~ (m TeamLinkWatcher), MonadIO m) => O.OverloadedMethod TeamLinkWatcherDupMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherDup

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


#endif

-- method TeamLinkWatcher::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #NMTeamLinkWatcher to compare @watcher to."
--                 , 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_team_link_watcher_equal" nm_team_link_watcher_equal :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    Ptr TeamLinkWatcher ->                  -- other : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO CInt

-- | Determines if two t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' objects contain the same values
-- in all the properties.
-- 
-- /Since: 1.12/
teamLinkWatcherEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> TeamLinkWatcher
    -- ^ /@other@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher' to compare /@watcher@/ to.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the objects contain the same values, 'P.False' if they do not.
teamLinkWatcherEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> TeamLinkWatcher -> m Bool
teamLinkWatcherEqual TeamLinkWatcher
watcher TeamLinkWatcher
other = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Ptr TeamLinkWatcher
other' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
other
    CInt
result <- Ptr TeamLinkWatcher -> Ptr TeamLinkWatcher -> IO CInt
nm_team_link_watcher_equal Ptr TeamLinkWatcher
watcher' Ptr TeamLinkWatcher
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
other
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherEqualMethodInfo
instance (signature ~ (TeamLinkWatcher -> m Bool), MonadIO m) => O.OverloadedMethod TeamLinkWatcherEqualMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherEqual

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


#endif

-- method TeamLinkWatcher::get_delay_down
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , 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_team_link_watcher_get_delay_down" nm_team_link_watcher_get_delay_down :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO Int32

-- | Gets the delay_down interval (in milliseconds) that elapses between the link
-- going down and the runner being notified about it.
-- 
-- /Since: 1.12/
teamLinkWatcherGetDelayDown ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m Int32
teamLinkWatcherGetDelayDown :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Int32
teamLinkWatcherGetDelayDown TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Int32
result <- Ptr TeamLinkWatcher -> IO Int32
nm_team_link_watcher_get_delay_down Ptr TeamLinkWatcher
watcher'
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetDelayDownMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetDelayDownMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetDelayDown

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


#endif

-- method TeamLinkWatcher::get_delay_up
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , 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_team_link_watcher_get_delay_up" nm_team_link_watcher_get_delay_up :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO Int32

-- | Gets the delay_up interval (in milliseconds) that elapses between the link
-- coming up and the runner being notified about it.
-- 
-- /Since: 1.12/
teamLinkWatcherGetDelayUp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m Int32
teamLinkWatcherGetDelayUp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Int32
teamLinkWatcherGetDelayUp TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Int32
result <- Ptr TeamLinkWatcher -> IO Int32
nm_team_link_watcher_get_delay_up Ptr TeamLinkWatcher
watcher'
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetDelayUpMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetDelayUpMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetDelayUp

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


#endif

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

foreign import ccall "nm_team_link_watcher_get_flags" nm_team_link_watcher_get_flags :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO CUInt

-- | Gets the arp ping watcher flags.
-- 
-- /Since: 1.12/
teamLinkWatcherGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m [NM.Flags.TeamLinkWatcherArpPingFlags]
teamLinkWatcherGetFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m [TeamLinkWatcherArpPingFlags]
teamLinkWatcherGetFlags TeamLinkWatcher
watcher = IO [TeamLinkWatcherArpPingFlags] -> m [TeamLinkWatcherArpPingFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TeamLinkWatcherArpPingFlags]
 -> m [TeamLinkWatcherArpPingFlags])
-> IO [TeamLinkWatcherArpPingFlags]
-> m [TeamLinkWatcherArpPingFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    CUInt
result <- Ptr TeamLinkWatcher -> IO CUInt
nm_team_link_watcher_get_flags Ptr TeamLinkWatcher
watcher'
    let result' :: [TeamLinkWatcherArpPingFlags]
result' = CUInt -> [TeamLinkWatcherArpPingFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    [TeamLinkWatcherArpPingFlags] -> IO [TeamLinkWatcherArpPingFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [TeamLinkWatcherArpPingFlags]
result'

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetFlagsMethodInfo
instance (signature ~ (m [NM.Flags.TeamLinkWatcherArpPingFlags]), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetFlagsMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetFlags

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


#endif

-- method TeamLinkWatcher::get_init_wait
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , 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_team_link_watcher_get_init_wait" nm_team_link_watcher_get_init_wait :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO Int32

-- | Gets the init_wait interval (in milliseconds) that the team port should
-- wait before sending the first packet to the target host.
-- 
-- /Since: 1.12/
teamLinkWatcherGetInitWait ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m Int32
teamLinkWatcherGetInitWait :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Int32
teamLinkWatcherGetInitWait TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Int32
result <- Ptr TeamLinkWatcher -> IO Int32
nm_team_link_watcher_get_init_wait Ptr TeamLinkWatcher
watcher'
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetInitWaitMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetInitWaitMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetInitWait

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


#endif

-- method TeamLinkWatcher::get_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , 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_team_link_watcher_get_interval" nm_team_link_watcher_get_interval :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO Int32

-- | Gets the interval (in milliseconds) that the team port should wait between
-- sending two check packets to the target host.
-- 
-- /Since: 1.12/
teamLinkWatcherGetInterval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m Int32
teamLinkWatcherGetInterval :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Int32
teamLinkWatcherGetInterval TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Int32
result <- Ptr TeamLinkWatcher -> IO Int32
nm_team_link_watcher_get_interval Ptr TeamLinkWatcher
watcher'
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetIntervalMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetIntervalMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetInterval

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


#endif

-- method TeamLinkWatcher::get_missed_max
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , 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_team_link_watcher_get_missed_max" nm_team_link_watcher_get_missed_max :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO Int32

-- | Gets the number of missed replies after which the link is considered down.
-- 
-- /Since: 1.12/
teamLinkWatcherGetMissedMax ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m Int32
teamLinkWatcherGetMissedMax :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Int32
teamLinkWatcherGetMissedMax TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Int32
result <- Ptr TeamLinkWatcher -> IO Int32
nm_team_link_watcher_get_missed_max Ptr TeamLinkWatcher
watcher'
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetMissedMaxMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetMissedMaxMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetMissedMax

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


#endif

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

foreign import ccall "nm_team_link_watcher_get_name" nm_team_link_watcher_get_name :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO CString

-- | Gets the name of the link watcher to be used.
-- 
-- /Since: 1.12/
teamLinkWatcherGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m T.Text
teamLinkWatcherGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Text
teamLinkWatcherGetName TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    CString
result <- Ptr TeamLinkWatcher -> IO CString
nm_team_link_watcher_get_name Ptr TeamLinkWatcher
watcher'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetNameMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetName

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


#endif

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

foreign import ccall "nm_team_link_watcher_get_source_host" nm_team_link_watcher_get_source_host :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO CString

-- | Gets the ip address to be used as source for the link probing packets.
-- 
-- /Since: 1.12/
teamLinkWatcherGetSourceHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m T.Text
teamLinkWatcherGetSourceHost :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Text
teamLinkWatcherGetSourceHost TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    CString
result <- Ptr TeamLinkWatcher -> IO CString
nm_team_link_watcher_get_source_host Ptr TeamLinkWatcher
watcher'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherGetSourceHost" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetSourceHostMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetSourceHostMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetSourceHost

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


#endif

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

foreign import ccall "nm_team_link_watcher_get_target_host" nm_team_link_watcher_get_target_host :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO CString

-- | Gets the host name\/ip address to be used as destination for the link probing
-- packets.
-- 
-- /Since: 1.12/
teamLinkWatcherGetTargetHost ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m T.Text
teamLinkWatcherGetTargetHost :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Text
teamLinkWatcherGetTargetHost TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    CString
result <- Ptr TeamLinkWatcher -> IO CString
nm_team_link_watcher_get_target_host Ptr TeamLinkWatcher
watcher'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"teamLinkWatcherGetTargetHost" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetTargetHostMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetTargetHostMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetTargetHost

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


#endif

-- method TeamLinkWatcher::get_vlanid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "watcher"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TeamLinkWatcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTeamLinkWatcher"
--                 , 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_team_link_watcher_get_vlanid" nm_team_link_watcher_get_vlanid :: 
    Ptr TeamLinkWatcher ->                  -- watcher : TInterface (Name {namespace = "NM", name = "TeamLinkWatcher"})
    IO Int32

-- | Gets the VLAN tag ID to be used to outgoing link probes
-- 
-- /Since: 1.16/
teamLinkWatcherGetVlanid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TeamLinkWatcher
    -- ^ /@watcher@/: the t'GI.NM.Structs.TeamLinkWatcher.TeamLinkWatcher'
    -> m Int32
teamLinkWatcherGetVlanid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TeamLinkWatcher -> m Int32
teamLinkWatcherGetVlanid TeamLinkWatcher
watcher = 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 TeamLinkWatcher
watcher' <- TeamLinkWatcher -> IO (Ptr TeamLinkWatcher)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TeamLinkWatcher
watcher
    Int32
result <- Ptr TeamLinkWatcher -> IO Int32
nm_team_link_watcher_get_vlanid Ptr TeamLinkWatcher
watcher'
    TeamLinkWatcher -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TeamLinkWatcher
watcher
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherGetVlanidMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod TeamLinkWatcherGetVlanidMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherGetVlanid

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TeamLinkWatcherRefMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherRef

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data TeamLinkWatcherUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TeamLinkWatcherUnrefMethodInfo TeamLinkWatcher signature where
    overloadedMethod = teamLinkWatcherUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTeamLinkWatcherMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTeamLinkWatcherMethod "dup" o = TeamLinkWatcherDupMethodInfo
    ResolveTeamLinkWatcherMethod "equal" o = TeamLinkWatcherEqualMethodInfo
    ResolveTeamLinkWatcherMethod "ref" o = TeamLinkWatcherRefMethodInfo
    ResolveTeamLinkWatcherMethod "unref" o = TeamLinkWatcherUnrefMethodInfo
    ResolveTeamLinkWatcherMethod "getDelayDown" o = TeamLinkWatcherGetDelayDownMethodInfo
    ResolveTeamLinkWatcherMethod "getDelayUp" o = TeamLinkWatcherGetDelayUpMethodInfo
    ResolveTeamLinkWatcherMethod "getFlags" o = TeamLinkWatcherGetFlagsMethodInfo
    ResolveTeamLinkWatcherMethod "getInitWait" o = TeamLinkWatcherGetInitWaitMethodInfo
    ResolveTeamLinkWatcherMethod "getInterval" o = TeamLinkWatcherGetIntervalMethodInfo
    ResolveTeamLinkWatcherMethod "getMissedMax" o = TeamLinkWatcherGetMissedMaxMethodInfo
    ResolveTeamLinkWatcherMethod "getName" o = TeamLinkWatcherGetNameMethodInfo
    ResolveTeamLinkWatcherMethod "getSourceHost" o = TeamLinkWatcherGetSourceHostMethodInfo
    ResolveTeamLinkWatcherMethod "getTargetHost" o = TeamLinkWatcherGetTargetHostMethodInfo
    ResolveTeamLinkWatcherMethod "getVlanid" o = TeamLinkWatcherGetVlanidMethodInfo
    ResolveTeamLinkWatcherMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif