{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IPv4 or IPv6 socket address; that is, the combination of a
-- t'GI.Gio.Objects.InetAddress.InetAddress' and a port number.

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

module GI.Gio.Objects.InetSocketAddress
    ( 

-- * Exported types
    InetSocketAddress(..)                   ,
    IsInetSocketAddress                     ,
    toInetSocketAddress                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [enumerate]("GI.Gio.Interfaces.SocketConnectable#g:method:enumerate"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [proxyEnumerate]("GI.Gio.Interfaces.SocketConnectable#g:method:proxyEnumerate"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toNative]("GI.Gio.Objects.SocketAddress#g:method:toNative"), [toString]("GI.Gio.Interfaces.SocketConnectable#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAddress]("GI.Gio.Objects.InetSocketAddress#g:method:getAddress"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFamily]("GI.Gio.Objects.SocketAddress#g:method:getFamily"), [getFlowinfo]("GI.Gio.Objects.InetSocketAddress#g:method:getFlowinfo"), [getNativeSize]("GI.Gio.Objects.SocketAddress#g:method:getNativeSize"), [getPort]("GI.Gio.Objects.InetSocketAddress#g:method:getPort"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScopeId]("GI.Gio.Objects.InetSocketAddress#g:method:getScopeId").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveInetSocketAddressMethod          ,
#endif

-- ** getAddress #method:getAddress#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetAddressMethodInfo   ,
#endif
    inetSocketAddressGetAddress             ,


-- ** getFlowinfo #method:getFlowinfo#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetFlowinfoMethodInfo  ,
#endif
    inetSocketAddressGetFlowinfo            ,


-- ** getPort #method:getPort#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetPortMethodInfo      ,
#endif
    inetSocketAddressGetPort                ,


-- ** getScopeId #method:getScopeId#

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressGetScopeIdMethodInfo   ,
#endif
    inetSocketAddressGetScopeId             ,


-- ** new #method:new#

    inetSocketAddressNew                    ,


-- ** newFromString #method:newFromString#

    inetSocketAddressNewFromString          ,




 -- * Properties


-- ** address #attr:address#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressAddressPropertyInfo    ,
#endif
    constructInetSocketAddressAddress       ,
    getInetSocketAddressAddress             ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressAddress                ,
#endif


-- ** flowinfo #attr:flowinfo#
-- | The @sin6_flowinfo@ field, for IPv6 addresses.
-- 
-- /Since: 2.32/

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressFlowinfoPropertyInfo   ,
#endif
    constructInetSocketAddressFlowinfo      ,
    getInetSocketAddressFlowinfo            ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressFlowinfo               ,
#endif


-- ** port #attr:port#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressPortPropertyInfo       ,
#endif
    constructInetSocketAddressPort          ,
    getInetSocketAddressPort                ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressPort                   ,
#endif


-- ** scopeId #attr:scopeId#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    InetSocketAddressScopeIdPropertyInfo    ,
#endif
    constructInetSocketAddressScopeId       ,
    getInetSocketAddressScopeId             ,
#if defined(ENABLE_OVERLOADING)
    inetSocketAddressScopeId                ,
#endif




    ) 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.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.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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
import {-# SOURCE #-} qualified GI.Gio.Objects.InetAddress as Gio.InetAddress
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress

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

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

foreign import ccall "g_inet_socket_address_get_type"
    c_g_inet_socket_address_get_type :: IO B.Types.GType

instance B.Types.TypedObject InetSocketAddress where
    glibType :: IO GType
glibType = IO GType
c_g_inet_socket_address_get_type

instance B.Types.GObject InetSocketAddress

-- | Type class for types which can be safely cast to `InetSocketAddress`, for instance with `toInetSocketAddress`.
class (SP.GObject o, O.IsDescendantOf InetSocketAddress o) => IsInetSocketAddress o
instance (SP.GObject o, O.IsDescendantOf InetSocketAddress o) => IsInetSocketAddress o

instance O.HasParentTypes InetSocketAddress
type instance O.ParentTypes InetSocketAddress = '[Gio.SocketAddress.SocketAddress, GObject.Object.Object, Gio.SocketConnectable.SocketConnectable]

-- | Cast to `InetSocketAddress`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toInetSocketAddress :: (MIO.MonadIO m, IsInetSocketAddress o) => o -> m InetSocketAddress
toInetSocketAddress :: forall (m :: * -> *) o.
(MonadIO m, IsInetSocketAddress o) =>
o -> m InetSocketAddress
toInetSocketAddress = IO InetSocketAddress -> m InetSocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InetSocketAddress -> m InetSocketAddress)
-> (o -> IO InetSocketAddress) -> o -> m InetSocketAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr InetSocketAddress -> InetSocketAddress)
-> o -> IO InetSocketAddress
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr InetSocketAddress -> InetSocketAddress
InetSocketAddress

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

#if defined(ENABLE_OVERLOADING)
type family ResolveInetSocketAddressMethod (t :: Symbol) (o :: *) :: * where
    ResolveInetSocketAddressMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveInetSocketAddressMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveInetSocketAddressMethod "enumerate" o = Gio.SocketConnectable.SocketConnectableEnumerateMethodInfo
    ResolveInetSocketAddressMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveInetSocketAddressMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveInetSocketAddressMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveInetSocketAddressMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveInetSocketAddressMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveInetSocketAddressMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveInetSocketAddressMethod "proxyEnumerate" o = Gio.SocketConnectable.SocketConnectableProxyEnumerateMethodInfo
    ResolveInetSocketAddressMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveInetSocketAddressMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveInetSocketAddressMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveInetSocketAddressMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveInetSocketAddressMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveInetSocketAddressMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveInetSocketAddressMethod "toNative" o = Gio.SocketAddress.SocketAddressToNativeMethodInfo
    ResolveInetSocketAddressMethod "toString" o = Gio.SocketConnectable.SocketConnectableToStringMethodInfo
    ResolveInetSocketAddressMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveInetSocketAddressMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveInetSocketAddressMethod "getAddress" o = InetSocketAddressGetAddressMethodInfo
    ResolveInetSocketAddressMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveInetSocketAddressMethod "getFamily" o = Gio.SocketAddress.SocketAddressGetFamilyMethodInfo
    ResolveInetSocketAddressMethod "getFlowinfo" o = InetSocketAddressGetFlowinfoMethodInfo
    ResolveInetSocketAddressMethod "getNativeSize" o = Gio.SocketAddress.SocketAddressGetNativeSizeMethodInfo
    ResolveInetSocketAddressMethod "getPort" o = InetSocketAddressGetPortMethodInfo
    ResolveInetSocketAddressMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveInetSocketAddressMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveInetSocketAddressMethod "getScopeId" o = InetSocketAddressGetScopeIdMethodInfo
    ResolveInetSocketAddressMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveInetSocketAddressMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveInetSocketAddressMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveInetSocketAddressMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "address"
   -- Type: TInterface (Name {namespace = "Gio", name = "InetAddress"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@address@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #address
-- @
getInetSocketAddressAddress :: (MonadIO m, IsInetSocketAddress o) => o -> m Gio.InetAddress.InetAddress
getInetSocketAddressAddress :: forall (m :: * -> *) o.
(MonadIO m, IsInetSocketAddress o) =>
o -> m InetAddress
getInetSocketAddressAddress o
obj = IO InetAddress -> m InetAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InetAddress -> m InetAddress)
-> IO InetAddress -> m InetAddress
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe InetAddress) -> IO InetAddress
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getInetSocketAddressAddress" (IO (Maybe InetAddress) -> IO InetAddress)
-> IO (Maybe InetAddress) -> IO InetAddress
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr InetAddress -> InetAddress)
-> IO (Maybe InetAddress)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"address" ManagedPtr InetAddress -> InetAddress
Gio.InetAddress.InetAddress

-- | Construct a `GValueConstruct` with valid value for the “@address@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressAddress :: (IsInetSocketAddress o, MIO.MonadIO m, Gio.InetAddress.IsInetAddress a) => a -> m (GValueConstruct o)
constructInetSocketAddressAddress :: forall o (m :: * -> *) a.
(IsInetSocketAddress o, MonadIO m, IsInetAddress a) =>
a -> m (GValueConstruct o)
constructInetSocketAddressAddress a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"address" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressAddressPropertyInfo
instance AttrInfo InetSocketAddressAddressPropertyInfo where
    type AttrAllowedOps InetSocketAddressAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint InetSocketAddressAddressPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressAddressPropertyInfo = Gio.InetAddress.IsInetAddress
    type AttrTransferTypeConstraint InetSocketAddressAddressPropertyInfo = Gio.InetAddress.IsInetAddress
    type AttrTransferType InetSocketAddressAddressPropertyInfo = Gio.InetAddress.InetAddress
    type AttrGetType InetSocketAddressAddressPropertyInfo = Gio.InetAddress.InetAddress
    type AttrLabel InetSocketAddressAddressPropertyInfo = "address"
    type AttrOrigin InetSocketAddressAddressPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressAddress
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.InetAddress.InetAddress v
    attrConstruct = constructInetSocketAddressAddress
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.address"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#g:attr:address"
        })
#endif

-- VVV Prop "flowinfo"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@flowinfo@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #flowinfo
-- @
getInetSocketAddressFlowinfo :: (MonadIO m, IsInetSocketAddress o) => o -> m Word32
getInetSocketAddressFlowinfo :: forall (m :: * -> *) o.
(MonadIO m, IsInetSocketAddress o) =>
o -> m Word32
getInetSocketAddressFlowinfo o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"flowinfo"

-- | Construct a `GValueConstruct` with valid value for the “@flowinfo@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressFlowinfo :: (IsInetSocketAddress o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructInetSocketAddressFlowinfo :: forall o (m :: * -> *).
(IsInetSocketAddress o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructInetSocketAddressFlowinfo Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"flowinfo" Word32
val

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressFlowinfoPropertyInfo
instance AttrInfo InetSocketAddressFlowinfoPropertyInfo where
    type AttrAllowedOps InetSocketAddressFlowinfoPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InetSocketAddressFlowinfoPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressFlowinfoPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint InetSocketAddressFlowinfoPropertyInfo = (~) Word32
    type AttrTransferType InetSocketAddressFlowinfoPropertyInfo = Word32
    type AttrGetType InetSocketAddressFlowinfoPropertyInfo = Word32
    type AttrLabel InetSocketAddressFlowinfoPropertyInfo = "flowinfo"
    type AttrOrigin InetSocketAddressFlowinfoPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressFlowinfo
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInetSocketAddressFlowinfo
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.flowinfo"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#g:attr:flowinfo"
        })
#endif

-- VVV Prop "port"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@port@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #port
-- @
getInetSocketAddressPort :: (MonadIO m, IsInetSocketAddress o) => o -> m Word32
getInetSocketAddressPort :: forall (m :: * -> *) o.
(MonadIO m, IsInetSocketAddress o) =>
o -> m Word32
getInetSocketAddressPort o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"port"

-- | Construct a `GValueConstruct` with valid value for the “@port@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressPort :: (IsInetSocketAddress o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructInetSocketAddressPort :: forall o (m :: * -> *).
(IsInetSocketAddress o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructInetSocketAddressPort Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"port" Word32
val

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressPortPropertyInfo
instance AttrInfo InetSocketAddressPortPropertyInfo where
    type AttrAllowedOps InetSocketAddressPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InetSocketAddressPortPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressPortPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint InetSocketAddressPortPropertyInfo = (~) Word32
    type AttrTransferType InetSocketAddressPortPropertyInfo = Word32
    type AttrGetType InetSocketAddressPortPropertyInfo = Word32
    type AttrLabel InetSocketAddressPortPropertyInfo = "port"
    type AttrOrigin InetSocketAddressPortPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressPort
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInetSocketAddressPort
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.port"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#g:attr:port"
        })
#endif

-- VVV Prop "scope-id"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@scope-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inetSocketAddress #scopeId
-- @
getInetSocketAddressScopeId :: (MonadIO m, IsInetSocketAddress o) => o -> m Word32
getInetSocketAddressScopeId :: forall (m :: * -> *) o.
(MonadIO m, IsInetSocketAddress o) =>
o -> m Word32
getInetSocketAddressScopeId o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"scope-id"

-- | Construct a `GValueConstruct` with valid value for the “@scope-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInetSocketAddressScopeId :: (IsInetSocketAddress o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructInetSocketAddressScopeId :: forall o (m :: * -> *).
(IsInetSocketAddress o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructInetSocketAddressScopeId Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"scope-id" Word32
val

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressScopeIdPropertyInfo
instance AttrInfo InetSocketAddressScopeIdPropertyInfo where
    type AttrAllowedOps InetSocketAddressScopeIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InetSocketAddressScopeIdPropertyInfo = IsInetSocketAddress
    type AttrSetTypeConstraint InetSocketAddressScopeIdPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint InetSocketAddressScopeIdPropertyInfo = (~) Word32
    type AttrTransferType InetSocketAddressScopeIdPropertyInfo = Word32
    type AttrGetType InetSocketAddressScopeIdPropertyInfo = Word32
    type AttrLabel InetSocketAddressScopeIdPropertyInfo = "scope-id"
    type AttrOrigin InetSocketAddressScopeIdPropertyInfo = InetSocketAddress
    attrGet = getInetSocketAddressScopeId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructInetSocketAddressScopeId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.scopeId"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#g:attr:scopeId"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InetSocketAddress
type instance O.AttributeList InetSocketAddress = InetSocketAddressAttributeList
type InetSocketAddressAttributeList = ('[ '("address", InetSocketAddressAddressPropertyInfo), '("family", Gio.SocketAddress.SocketAddressFamilyPropertyInfo), '("flowinfo", InetSocketAddressFlowinfoPropertyInfo), '("port", InetSocketAddressPortPropertyInfo), '("scopeId", InetSocketAddressScopeIdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
inetSocketAddressAddress :: AttrLabelProxy "address"
inetSocketAddressAddress = AttrLabelProxy

inetSocketAddressFlowinfo :: AttrLabelProxy "flowinfo"
inetSocketAddressFlowinfo = AttrLabelProxy

inetSocketAddressPort :: AttrLabelProxy "port"
inetSocketAddressPort = AttrLabelProxy

inetSocketAddressScopeId :: AttrLabelProxy "scopeId"
inetSocketAddressScopeId = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList InetSocketAddress = InetSocketAddressSignalList
type InetSocketAddressSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method InetSocketAddress::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInetAddress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a port number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "InetSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_new" g_inet_socket_address_new :: 
    Ptr Gio.InetAddress.InetAddress ->      -- address : TInterface (Name {namespace = "Gio", name = "InetAddress"})
    Word16 ->                               -- port : TBasicType TUInt16
    IO (Ptr InetSocketAddress)

-- | Creates a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress' for /@address@/ and /@port@/.
-- 
-- /Since: 2.22/
inetSocketAddressNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InetAddress.IsInetAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetAddress.InetAddress'
    -> Word16
    -- ^ /@port@/: a port number
    -> m InetSocketAddress
    -- ^ __Returns:__ a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
inetSocketAddressNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> Word16 -> m InetSocketAddress
inetSocketAddressNew a
address Word16
port = IO InetSocketAddress -> m InetSocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InetSocketAddress -> m InetSocketAddress)
-> IO InetSocketAddress -> m InetSocketAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr InetAddress
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Ptr InetSocketAddress
result <- Ptr InetAddress -> Word16 -> IO (Ptr InetSocketAddress)
g_inet_socket_address_new Ptr InetAddress
address' Word16
port
    Text -> Ptr InetSocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inetSocketAddressNew" Ptr InetSocketAddress
result
    InetSocketAddress
result' <- ((ManagedPtr InetSocketAddress -> InetSocketAddress)
-> Ptr InetSocketAddress -> IO InetSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InetSocketAddress -> InetSocketAddress
InetSocketAddress) Ptr InetSocketAddress
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    InetSocketAddress -> IO InetSocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return InetSocketAddress
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method InetSocketAddress::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "address"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string form of an IP address"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "port"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a port number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "InetSocketAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_new_from_string" g_inet_socket_address_new_from_string :: 
    CString ->                              -- address : TBasicType TUTF8
    Word32 ->                               -- port : TBasicType TUInt
    IO (Ptr InetSocketAddress)

-- | Creates a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress' for /@address@/ and /@port@/.
-- 
-- If /@address@/ is an IPv6 address, it can also contain a scope ID
-- (separated from the address by a @%@).
-- 
-- /Since: 2.40/
inetSocketAddressNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@address@/: the string form of an IP address
    -> Word32
    -- ^ /@port@/: a port number
    -> m (Maybe InetSocketAddress)
    -- ^ __Returns:__ a new t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress',
    -- or 'P.Nothing' if /@address@/ cannot be parsed.
inetSocketAddressNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Word32 -> m (Maybe InetSocketAddress)
inetSocketAddressNewFromString Text
address Word32
port = IO (Maybe InetSocketAddress) -> m (Maybe InetSocketAddress)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InetSocketAddress) -> m (Maybe InetSocketAddress))
-> IO (Maybe InetSocketAddress) -> m (Maybe InetSocketAddress)
forall a b. (a -> b) -> a -> b
$ do
    CString
address' <- Text -> IO CString
textToCString Text
address
    Ptr InetSocketAddress
result <- CString -> Word32 -> IO (Ptr InetSocketAddress)
g_inet_socket_address_new_from_string CString
address' Word32
port
    Maybe InetSocketAddress
maybeResult <- Ptr InetSocketAddress
-> (Ptr InetSocketAddress -> IO InetSocketAddress)
-> IO (Maybe InetSocketAddress)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr InetSocketAddress
result ((Ptr InetSocketAddress -> IO InetSocketAddress)
 -> IO (Maybe InetSocketAddress))
-> (Ptr InetSocketAddress -> IO InetSocketAddress)
-> IO (Maybe InetSocketAddress)
forall a b. (a -> b) -> a -> b
$ \Ptr InetSocketAddress
result' -> do
        InetSocketAddress
result'' <- ((ManagedPtr InetSocketAddress -> InetSocketAddress)
-> Ptr InetSocketAddress -> IO InetSocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InetSocketAddress -> InetSocketAddress
InetSocketAddress) Ptr InetSocketAddress
result'
        InetSocketAddress -> IO InetSocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return InetSocketAddress
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
address'
    Maybe InetSocketAddress -> IO (Maybe InetSocketAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InetSocketAddress
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method InetSocketAddress::get_address
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInetSocketAddress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InetAddress" })
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_get_address" g_inet_socket_address_get_address :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO (Ptr Gio.InetAddress.InetAddress)

-- | Gets /@address@/\'s t'GI.Gio.Objects.InetAddress.InetAddress'.
-- 
-- /Since: 2.22/
inetSocketAddressGetAddress ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Gio.InetAddress.InetAddress
    -- ^ __Returns:__ the t'GI.Gio.Objects.InetAddress.InetAddress' for /@address@/, which must be
    -- 'GI.GObject.Objects.Object.objectRef'\'d if it will be stored
inetSocketAddressGetAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetSocketAddress a) =>
a -> m InetAddress
inetSocketAddressGetAddress a
address = IO InetAddress -> m InetAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InetAddress -> m InetAddress)
-> IO InetAddress -> m InetAddress
forall a b. (a -> b) -> a -> b
$ do
    Ptr InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Ptr InetAddress
result <- Ptr InetSocketAddress -> IO (Ptr InetAddress)
g_inet_socket_address_get_address Ptr InetSocketAddress
address'
    Text -> Ptr InetAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"inetSocketAddressGetAddress" Ptr InetAddress
result
    InetAddress
result' <- ((ManagedPtr InetAddress -> InetAddress)
-> Ptr InetAddress -> IO InetAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr InetAddress -> InetAddress
Gio.InetAddress.InetAddress) Ptr InetAddress
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    InetAddress -> IO InetAddress
forall (m :: * -> *) a. Monad m => a -> m a
return InetAddress
result'

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetAddressMethodInfo
instance (signature ~ (m Gio.InetAddress.InetAddress), MonadIO m, IsInetSocketAddress a) => O.OverloadedMethod InetSocketAddressGetAddressMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetAddress

instance O.OverloadedMethodInfo InetSocketAddressGetAddressMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.inetSocketAddressGetAddress",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#v:inetSocketAddressGetAddress"
        })


#endif

-- method InetSocketAddress::get_flowinfo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a %G_SOCKET_FAMILY_IPV6 #GInetSocketAddress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_get_flowinfo" g_inet_socket_address_get_flowinfo :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO Word32

-- | Gets the @sin6_flowinfo@ field from /@address@/,
-- which must be an IPv6 address.
-- 
-- /Since: 2.32/
inetSocketAddressGetFlowinfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a 'GI.Gio.Enums.SocketFamilyIpv6' t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Word32
    -- ^ __Returns:__ the flowinfo field
inetSocketAddressGetFlowinfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetSocketAddress a) =>
a -> m Word32
inetSocketAddressGetFlowinfo a
address = IO Word32 -> m Word32
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 InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word32
result <- Ptr InetSocketAddress -> IO Word32
g_inet_socket_address_get_flowinfo Ptr InetSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetFlowinfoMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsInetSocketAddress a) => O.OverloadedMethod InetSocketAddressGetFlowinfoMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetFlowinfo

instance O.OverloadedMethodInfo InetSocketAddressGetFlowinfoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.inetSocketAddressGetFlowinfo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#v:inetSocketAddressGetFlowinfo"
        })


#endif

-- method InetSocketAddress::get_port
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInetSocketAddress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt16)
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_get_port" g_inet_socket_address_get_port :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO Word16

-- | Gets /@address@/\'s port.
-- 
-- /Since: 2.22/
inetSocketAddressGetPort ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a t'GI.Gio.Objects.InetSocketAddress.InetSocketAddress'
    -> m Word16
    -- ^ __Returns:__ the port for /@address@/
inetSocketAddressGetPort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetSocketAddress a) =>
a -> m Word16
inetSocketAddressGetPort a
address = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word16
result <- Ptr InetSocketAddress -> IO Word16
g_inet_socket_address_get_port Ptr InetSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetPortMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsInetSocketAddress a) => O.OverloadedMethod InetSocketAddressGetPortMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetPort

instance O.OverloadedMethodInfo InetSocketAddressGetPortMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.inetSocketAddressGetPort",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#v:inetSocketAddressGetPort"
        })


#endif

-- method InetSocketAddress::get_scope_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "address"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InetSocketAddress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a %G_SOCKET_FAMILY_IPV6 #GInetAddress"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "g_inet_socket_address_get_scope_id" g_inet_socket_address_get_scope_id :: 
    Ptr InetSocketAddress ->                -- address : TInterface (Name {namespace = "Gio", name = "InetSocketAddress"})
    IO Word32

-- | Gets the @sin6_scope_id@ field from /@address@/,
-- which must be an IPv6 address.
-- 
-- /Since: 2.32/
inetSocketAddressGetScopeId ::
    (B.CallStack.HasCallStack, MonadIO m, IsInetSocketAddress a) =>
    a
    -- ^ /@address@/: a 'GI.Gio.Enums.SocketFamilyIpv6' t'GI.Gio.Objects.InetAddress.InetAddress'
    -> m Word32
    -- ^ __Returns:__ the scope id field
inetSocketAddressGetScopeId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetSocketAddress a) =>
a -> m Word32
inetSocketAddressGetScopeId a
address = IO Word32 -> m Word32
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 InetSocketAddress
address' <- a -> IO (Ptr InetSocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
    Word32
result <- Ptr InetSocketAddress -> IO Word32
g_inet_socket_address_get_scope_id Ptr InetSocketAddress
address'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
address
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data InetSocketAddressGetScopeIdMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsInetSocketAddress a) => O.OverloadedMethod InetSocketAddressGetScopeIdMethodInfo a signature where
    overloadedMethod = inetSocketAddressGetScopeId

instance O.OverloadedMethodInfo InetSocketAddressGetScopeIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.InetSocketAddress.inetSocketAddressGetScopeId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-InetSocketAddress.html#v:inetSocketAddressGetScopeId"
        })


#endif