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

-- * Exported types
    IPRoute(..)                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [dup]("GI.NM.Structs.IPRoute#g:method:dup"), [equal]("GI.NM.Structs.IPRoute#g:method:equal"), [equalFull]("GI.NM.Structs.IPRoute#g:method:equalFull"), [ref]("GI.NM.Structs.IPRoute#g:method:ref"), [unref]("GI.NM.Structs.IPRoute#g:method:unref").
-- 
-- ==== Getters
-- [getAttribute]("GI.NM.Structs.IPRoute#g:method:getAttribute"), [getAttributeNames]("GI.NM.Structs.IPRoute#g:method:getAttributeNames"), [getDest]("GI.NM.Structs.IPRoute#g:method:getDest"), [getFamily]("GI.NM.Structs.IPRoute#g:method:getFamily"), [getMetric]("GI.NM.Structs.IPRoute#g:method:getMetric"), [getNextHop]("GI.NM.Structs.IPRoute#g:method:getNextHop"), [getPrefix]("GI.NM.Structs.IPRoute#g:method:getPrefix").
-- 
-- ==== Setters
-- [setAttribute]("GI.NM.Structs.IPRoute#g:method:setAttribute"), [setDest]("GI.NM.Structs.IPRoute#g:method:setDest"), [setMetric]("GI.NM.Structs.IPRoute#g:method:setMetric"), [setNextHop]("GI.NM.Structs.IPRoute#g:method:setNextHop"), [setPrefix]("GI.NM.Structs.IPRoute#g:method:setPrefix").

#if defined(ENABLE_OVERLOADING)
    ResolveIPRouteMethod                    ,
#endif

-- ** attributeValidate #method:attributeValidate#

    iPRouteAttributeValidate                ,


-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    IPRouteDupMethodInfo                    ,
#endif
    iPRouteDup                              ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    IPRouteEqualMethodInfo                  ,
#endif
    iPRouteEqual                            ,


-- ** equalFull #method:equalFull#

#if defined(ENABLE_OVERLOADING)
    IPRouteEqualFullMethodInfo              ,
#endif
    iPRouteEqualFull                        ,


-- ** getAttribute #method:getAttribute#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetAttributeMethodInfo           ,
#endif
    iPRouteGetAttribute                     ,


-- ** getAttributeNames #method:getAttributeNames#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetAttributeNamesMethodInfo      ,
#endif
    iPRouteGetAttributeNames                ,


-- ** getDest #method:getDest#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetDestMethodInfo                ,
#endif
    iPRouteGetDest                          ,


-- ** getFamily #method:getFamily#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetFamilyMethodInfo              ,
#endif
    iPRouteGetFamily                        ,


-- ** getMetric #method:getMetric#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetMetricMethodInfo              ,
#endif
    iPRouteGetMetric                        ,


-- ** getNextHop #method:getNextHop#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetNextHopMethodInfo             ,
#endif
    iPRouteGetNextHop                       ,


-- ** getPrefix #method:getPrefix#

#if defined(ENABLE_OVERLOADING)
    IPRouteGetPrefixMethodInfo              ,
#endif
    iPRouteGetPrefix                        ,


-- ** getVariantAttributeSpec #method:getVariantAttributeSpec#

    iPRouteGetVariantAttributeSpec          ,


-- ** new #method:new#

    iPRouteNew                              ,


-- ** newBinary #method:newBinary#

    iPRouteNewBinary                        ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    IPRouteRefMethodInfo                    ,
#endif
    iPRouteRef                              ,


-- ** setAttribute #method:setAttribute#

#if defined(ENABLE_OVERLOADING)
    IPRouteSetAttributeMethodInfo           ,
#endif
    iPRouteSetAttribute                     ,


-- ** setDest #method:setDest#

#if defined(ENABLE_OVERLOADING)
    IPRouteSetDestMethodInfo                ,
#endif
    iPRouteSetDest                          ,


-- ** setMetric #method:setMetric#

#if defined(ENABLE_OVERLOADING)
    IPRouteSetMetricMethodInfo              ,
#endif
    iPRouteSetMetric                        ,


-- ** setNextHop #method:setNextHop#

#if defined(ENABLE_OVERLOADING)
    IPRouteSetNextHopMethodInfo             ,
#endif
    iPRouteSetNextHop                       ,


-- ** setPrefix #method:setPrefix#

#if defined(ENABLE_OVERLOADING)
    IPRouteSetPrefixMethodInfo              ,
#endif
    iPRouteSetPrefix                        ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    IPRouteUnrefMethodInfo                  ,
#endif
    iPRouteUnref                            ,




    ) 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.Structs.VariantAttributeSpec as NM.VariantAttributeSpec

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

#endif

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

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

foreign import ccall "nm_ip_route_get_type" c_nm_ip_route_get_type :: 
    IO GType

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

instance B.Types.TypedObject IPRoute where
    glibType :: IO GType
glibType = IO GType
c_nm_ip_route_get_type

instance B.Types.GBoxed IPRoute

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


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

-- method IPRoute::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "family"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the IP address family (<literal>AF_INET</literal> or\n  <literal>AF_INET6</literal>)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address of the route's destination"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the address prefix length"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "next_hop"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address of the next hop (or %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metric"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the route metric (or -1 for \"default\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "IPRoute" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_ip_route_new" nm_ip_route_new :: 
    Int32 ->                                -- family : TBasicType TInt
    CString ->                              -- dest : TBasicType TUTF8
    Word32 ->                               -- prefix : TBasicType TUInt
    CString ->                              -- next_hop : TBasicType TUTF8
    Int64 ->                                -- metric : TBasicType TInt64
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IPRoute)

-- | Creates a new t'GI.NM.Structs.IPRoute.IPRoute' object.
iPRouteNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@family@/: the IP address family (\<literal>AF_INET\<\/literal> or
    --   \<literal>AF_INET6\<\/literal>)
    -> T.Text
    -- ^ /@dest@/: the IP address of the route\'s destination
    -> Word32
    -- ^ /@prefix@/: the address prefix length
    -> Maybe (T.Text)
    -- ^ /@nextHop@/: the IP address of the next hop (or 'P.Nothing')
    -> Int64
    -- ^ /@metric@/: the route metric (or -1 for \"default\")
    -> m IPRoute
    -- ^ __Returns:__ the new t'GI.NM.Structs.IPRoute.IPRoute' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
iPRouteNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Text -> Word32 -> Maybe Text -> Int64 -> m IPRoute
iPRouteNew Int32
family Text
dest Word32
prefix Maybe Text
nextHop Int64
metric = IO IPRoute -> m IPRoute
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoute -> m IPRoute) -> IO IPRoute -> m IPRoute
forall a b. (a -> b) -> a -> b
$ do
    CString
dest' <- Text -> IO CString
textToCString Text
dest
    CString
maybeNextHop <- case Maybe Text
nextHop of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jNextHop -> do
            CString
jNextHop' <- Text -> IO CString
textToCString Text
jNextHop
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jNextHop'
    IO IPRoute -> IO () -> IO IPRoute
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr IPRoute
result <- (Ptr (Ptr GError) -> IO (Ptr IPRoute)) -> IO (Ptr IPRoute)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr IPRoute)) -> IO (Ptr IPRoute))
-> (Ptr (Ptr GError) -> IO (Ptr IPRoute)) -> IO (Ptr IPRoute)
forall a b. (a -> b) -> a -> b
$ Int32
-> CString
-> Word32
-> CString
-> Int64
-> Ptr (Ptr GError)
-> IO (Ptr IPRoute)
nm_ip_route_new Int32
family CString
dest' Word32
prefix CString
maybeNextHop Int64
metric
        Text -> Ptr IPRoute -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteNew" Ptr IPRoute
result
        IPRoute
result' <- ((ManagedPtr IPRoute -> IPRoute) -> Ptr IPRoute -> IO IPRoute
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoute -> IPRoute
IPRoute) Ptr IPRoute
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dest'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeNextHop
        IPRoute -> IO IPRoute
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoute
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dest'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeNextHop
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method IPRoute::new_binary
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "family"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the IP address family (<literal>AF_INET</literal> or\n  <literal>AF_INET6</literal>)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address of the route's destination"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the address prefix length"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "next_hop"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address of the next hop (or %NULL)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metric"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the route metric (or -1 for \"default\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "IPRoute" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_ip_route_new_binary" nm_ip_route_new_binary :: 
    Int32 ->                                -- family : TBasicType TInt
    Ptr () ->                               -- dest : TBasicType TPtr
    Word32 ->                               -- prefix : TBasicType TUInt
    Ptr () ->                               -- next_hop : TBasicType TPtr
    Int64 ->                                -- metric : TBasicType TInt64
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IPRoute)

-- | Creates a new t'GI.NM.Structs.IPRoute.IPRoute' object. /@dest@/ and /@nextHop@/ (if non-'P.Nothing') must
-- point to buffers of the correct size for /@family@/.
iPRouteNewBinary ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@family@/: the IP address family (\<literal>AF_INET\<\/literal> or
    --   \<literal>AF_INET6\<\/literal>)
    -> Ptr ()
    -- ^ /@dest@/: the IP address of the route\'s destination
    -> Word32
    -- ^ /@prefix@/: the address prefix length
    -> Ptr ()
    -- ^ /@nextHop@/: the IP address of the next hop (or 'P.Nothing')
    -> Int64
    -- ^ /@metric@/: the route metric (or -1 for \"default\")
    -> m IPRoute
    -- ^ __Returns:__ the new t'GI.NM.Structs.IPRoute.IPRoute' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
iPRouteNewBinary :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Ptr () -> Word32 -> Ptr () -> Int64 -> m IPRoute
iPRouteNewBinary Int32
family Ptr ()
dest Word32
prefix Ptr ()
nextHop Int64
metric = IO IPRoute -> m IPRoute
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoute -> m IPRoute) -> IO IPRoute -> m IPRoute
forall a b. (a -> b) -> a -> b
$ do
    IO IPRoute -> IO () -> IO IPRoute
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr IPRoute
result <- (Ptr (Ptr GError) -> IO (Ptr IPRoute)) -> IO (Ptr IPRoute)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr IPRoute)) -> IO (Ptr IPRoute))
-> (Ptr (Ptr GError) -> IO (Ptr IPRoute)) -> IO (Ptr IPRoute)
forall a b. (a -> b) -> a -> b
$ Int32
-> Ptr ()
-> Word32
-> Ptr ()
-> Int64
-> Ptr (Ptr GError)
-> IO (Ptr IPRoute)
nm_ip_route_new_binary Int32
family Ptr ()
dest Word32
prefix Ptr ()
nextHop Int64
metric
        Text -> Ptr IPRoute -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteNewBinary" Ptr IPRoute
result
        IPRoute
result' <- ((ManagedPtr IPRoute -> IPRoute) -> Ptr IPRoute -> IO IPRoute
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoute -> IPRoute
IPRoute) Ptr IPRoute
result
        IPRoute -> IO IPRoute
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoute
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "nm_ip_route_dup" nm_ip_route_dup :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO (Ptr IPRoute)

-- | Creates a copy of /@route@/
-- 
-- /Since: 1.32/
iPRouteDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m IPRoute
    -- ^ __Returns:__ a copy of /@route@/
    -- 
    -- This API was part of public headers before 1.32.0 but
    -- was erroneously not exported in the ABI. It is thus only
    -- usable since 1.32.0.
iPRouteDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m IPRoute
iPRouteDup IPRoute
route = IO IPRoute -> m IPRoute
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPRoute -> m IPRoute) -> IO IPRoute -> m IPRoute
forall a b. (a -> b) -> a -> b
$ do
    Ptr IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute
result <- Ptr IPRoute -> IO (Ptr IPRoute)
nm_ip_route_dup Ptr IPRoute
route'
    Text -> Ptr IPRoute -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteDup" Ptr IPRoute
result
    IPRoute
result' <- ((ManagedPtr IPRoute -> IPRoute) -> Ptr IPRoute -> IO IPRoute
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPRoute -> IPRoute
IPRoute) Ptr IPRoute
result
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    IPRoute -> IO IPRoute
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPRoute
result'

#if defined(ENABLE_OVERLOADING)
data IPRouteDupMethodInfo
instance (signature ~ (m IPRoute), MonadIO m) => O.OverloadedMethod IPRouteDupMethodInfo IPRoute signature where
    overloadedMethod = iPRouteDup

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


#endif

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

-- | Determines if two t'GI.NM.Structs.IPRoute.IPRoute' objects contain the same destination, prefix,
-- next hop, and metric. (Attributes are not compared.)
iPRouteEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> IPRoute
    -- ^ /@other@/: the t'GI.NM.Structs.IPRoute.IPRoute' to compare /@route@/ to.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the objects contain the same values, 'P.False' if they do not.
iPRouteEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> IPRoute -> m Bool
iPRouteEqual IPRoute
route IPRoute
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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute
other' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
other
    CInt
result <- Ptr IPRoute -> Ptr IPRoute -> IO CInt
nm_ip_route_equal Ptr IPRoute
route' Ptr IPRoute
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
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 IPRouteEqualMethodInfo
instance (signature ~ (IPRoute -> m Bool), MonadIO m) => O.OverloadedMethod IPRouteEqualMethodInfo IPRoute signature where
    overloadedMethod = iPRouteEqual

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


#endif

-- method IPRoute::equal_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute to compare @route to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cmp_flags"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "tune how to compare attributes. Currently, only\n  NM_IP_ROUTE_EQUAL_CMP_FLAGS_NONE (0) and NM_IP_ROUTE_EQUAL_CMP_FLAGS_WITH_ATTRS (1)\n  is supported."
--                 , 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_ip_route_equal_full" nm_ip_route_equal_full :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    Ptr IPRoute ->                          -- other : TInterface (Name {namespace = "NM", name = "IPRoute"})
    Word32 ->                               -- cmp_flags : TBasicType TUInt
    IO CInt

-- | Determines if two t'GI.NM.Structs.IPRoute.IPRoute' objects contain the same destination, prefix,
-- next hop, and metric.
-- 
-- /Since: 1.10/
iPRouteEqualFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> IPRoute
    -- ^ /@other@/: the t'GI.NM.Structs.IPRoute.IPRoute' to compare /@route@/ to.
    -> Word32
    -- ^ /@cmpFlags@/: tune how to compare attributes. Currently, only
    --   NM_IP_ROUTE_EQUAL_CMP_FLAGS_NONE (0) and NM_IP_ROUTE_EQUAL_CMP_FLAGS_WITH_ATTRS (1)
    --   is supported.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the objects contain the same values, 'P.False' if they do not.
iPRouteEqualFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> IPRoute -> Word32 -> m Bool
iPRouteEqualFull IPRoute
route IPRoute
other Word32
cmpFlags = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute
other' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
other
    CInt
result <- Ptr IPRoute -> Ptr IPRoute -> Word32 -> IO CInt
nm_ip_route_equal_full Ptr IPRoute
route' Ptr IPRoute
other' Word32
cmpFlags
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
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 IPRouteEqualFullMethodInfo
instance (signature ~ (IPRoute -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod IPRouteEqualFullMethodInfo IPRoute signature where
    overloadedMethod = iPRouteEqualFull

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


#endif

-- method IPRoute::get_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , 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 name of an route attribute"
--                 , 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_ip_route_get_attribute" nm_ip_route_get_attribute :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Gets the value of the attribute with name /@name@/ on /@route@/
iPRouteGetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> T.Text
    -- ^ /@name@/: the name of an route attribute
    -> m GVariant
    -- ^ __Returns:__ the value of the attribute with name /@name@/ on
    --   /@route@/, or 'P.Nothing' if /@route@/ has no such attribute.
iPRouteGetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> Text -> m GVariant
iPRouteGetAttribute IPRoute
route 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
result <- Ptr IPRoute -> CString -> IO (Ptr GVariant)
nm_ip_route_get_attribute Ptr IPRoute
route' CString
name'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteGetAttribute" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    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 IPRouteGetAttributeMethodInfo
instance (signature ~ (T.Text -> m GVariant), MonadIO m) => O.OverloadedMethod IPRouteGetAttributeMethodInfo IPRoute signature where
    overloadedMethod = iPRouteGetAttribute

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


#endif

-- method IPRoute::get_attribute_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , 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_ip_route_get_attribute_names" nm_ip_route_get_attribute_names :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO (Ptr CString)

-- | Gets an array of attribute names defined on /@route@/.
iPRouteGetAttributeNames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of attribute names
iPRouteGetAttributeNames :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m [Text]
iPRouteGetAttributeNames IPRoute
route = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr CString
result <- Ptr IPRoute -> IO (Ptr CString)
nm_ip_route_get_attribute_names Ptr IPRoute
route'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteGetAttributeNames" 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
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

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

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


#endif

-- method IPRoute::get_dest
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , 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_ip_route_get_dest" nm_ip_route_get_dest :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO CString

-- | Gets the IP destination address property of this route object.
iPRouteGetDest ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m T.Text
    -- ^ __Returns:__ the IP address of the route\'s destination
iPRouteGetDest :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m Text
iPRouteGetDest IPRoute
route = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    CString
result <- Ptr IPRoute -> IO CString
nm_ip_route_get_dest Ptr IPRoute
route'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteGetDest" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IPRouteGetDestMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPRouteGetDestMethodInfo IPRoute signature where
    overloadedMethod = iPRouteGetDest

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


#endif

-- method IPRoute::get_family
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , 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_ip_route_get_family" nm_ip_route_get_family :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO Int32

-- | Gets the IP address family (eg, AF_INET) property of this route
-- object.
iPRouteGetFamily ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m Int32
    -- ^ __Returns:__ the IP address family
iPRouteGetFamily :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m Int32
iPRouteGetFamily IPRoute
route = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Int32
result <- Ptr IPRoute -> IO Int32
nm_ip_route_get_family Ptr IPRoute
route'
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data IPRouteGetFamilyMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod IPRouteGetFamilyMethodInfo IPRoute signature where
    overloadedMethod = iPRouteGetFamily

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


#endif

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

foreign import ccall "nm_ip_route_get_metric" nm_ip_route_get_metric :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO Int64

-- | Gets the route metric property of this route object; lower values
-- indicate \"better\" or more preferred routes; -1 indicates \"default\"
-- (meaning NetworkManager will set it appropriately).
iPRouteGetMetric ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m Int64
    -- ^ __Returns:__ the route metric
iPRouteGetMetric :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m Int64
iPRouteGetMetric IPRoute
route = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Int64
result <- Ptr IPRoute -> IO Int64
nm_ip_route_get_metric Ptr IPRoute
route'
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data IPRouteGetMetricMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.OverloadedMethod IPRouteGetMetricMethodInfo IPRoute signature where
    overloadedMethod = iPRouteGetMetric

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


#endif

-- method IPRoute::get_next_hop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , 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_ip_route_get_next_hop" nm_ip_route_get_next_hop :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO CString

-- | Gets the IP address of the next hop of this route; this will be 'P.Nothing' if the
-- route has no next hop.
iPRouteGetNextHop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m T.Text
    -- ^ __Returns:__ the IP address of the next hop, or 'P.Nothing' if this is a device route.
iPRouteGetNextHop :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m Text
iPRouteGetNextHop IPRoute
route = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    CString
result <- Ptr IPRoute -> IO CString
nm_ip_route_get_next_hop Ptr IPRoute
route'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteGetNextHop" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IPRouteGetNextHopMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPRouteGetNextHopMethodInfo IPRoute signature where
    overloadedMethod = iPRouteGetNextHop

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


#endif

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

foreign import ccall "nm_ip_route_get_prefix" nm_ip_route_get_prefix :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    IO Word32

-- | Gets the IP prefix (ie \"24\" or \"30\" etc) of this route.
iPRouteGetPrefix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m Word32
    -- ^ __Returns:__ the IP prefix
iPRouteGetPrefix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> m Word32
iPRouteGetPrefix IPRoute
route = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Word32
result <- Ptr IPRoute -> IO Word32
nm_ip_route_get_prefix Ptr IPRoute
route'
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IPRouteGetPrefixMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod IPRouteGetPrefixMethodInfo IPRoute signature where
    overloadedMethod = iPRouteGetPrefix

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


#endif

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

-- | Increases the reference count of the object.
iPRouteRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m ()
iPRouteRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => IPRoute -> m ()
iPRouteRef IPRoute
route = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute -> IO ()
nm_ip_route_ref Ptr IPRoute
route'
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPRouteRefMethodInfo IPRoute signature where
    overloadedMethod = iPRouteRef

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


#endif

-- method IPRoute::set_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , 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 name of a route attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_ip_route_set_attribute" nm_ip_route_set_attribute :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Sets the named attribute on /@route@/ to the given value.
iPRouteSetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> T.Text
    -- ^ /@name@/: the name of a route attribute
    -> Maybe (GVariant)
    -- ^ /@value@/: the value
    -> m ()
iPRouteSetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> Text -> Maybe GVariant -> m ()
iPRouteSetAttribute IPRoute
route Text
name Maybe GVariant
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
maybeValue <- case Maybe GVariant
value of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jValue -> do
            Ptr GVariant
jValue' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jValue
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jValue'
    Ptr IPRoute -> CString -> Ptr GVariant -> IO ()
nm_ip_route_set_attribute Ptr IPRoute
route' CString
name' Ptr GVariant
maybeValue
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
value GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteSetAttributeMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> m ()), MonadIO m) => O.OverloadedMethod IPRouteSetAttributeMethodInfo IPRoute signature where
    overloadedMethod = iPRouteSetAttribute

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


#endif

-- method IPRoute::set_dest
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the route's destination, as a string"
--                 , 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_ip_route_set_dest" nm_ip_route_set_dest :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    CString ->                              -- dest : TBasicType TUTF8
    IO ()

-- | Sets the destination property of this route object.
-- 
-- /@dest@/ must be a valid address of /@route@/\'s family. If you aren\'t sure you
-- have a valid address, use @/nm_inet_is_valid()/@ to check it.
iPRouteSetDest ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> T.Text
    -- ^ /@dest@/: the route\'s destination, as a string
    -> m ()
iPRouteSetDest :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> Text -> m ()
iPRouteSetDest IPRoute
route Text
dest = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    CString
dest' <- Text -> IO CString
textToCString Text
dest
    Ptr IPRoute -> CString -> IO ()
nm_ip_route_set_dest Ptr IPRoute
route' CString
dest'
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dest'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteSetDestMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod IPRouteSetDestMethodInfo IPRoute signature where
    overloadedMethod = iPRouteSetDest

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


#endif

-- method IPRoute::set_metric
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metric"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the route metric (or -1 for \"default\")"
--                 , 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_ip_route_set_metric" nm_ip_route_set_metric :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    Int64 ->                                -- metric : TBasicType TInt64
    IO ()

-- | Sets the metric property of this route object.
iPRouteSetMetric ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> Int64
    -- ^ /@metric@/: the route metric (or -1 for \"default\")
    -> m ()
iPRouteSetMetric :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> Int64 -> m ()
iPRouteSetMetric IPRoute
route Int64
metric = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute -> Int64 -> IO ()
nm_ip_route_set_metric Ptr IPRoute
route' Int64
metric
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteSetMetricMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.OverloadedMethod IPRouteSetMetricMethodInfo IPRoute signature where
    overloadedMethod = iPRouteSetMetric

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


#endif

-- method IPRoute::set_next_hop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "next_hop"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the route's next hop, as a string"
--                 , 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_ip_route_set_next_hop" nm_ip_route_set_next_hop :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    CString ->                              -- next_hop : TBasicType TUTF8
    IO ()

-- | Sets the next-hop property of this route object.
-- 
-- /@nextHop@/ (if non-'P.Nothing') must be a valid address of /@route@/\'s family. If you
-- aren\'t sure you have a valid address, use 'GI.NM.Functions.utilsIpaddrValid' to check
-- it.
iPRouteSetNextHop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> Maybe (T.Text)
    -- ^ /@nextHop@/: the route\'s next hop, as a string
    -> m ()
iPRouteSetNextHop :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> Maybe Text -> m ()
iPRouteSetNextHop IPRoute
route Maybe Text
nextHop = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    CString
maybeNextHop <- case Maybe Text
nextHop of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jNextHop -> do
            CString
jNextHop' <- Text -> IO CString
textToCString Text
jNextHop
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jNextHop'
    Ptr IPRoute -> CString -> IO ()
nm_ip_route_set_next_hop Ptr IPRoute
route' CString
maybeNextHop
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeNextHop
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteSetNextHopMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.OverloadedMethod IPRouteSetNextHopMethodInfo IPRoute signature where
    overloadedMethod = iPRouteSetNextHop

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


#endif

-- method IPRoute::set_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "route"
--           , argType = TInterface Name { namespace = "NM" , name = "IPRoute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPRoute" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the route prefix" , 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_ip_route_set_prefix" nm_ip_route_set_prefix :: 
    Ptr IPRoute ->                          -- route : TInterface (Name {namespace = "NM", name = "IPRoute"})
    Word32 ->                               -- prefix : TBasicType TUInt
    IO ()

-- | Sets the prefix property of this route object.
iPRouteSetPrefix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> Word32
    -- ^ /@prefix@/: the route prefix
    -> m ()
iPRouteSetPrefix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPRoute -> Word32 -> m ()
iPRouteSetPrefix IPRoute
route Word32
prefix = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute -> Word32 -> IO ()
nm_ip_route_set_prefix Ptr IPRoute
route' Word32
prefix
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteSetPrefixMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod IPRouteSetPrefixMethodInfo IPRoute signature where
    overloadedMethod = iPRouteSetPrefix

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


#endif

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

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero, the object will be destroyed.
iPRouteUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPRoute
    -- ^ /@route@/: the t'GI.NM.Structs.IPRoute.IPRoute'
    -> m ()
iPRouteUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => IPRoute -> m ()
iPRouteUnref IPRoute
route = 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 IPRoute
route' <- IPRoute -> IO (Ptr IPRoute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPRoute
route
    Ptr IPRoute -> IO ()
nm_ip_route_unref Ptr IPRoute
route'
    IPRoute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPRoute
route
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IPRouteUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPRouteUnrefMethodInfo IPRoute signature where
    overloadedMethod = iPRouteUnref

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


#endif

-- method IPRoute::attribute_validate
-- method type : MemberFunction
-- Args: [ 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 = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "family"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IP address family of the route"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "known"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "on return, whether the attribute name is a known one"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_ip_route_attribute_validate" nm_ip_route_attribute_validate :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    Int32 ->                                -- family : TBasicType TInt
    Ptr CInt ->                             -- known : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Validates a route attribute, i.e. checks that the attribute is a known one
-- and the value is of the correct type and well-formed.
-- 
-- /Since: 1.8/
iPRouteAttributeValidate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the attribute name
    -> GVariant
    -- ^ /@value@/: the attribute value
    -> Int32
    -- ^ /@family@/: IP address family of the route
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
iPRouteAttributeValidate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> GVariant -> Int32 -> m Bool
iPRouteAttributeValidate Text
name GVariant
value Int32
family = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr CInt
known <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO Bool -> IO () -> IO Bool
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ CString
-> Ptr GVariant -> Int32 -> Ptr CInt -> Ptr (Ptr GError) -> IO CInt
nm_ip_route_attribute_validate CString
name' Ptr GVariant
value' Int32
family Ptr CInt
known
        CInt
known' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
known
        let known'' :: Bool
known'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
known'
        GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
known
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
known''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
known
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method IPRoute::get_variant_attribute_spec
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "NM" , name = "VariantAttributeSpec" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_ip_route_get_variant_attribute_spec" nm_ip_route_get_variant_attribute_spec :: 
    IO (Ptr NM.VariantAttributeSpec.VariantAttributeSpec)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.8/
iPRouteGetVariantAttributeSpec ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m NM.VariantAttributeSpec.VariantAttributeSpec
    -- ^ __Returns:__ the specifiers for route attributes
iPRouteGetVariantAttributeSpec :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m VariantAttributeSpec
iPRouteGetVariantAttributeSpec  = IO VariantAttributeSpec -> m VariantAttributeSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VariantAttributeSpec -> m VariantAttributeSpec)
-> IO VariantAttributeSpec -> m VariantAttributeSpec
forall a b. (a -> b) -> a -> b
$ do
    Ptr VariantAttributeSpec
result <- IO (Ptr VariantAttributeSpec)
nm_ip_route_get_variant_attribute_spec
    Text -> Ptr VariantAttributeSpec -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPRouteGetVariantAttributeSpec" Ptr VariantAttributeSpec
result
    VariantAttributeSpec
result' <- ((ManagedPtr VariantAttributeSpec -> VariantAttributeSpec)
-> Ptr VariantAttributeSpec -> IO VariantAttributeSpec
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VariantAttributeSpec -> VariantAttributeSpec
NM.VariantAttributeSpec.VariantAttributeSpec) Ptr VariantAttributeSpec
result
    VariantAttributeSpec -> IO VariantAttributeSpec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VariantAttributeSpec
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIPRouteMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveIPRouteMethod "dup" o = IPRouteDupMethodInfo
    ResolveIPRouteMethod "equal" o = IPRouteEqualMethodInfo
    ResolveIPRouteMethod "equalFull" o = IPRouteEqualFullMethodInfo
    ResolveIPRouteMethod "ref" o = IPRouteRefMethodInfo
    ResolveIPRouteMethod "unref" o = IPRouteUnrefMethodInfo
    ResolveIPRouteMethod "getAttribute" o = IPRouteGetAttributeMethodInfo
    ResolveIPRouteMethod "getAttributeNames" o = IPRouteGetAttributeNamesMethodInfo
    ResolveIPRouteMethod "getDest" o = IPRouteGetDestMethodInfo
    ResolveIPRouteMethod "getFamily" o = IPRouteGetFamilyMethodInfo
    ResolveIPRouteMethod "getMetric" o = IPRouteGetMetricMethodInfo
    ResolveIPRouteMethod "getNextHop" o = IPRouteGetNextHopMethodInfo
    ResolveIPRouteMethod "getPrefix" o = IPRouteGetPrefixMethodInfo
    ResolveIPRouteMethod "setAttribute" o = IPRouteSetAttributeMethodInfo
    ResolveIPRouteMethod "setDest" o = IPRouteSetDestMethodInfo
    ResolveIPRouteMethod "setMetric" o = IPRouteSetMetricMethodInfo
    ResolveIPRouteMethod "setNextHop" o = IPRouteSetNextHopMethodInfo
    ResolveIPRouteMethod "setPrefix" o = IPRouteSetPrefixMethodInfo
    ResolveIPRouteMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif