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

-- * Exported types
    IPAddress(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [cmpFull]("GI.NM.Structs.IPAddress#g:method:cmpFull"), [dup]("GI.NM.Structs.IPAddress#g:method:dup"), [equal]("GI.NM.Structs.IPAddress#g:method:equal"), [ref]("GI.NM.Structs.IPAddress#g:method:ref"), [unref]("GI.NM.Structs.IPAddress#g:method:unref").
-- 
-- ==== Getters
-- [getAddress]("GI.NM.Structs.IPAddress#g:method:getAddress"), [getAttribute]("GI.NM.Structs.IPAddress#g:method:getAttribute"), [getAttributeNames]("GI.NM.Structs.IPAddress#g:method:getAttributeNames"), [getFamily]("GI.NM.Structs.IPAddress#g:method:getFamily"), [getPrefix]("GI.NM.Structs.IPAddress#g:method:getPrefix").
-- 
-- ==== Setters
-- [setAddress]("GI.NM.Structs.IPAddress#g:method:setAddress"), [setAttribute]("GI.NM.Structs.IPAddress#g:method:setAttribute"), [setPrefix]("GI.NM.Structs.IPAddress#g:method:setPrefix").

#if defined(ENABLE_OVERLOADING)
    ResolveIPAddressMethod                  ,
#endif

-- ** cmpFull #method:cmpFull#

#if defined(ENABLE_OVERLOADING)
    IPAddressCmpFullMethodInfo              ,
#endif
    iPAddressCmpFull                        ,


-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    IPAddressDupMethodInfo                  ,
#endif
    iPAddressDup                            ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    IPAddressEqualMethodInfo                ,
#endif
    iPAddressEqual                          ,


-- ** getAddress #method:getAddress#

#if defined(ENABLE_OVERLOADING)
    IPAddressGetAddressMethodInfo           ,
#endif
    iPAddressGetAddress                     ,


-- ** getAttribute #method:getAttribute#

#if defined(ENABLE_OVERLOADING)
    IPAddressGetAttributeMethodInfo         ,
#endif
    iPAddressGetAttribute                   ,


-- ** getAttributeNames #method:getAttributeNames#

#if defined(ENABLE_OVERLOADING)
    IPAddressGetAttributeNamesMethodInfo    ,
#endif
    iPAddressGetAttributeNames              ,


-- ** getFamily #method:getFamily#

#if defined(ENABLE_OVERLOADING)
    IPAddressGetFamilyMethodInfo            ,
#endif
    iPAddressGetFamily                      ,


-- ** getPrefix #method:getPrefix#

#if defined(ENABLE_OVERLOADING)
    IPAddressGetPrefixMethodInfo            ,
#endif
    iPAddressGetPrefix                      ,


-- ** new #method:new#

    iPAddressNew                            ,


-- ** newBinary #method:newBinary#

    iPAddressNewBinary                      ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    IPAddressRefMethodInfo                  ,
#endif
    iPAddressRef                            ,


-- ** setAddress #method:setAddress#

#if defined(ENABLE_OVERLOADING)
    IPAddressSetAddressMethodInfo           ,
#endif
    iPAddressSetAddress                     ,


-- ** setAttribute #method:setAttribute#

#if defined(ENABLE_OVERLOADING)
    IPAddressSetAttributeMethodInfo         ,
#endif
    iPAddressSetAttribute                   ,


-- ** setPrefix #method:setPrefix#

#if defined(ENABLE_OVERLOADING)
    IPAddressSetPrefixMethodInfo            ,
#endif
    iPAddressSetPrefix                      ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    IPAddressUnrefMethodInfo                ,
#endif
    iPAddressUnref                          ,




    ) 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 IPAddress = IPAddress (SP.ManagedPtr IPAddress)
    deriving (IPAddress -> IPAddress -> Bool
(IPAddress -> IPAddress -> Bool)
-> (IPAddress -> IPAddress -> Bool) -> Eq IPAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPAddress -> IPAddress -> Bool
== :: IPAddress -> IPAddress -> Bool
$c/= :: IPAddress -> IPAddress -> Bool
/= :: IPAddress -> IPAddress -> Bool
Eq)

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

foreign import ccall "nm_ip_address_get_type" c_nm_ip_address_get_type :: 
    IO GType

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

instance B.Types.TypedObject IPAddress where
    glibType :: IO GType
glibType = IO GType
c_nm_ip_address_get_type

instance B.Types.GBoxed IPAddress

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


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

-- method IPAddress::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 = "addr"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address" , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "IPAddress" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_ip_address_new" nm_ip_address_new :: 
    Int32 ->                                -- family : TBasicType TInt
    CString ->                              -- addr : TBasicType TUTF8
    Word32 ->                               -- prefix : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IPAddress)

-- | Creates a new t'GI.NM.Structs.IPAddress.IPAddress' object.
iPAddressNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@family@/: the IP address family (\<literal>AF_INET\<\/literal> or
    --   \<literal>AF_INET6\<\/literal>)
    -> T.Text
    -- ^ /@addr@/: the IP address
    -> Word32
    -- ^ /@prefix@/: the address prefix length
    -> m IPAddress
    -- ^ __Returns:__ the new t'GI.NM.Structs.IPAddress.IPAddress' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
iPAddressNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Text -> Word32 -> m IPAddress
iPAddressNew Int32
family Text
addr Word32
prefix = IO IPAddress -> m IPAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPAddress -> m IPAddress) -> IO IPAddress -> m IPAddress
forall a b. (a -> b) -> a -> b
$ do
    CString
addr' <- Text -> IO CString
textToCString Text
addr
    IO IPAddress -> IO () -> IO IPAddress
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr IPAddress
result <- (Ptr (Ptr GError) -> IO (Ptr IPAddress)) -> IO (Ptr IPAddress)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr IPAddress)) -> IO (Ptr IPAddress))
-> (Ptr (Ptr GError) -> IO (Ptr IPAddress)) -> IO (Ptr IPAddress)
forall a b. (a -> b) -> a -> b
$ Int32
-> CString -> Word32 -> Ptr (Ptr GError) -> IO (Ptr IPAddress)
nm_ip_address_new Int32
family CString
addr' Word32
prefix
        Text -> Ptr IPAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPAddressNew" Ptr IPAddress
result
        IPAddress
result' <- ((ManagedPtr IPAddress -> IPAddress)
-> Ptr IPAddress -> IO IPAddress
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPAddress -> IPAddress
IPAddress) Ptr IPAddress
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
addr'
        IPAddress -> IO IPAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPAddress
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
addr'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method IPAddress::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 = "addr"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address" , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "IPAddress" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_ip_address_new_binary" nm_ip_address_new_binary :: 
    Int32 ->                                -- family : TBasicType TInt
    Ptr () ->                               -- addr : TBasicType TPtr
    Word32 ->                               -- prefix : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr IPAddress)

-- | Creates a new t'GI.NM.Structs.IPAddress.IPAddress' object. /@addr@/ must point to a buffer of the
-- correct size for /@family@/.
iPAddressNewBinary ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@family@/: the IP address family (\<literal>AF_INET\<\/literal> or
    --   \<literal>AF_INET6\<\/literal>)
    -> Ptr ()
    -- ^ /@addr@/: the IP address
    -> Word32
    -- ^ /@prefix@/: the address prefix length
    -> m IPAddress
    -- ^ __Returns:__ the new t'GI.NM.Structs.IPAddress.IPAddress' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
iPAddressNewBinary :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> Ptr () -> Word32 -> m IPAddress
iPAddressNewBinary Int32
family Ptr ()
addr Word32
prefix = IO IPAddress -> m IPAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPAddress -> m IPAddress) -> IO IPAddress -> m IPAddress
forall a b. (a -> b) -> a -> b
$ do
    IO IPAddress -> IO () -> IO IPAddress
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr IPAddress
result <- (Ptr (Ptr GError) -> IO (Ptr IPAddress)) -> IO (Ptr IPAddress)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr IPAddress)) -> IO (Ptr IPAddress))
-> (Ptr (Ptr GError) -> IO (Ptr IPAddress)) -> IO (Ptr IPAddress)
forall a b. (a -> b) -> a -> b
$ Int32 -> Ptr () -> Word32 -> Ptr (Ptr GError) -> IO (Ptr IPAddress)
nm_ip_address_new_binary Int32
family Ptr ()
addr Word32
prefix
        Text -> Ptr IPAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPAddressNewBinary" Ptr IPAddress
result
        IPAddress
result' <- ((ManagedPtr IPAddress -> IPAddress)
-> Ptr IPAddress -> IO IPAddress
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPAddress -> IPAddress
IPAddress) Ptr IPAddress
result
        IPAddress -> IO IPAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPAddress
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method IPAddress::cmp_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress to compare @address to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cmp_flags"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddressCmpFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #NMIPAddressCmpFlags that indicate what to compare."
--                 , 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_address_cmp_full" nm_ip_address_cmp_full :: 
    Ptr IPAddress ->                        -- a : TInterface (Name {namespace = "NM", name = "IPAddress"})
    Ptr IPAddress ->                        -- b : TInterface (Name {namespace = "NM", name = "IPAddress"})
    CUInt ->                                -- cmp_flags : TInterface (Name {namespace = "NM", name = "IPAddressCmpFlags"})
    IO Int32

-- | Note that with /@cmpFlags@/ @/NM_IP_ADDRESS_CMP_FLAGS_WITH_ATTRS/@, there
-- is no total order for comparing GVariant. That means, if the two addresses
-- only differ by their attributes, the sort order is undefined and the return
-- value only indicates equality.
-- 
-- /Since: 1.22/
iPAddressCmpFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPAddress
    -- ^ /@a@/: the t'GI.NM.Structs.IPAddress.IPAddress'
    -> IPAddress
    -- ^ /@b@/: the t'GI.NM.Structs.IPAddress.IPAddress' to compare /@address@/ to.
    -> [NM.Flags.IPAddressCmpFlags]
    -- ^ /@cmpFlags@/: the t'GI.NM.Flags.IPAddressCmpFlags' that indicate what to compare.
    -> m Int32
    -- ^ __Returns:__ 0 if the two objects have the same values (according to their flags)
    --   or a integer indicating the compare order.
iPAddressCmpFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPAddress -> IPAddress -> [IPAddressCmpFlags] -> m Int32
iPAddressCmpFull IPAddress
a IPAddress
b [IPAddressCmpFlags]
cmpFlags = 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 IPAddress
a' <- IPAddress -> IO (Ptr IPAddress)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPAddress
a
    Ptr IPAddress
b' <- IPAddress -> IO (Ptr IPAddress)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPAddress
b
    let cmpFlags' :: CUInt
cmpFlags' = [IPAddressCmpFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [IPAddressCmpFlags]
cmpFlags
    Int32
result <- Ptr IPAddress -> Ptr IPAddress -> CUInt -> IO Int32
nm_ip_address_cmp_full Ptr IPAddress
a' Ptr IPAddress
b' CUInt
cmpFlags'
    IPAddress -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPAddress
a
    IPAddress -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPAddress
b
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data IPAddressCmpFullMethodInfo
instance (signature ~ (IPAddress -> [NM.Flags.IPAddressCmpFlags] -> m Int32), MonadIO m) => O.OverloadedMethod IPAddressCmpFullMethodInfo IPAddress signature where
    overloadedMethod = iPAddressCmpFull

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


#endif

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

foreign import ccall "nm_ip_address_dup" nm_ip_address_dup :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    IO (Ptr IPAddress)

-- | Creates a copy of /@address@/
-- 
-- /Since: 1.32/
iPAddressDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPAddress
    -- ^ /@address@/: the t'GI.NM.Structs.IPAddress.IPAddress'
    -> m IPAddress
    -- ^ __Returns:__ a copy of /@address@/
    -- 
    -- 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.
iPAddressDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPAddress -> m IPAddress
iPAddressDup IPAddress
address = IO IPAddress -> m IPAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPAddress -> m IPAddress) -> IO IPAddress -> m IPAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr IPAddress
address' <- IPAddress -> IO (Ptr IPAddress)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPAddress
address
    Ptr IPAddress
result <- Ptr IPAddress -> IO (Ptr IPAddress)
nm_ip_address_dup Ptr IPAddress
address'
    Text -> Ptr IPAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iPAddressDup" Ptr IPAddress
result
    IPAddress
result' <- ((ManagedPtr IPAddress -> IPAddress)
-> Ptr IPAddress -> IO IPAddress
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IPAddress -> IPAddress
IPAddress) Ptr IPAddress
result
    IPAddress -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPAddress
address
    IPAddress -> IO IPAddress
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPAddress
result'

#if defined(ENABLE_OVERLOADING)
data IPAddressDupMethodInfo
instance (signature ~ (m IPAddress), MonadIO m) => O.OverloadedMethod IPAddressDupMethodInfo IPAddress signature where
    overloadedMethod = iPAddressDup

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


#endif

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

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

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


#endif

-- method IPAddress::get_address
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , 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_address_get_address" nm_ip_address_get_address :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    IO CString

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

#if defined(ENABLE_OVERLOADING)
data IPAddressGetAddressMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod IPAddressGetAddressMethodInfo IPAddress signature where
    overloadedMethod = iPAddressGetAddress

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


#endif

-- method IPAddress::get_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , 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 address 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_address_get_attribute" nm_ip_address_get_attribute :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GVariant)

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

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


#endif

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

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

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

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data IPAddressGetFamilyMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod IPAddressGetFamilyMethodInfo IPAddress signature where
    overloadedMethod = iPAddressGetFamily

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


#endif

-- method IPAddress::get_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , 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_address_get_prefix" nm_ip_address_get_prefix :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    IO Word32

-- | Gets the IP address prefix (ie \"24\" or \"30\" etc) property of this address
-- object.
iPAddressGetPrefix ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPAddress
    -- ^ /@address@/: the t'GI.NM.Structs.IPAddress.IPAddress'
    -> m Word32
    -- ^ __Returns:__ the IP address prefix
iPAddressGetPrefix :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPAddress -> m Word32
iPAddressGetPrefix IPAddress
address = 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 IPAddress
address' <- IPAddress -> IO (Ptr IPAddress)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPAddress
address
    Word32
result <- Ptr IPAddress -> IO Word32
nm_ip_address_get_prefix Ptr IPAddress
address'
    IPAddress -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPAddress
address
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IPAddressGetPrefixMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod IPAddressGetPrefixMethodInfo IPAddress signature where
    overloadedMethod = iPAddressGetPrefix

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data IPAddressRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPAddressRefMethodInfo IPAddress signature where
    overloadedMethod = iPAddressRef

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


#endif

-- method IPAddress::set_address
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "addr"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the IP address, 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_address_set_address" nm_ip_address_set_address :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    CString ->                              -- addr : TBasicType TUTF8
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data IPAddressSetAddressMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod IPAddressSetAddressMethodInfo IPAddress signature where
    overloadedMethod = iPAddressSetAddress

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


#endif

-- method IPAddress::set_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , 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 address 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_address_set_attribute" nm_ip_address_set_attribute :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Sets or clears the named attribute on /@address@/ to the given value.
iPAddressSetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IPAddress
    -- ^ /@address@/: the t'GI.NM.Structs.IPAddress.IPAddress'
    -> T.Text
    -- ^ /@name@/: the name of an address attribute
    -> Maybe (GVariant)
    -- ^ /@value@/: the value
    -> m ()
iPAddressSetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
IPAddress -> Text -> Maybe GVariant -> m ()
iPAddressSetAttribute IPAddress
address 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 IPAddress
address' <- IPAddress -> IO (Ptr IPAddress)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IPAddress
address
    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 IPAddress -> CString -> Ptr GVariant -> IO ()
nm_ip_address_set_attribute Ptr IPAddress
address' CString
name' Ptr GVariant
maybeValue
    IPAddress -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IPAddress
address
    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 IPAddressSetAttributeMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> m ()), MonadIO m) => O.OverloadedMethod IPAddressSetAttributeMethodInfo IPAddress signature where
    overloadedMethod = iPAddressSetAttribute

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


#endif

-- method IPAddress::set_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "IPAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMIPAddress" , 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 IP address 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_address_set_prefix" nm_ip_address_set_prefix :: 
    Ptr IPAddress ->                        -- address : TInterface (Name {namespace = "NM", name = "IPAddress"})
    Word32 ->                               -- prefix : TBasicType TUInt
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data IPAddressSetPrefixMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod IPAddressSetPrefixMethodInfo IPAddress signature where
    overloadedMethod = iPAddressSetPrefix

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data IPAddressUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod IPAddressUnrefMethodInfo IPAddress signature where
    overloadedMethod = iPAddressUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveIPAddressMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveIPAddressMethod "cmpFull" o = IPAddressCmpFullMethodInfo
    ResolveIPAddressMethod "dup" o = IPAddressDupMethodInfo
    ResolveIPAddressMethod "equal" o = IPAddressEqualMethodInfo
    ResolveIPAddressMethod "ref" o = IPAddressRefMethodInfo
    ResolveIPAddressMethod "unref" o = IPAddressUnrefMethodInfo
    ResolveIPAddressMethod "getAddress" o = IPAddressGetAddressMethodInfo
    ResolveIPAddressMethod "getAttribute" o = IPAddressGetAttributeMethodInfo
    ResolveIPAddressMethod "getAttributeNames" o = IPAddressGetAttributeNamesMethodInfo
    ResolveIPAddressMethod "getFamily" o = IPAddressGetFamilyMethodInfo
    ResolveIPAddressMethod "getPrefix" o = IPAddressGetPrefixMethodInfo
    ResolveIPAddressMethod "setAddress" o = IPAddressSetAddressMethodInfo
    ResolveIPAddressMethod "setAttribute" o = IPAddressSetAttributeMethodInfo
    ResolveIPAddressMethod "setPrefix" o = IPAddressSetPrefixMethodInfo
    ResolveIPAddressMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif