{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gio.Objects.InetAddress
(
InetAddress(..) ,
IsInetAddress ,
toInetAddress ,
#if defined(ENABLE_OVERLOADING)
ResolveInetAddressMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressEqualMethodInfo ,
#endif
inetAddressEqual ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetFamilyMethodInfo ,
#endif
inetAddressGetFamily ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsAnyMethodInfo ,
#endif
inetAddressGetIsAny ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsLinkLocalMethodInfo ,
#endif
inetAddressGetIsLinkLocal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsLoopbackMethodInfo ,
#endif
inetAddressGetIsLoopback ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsMcGlobalMethodInfo ,
#endif
inetAddressGetIsMcGlobal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsMcLinkLocalMethodInfo ,
#endif
inetAddressGetIsMcLinkLocal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsMcNodeLocalMethodInfo ,
#endif
inetAddressGetIsMcNodeLocal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsMcOrgLocalMethodInfo ,
#endif
inetAddressGetIsMcOrgLocal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsMcSiteLocalMethodInfo ,
#endif
inetAddressGetIsMcSiteLocal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsMulticastMethodInfo ,
#endif
inetAddressGetIsMulticast ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetIsSiteLocalMethodInfo ,
#endif
inetAddressGetIsSiteLocal ,
#if defined(ENABLE_OVERLOADING)
InetAddressGetNativeSizeMethodInfo ,
#endif
inetAddressGetNativeSize ,
inetAddressNewAny ,
inetAddressNewFromBytes ,
inetAddressNewFromString ,
inetAddressNewLoopback ,
#if defined(ENABLE_OVERLOADING)
InetAddressToStringMethodInfo ,
#endif
inetAddressToString ,
#if defined(ENABLE_OVERLOADING)
InetAddressBytesPropertyInfo ,
#endif
constructInetAddressBytes ,
getInetAddressBytes ,
#if defined(ENABLE_OVERLOADING)
inetAddressBytes ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressFamilyPropertyInfo ,
#endif
constructInetAddressFamily ,
getInetAddressFamily ,
#if defined(ENABLE_OVERLOADING)
inetAddressFamily ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsAnyPropertyInfo ,
#endif
getInetAddressIsAny ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsAny ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsLinkLocalPropertyInfo ,
#endif
getInetAddressIsLinkLocal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsLinkLocal ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsLoopbackPropertyInfo ,
#endif
getInetAddressIsLoopback ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsLoopback ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsMcGlobalPropertyInfo ,
#endif
getInetAddressIsMcGlobal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsMcGlobal ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsMcLinkLocalPropertyInfo ,
#endif
getInetAddressIsMcLinkLocal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsMcLinkLocal ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsMcNodeLocalPropertyInfo ,
#endif
getInetAddressIsMcNodeLocal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsMcNodeLocal ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsMcOrgLocalPropertyInfo ,
#endif
getInetAddressIsMcOrgLocal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsMcOrgLocal ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsMcSiteLocalPropertyInfo ,
#endif
getInetAddressIsMcSiteLocal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsMcSiteLocal ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsMulticastPropertyInfo ,
#endif
getInetAddressIsMulticast ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsMulticast ,
#endif
#if defined(ENABLE_OVERLOADING)
InetAddressIsSiteLocalPropertyInfo ,
#endif
getInetAddressIsSiteLocal ,
#if defined(ENABLE_OVERLOADING)
inetAddressIsSiteLocal ,
#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.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
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
#endif
newtype InetAddress = InetAddress (SP.ManagedPtr InetAddress)
deriving (InetAddress -> InetAddress -> Bool
(InetAddress -> InetAddress -> Bool)
-> (InetAddress -> InetAddress -> Bool) -> Eq InetAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InetAddress -> InetAddress -> Bool
== :: InetAddress -> InetAddress -> Bool
$c/= :: InetAddress -> InetAddress -> Bool
/= :: InetAddress -> InetAddress -> Bool
Eq)
instance SP.ManagedPtrNewtype InetAddress where
toManagedPtr :: InetAddress -> ManagedPtr InetAddress
toManagedPtr (InetAddress ManagedPtr InetAddress
p) = ManagedPtr InetAddress
p
foreign import ccall "g_inet_address_get_type"
c_g_inet_address_get_type :: IO B.Types.GType
instance B.Types.TypedObject InetAddress where
glibType :: IO GType
glibType = IO GType
c_g_inet_address_get_type
instance B.Types.GObject InetAddress
class (SP.GObject o, O.IsDescendantOf InetAddress o) => IsInetAddress o
instance (SP.GObject o, O.IsDescendantOf InetAddress o) => IsInetAddress o
instance O.HasParentTypes InetAddress
type instance O.ParentTypes InetAddress = '[GObject.Object.Object]
toInetAddress :: (MIO.MonadIO m, IsInetAddress o) => o -> m InetAddress
toInetAddress :: forall (m :: * -> *) o.
(MonadIO m, IsInetAddress o) =>
o -> m InetAddress
toInetAddress = IO InetAddress -> m InetAddress
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InetAddress -> m InetAddress)
-> (o -> IO InetAddress) -> o -> m InetAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr InetAddress -> InetAddress) -> o -> IO InetAddress
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr InetAddress -> InetAddress
InetAddress
instance B.GValue.IsGValue (Maybe InetAddress) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_inet_address_get_type
gvalueSet_ :: Ptr GValue -> Maybe InetAddress -> IO ()
gvalueSet_ Ptr GValue
gv Maybe InetAddress
P.Nothing = Ptr GValue -> Ptr InetAddress -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr InetAddress
forall a. Ptr a
FP.nullPtr :: FP.Ptr InetAddress)
gvalueSet_ Ptr GValue
gv (P.Just InetAddress
obj) = InetAddress -> (Ptr InetAddress -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr InetAddress
obj (Ptr GValue -> Ptr InetAddress -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe InetAddress)
gvalueGet_ Ptr GValue
gv = do
ptr <- Ptr GValue -> IO (Ptr InetAddress)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr InetAddress)
if ptr /= FP.nullPtr
then P.Just <$> B.ManagedPtr.newObject InetAddress ptr
else return P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveInetAddressMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveInetAddressMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveInetAddressMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveInetAddressMethod "equal" o = InetAddressEqualMethodInfo
ResolveInetAddressMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveInetAddressMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveInetAddressMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveInetAddressMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveInetAddressMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveInetAddressMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveInetAddressMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveInetAddressMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveInetAddressMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveInetAddressMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveInetAddressMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveInetAddressMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveInetAddressMethod "toString" o = InetAddressToStringMethodInfo
ResolveInetAddressMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveInetAddressMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveInetAddressMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveInetAddressMethod "getFamily" o = InetAddressGetFamilyMethodInfo
ResolveInetAddressMethod "getIsAny" o = InetAddressGetIsAnyMethodInfo
ResolveInetAddressMethod "getIsLinkLocal" o = InetAddressGetIsLinkLocalMethodInfo
ResolveInetAddressMethod "getIsLoopback" o = InetAddressGetIsLoopbackMethodInfo
ResolveInetAddressMethod "getIsMcGlobal" o = InetAddressGetIsMcGlobalMethodInfo
ResolveInetAddressMethod "getIsMcLinkLocal" o = InetAddressGetIsMcLinkLocalMethodInfo
ResolveInetAddressMethod "getIsMcNodeLocal" o = InetAddressGetIsMcNodeLocalMethodInfo
ResolveInetAddressMethod "getIsMcOrgLocal" o = InetAddressGetIsMcOrgLocalMethodInfo
ResolveInetAddressMethod "getIsMcSiteLocal" o = InetAddressGetIsMcSiteLocalMethodInfo
ResolveInetAddressMethod "getIsMulticast" o = InetAddressGetIsMulticastMethodInfo
ResolveInetAddressMethod "getIsSiteLocal" o = InetAddressGetIsSiteLocalMethodInfo
ResolveInetAddressMethod "getNativeSize" o = InetAddressGetNativeSizeMethodInfo
ResolveInetAddressMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveInetAddressMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveInetAddressMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveInetAddressMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveInetAddressMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveInetAddressMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveInetAddressMethod t InetAddress, O.OverloadedMethod info InetAddress p) => OL.IsLabel t (InetAddress -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: InetAddress -> p
fromLabel = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveInetAddressMethod t InetAddress, O.OverloadedMethod info InetAddress p, R.HasField t InetAddress p) => R.HasField t InetAddress p where
getField :: InetAddress -> p
getField = forall {k} (i :: k) o s. OverloadedMethod i o s => o -> s
forall i o s. OverloadedMethod i o s => o -> s
O.overloadedMethod @info
#endif
instance (info ~ ResolveInetAddressMethod t InetAddress, O.OverloadedMethodInfo info InetAddress) => OL.IsLabel t (O.MethodProxy info InetAddress) where
#if MIN_VERSION_base(4,10,0)
fromLabel :: MethodProxy info InetAddress
fromLabel = MethodProxy info InetAddress
forall info obj. MethodProxy info obj
O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getInetAddressBytes :: (MonadIO m, IsInetAddress o) => o -> m (Ptr ())
getInetAddressBytes :: forall (m :: * -> *) o.
(MonadIO m, IsInetAddress o) =>
o -> m (Ptr ())
getInetAddressBytes o
obj = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"bytes"
constructInetAddressBytes :: (IsInetAddress o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructInetAddressBytes :: forall o (m :: * -> *).
(IsInetAddress o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructInetAddressBytes Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"bytes" Ptr ()
val
#if defined(ENABLE_OVERLOADING)
data InetAddressBytesPropertyInfo
instance AttrInfo InetAddressBytesPropertyInfo where
type AttrAllowedOps InetAddressBytesPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint InetAddressBytesPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressBytesPropertyInfo = (~) (Ptr ())
type AttrTransferTypeConstraint InetAddressBytesPropertyInfo = (~) (Ptr ())
type AttrTransferType InetAddressBytesPropertyInfo = Ptr ()
type AttrGetType InetAddressBytesPropertyInfo = (Ptr ())
type AttrLabel InetAddressBytesPropertyInfo = "bytes"
type AttrOrigin InetAddressBytesPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressBytesPropertyInfo o =>
o -> IO (AttrGetType InetAddressBytesPropertyInfo)
attrGet = o -> IO (Ptr ())
o -> IO (AttrGetType InetAddressBytesPropertyInfo)
forall (m :: * -> *) o.
(MonadIO m, IsInetAddress o) =>
o -> m (Ptr ())
getInetAddressBytes
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressBytesPropertyInfo o,
AttrSetTypeConstraint InetAddressBytesPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressBytesPropertyInfo o,
AttrTransferTypeConstraint InetAddressBytesPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType InetAddressBytesPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressBytesPropertyInfo o,
AttrSetTypeConstraint InetAddressBytesPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
Ptr () -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsInetAddress o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructInetAddressBytes
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressBytesPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.bytes"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:bytes"
})
#endif
getInetAddressFamily :: (MonadIO m, IsInetAddress o) => o -> m Gio.Enums.SocketFamily
getInetAddressFamily :: forall (m :: * -> *) o.
(MonadIO m, IsInetAddress o) =>
o -> m SocketFamily
getInetAddressFamily o
obj = IO SocketFamily -> m SocketFamily
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SocketFamily -> m SocketFamily)
-> IO SocketFamily -> m SocketFamily
forall a b. (a -> b) -> a -> b
$ o -> String -> IO SocketFamily
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"family"
constructInetAddressFamily :: (IsInetAddress o, MIO.MonadIO m) => Gio.Enums.SocketFamily -> m (GValueConstruct o)
constructInetAddressFamily :: forall o (m :: * -> *).
(IsInetAddress o, MonadIO m) =>
SocketFamily -> m (GValueConstruct o)
constructInetAddressFamily SocketFamily
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 -> SocketFamily -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"family" SocketFamily
val
#if defined(ENABLE_OVERLOADING)
data InetAddressFamilyPropertyInfo
instance AttrInfo InetAddressFamilyPropertyInfo where
type AttrAllowedOps InetAddressFamilyPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint InetAddressFamilyPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressFamilyPropertyInfo = (~) Gio.Enums.SocketFamily
type AttrTransferTypeConstraint InetAddressFamilyPropertyInfo = (~) Gio.Enums.SocketFamily
type AttrTransferType InetAddressFamilyPropertyInfo = Gio.Enums.SocketFamily
type AttrGetType InetAddressFamilyPropertyInfo = Gio.Enums.SocketFamily
type AttrLabel InetAddressFamilyPropertyInfo = "family"
type AttrOrigin InetAddressFamilyPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressFamilyPropertyInfo o =>
o -> IO (AttrGetType InetAddressFamilyPropertyInfo)
attrGet = o -> IO (AttrGetType InetAddressFamilyPropertyInfo)
o -> IO SocketFamily
forall (m :: * -> *) o.
(MonadIO m, IsInetAddress o) =>
o -> m SocketFamily
getInetAddressFamily
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressFamilyPropertyInfo o,
AttrSetTypeConstraint InetAddressFamilyPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressFamilyPropertyInfo o,
AttrTransferTypeConstraint InetAddressFamilyPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType InetAddressFamilyPropertyInfo)
attrTransfer Proxy o
_ b
v = do
b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressFamilyPropertyInfo o,
AttrSetTypeConstraint InetAddressFamilyPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
SocketFamily -> IO (GValueConstruct o)
forall o (m :: * -> *).
(IsInetAddress o, MonadIO m) =>
SocketFamily -> m (GValueConstruct o)
constructInetAddressFamily
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressFamilyPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.family"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:family"
})
#endif
getInetAddressIsAny :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsAny :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsAny o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-any"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsAnyPropertyInfo
instance AttrInfo InetAddressIsAnyPropertyInfo where
type AttrAllowedOps InetAddressIsAnyPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsAnyPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsAnyPropertyInfo = (~) ()
type AttrTransferType InetAddressIsAnyPropertyInfo = ()
type AttrGetType InetAddressIsAnyPropertyInfo = Bool
type AttrLabel InetAddressIsAnyPropertyInfo = "is-any"
type AttrOrigin InetAddressIsAnyPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsAnyPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsAnyPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsAny
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo o,
AttrSetTypeConstraint InetAddressIsAnyPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo o,
AttrTransferTypeConstraint InetAddressIsAnyPropertyInfo b) =>
Proxy o -> b -> IO (AttrTransferType InetAddressIsAnyPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsAnyPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo o,
AttrSetTypeConstraint InetAddressIsAnyPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isAny"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isAny"
})
#endif
getInetAddressIsLinkLocal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsLinkLocal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsLinkLocal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-link-local"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsLinkLocalPropertyInfo
instance AttrInfo InetAddressIsLinkLocalPropertyInfo where
type AttrAllowedOps InetAddressIsLinkLocalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsLinkLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsLinkLocalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsLinkLocalPropertyInfo = ()
type AttrGetType InetAddressIsLinkLocalPropertyInfo = Bool
type AttrLabel InetAddressIsLinkLocalPropertyInfo = "is-link-local"
type AttrOrigin InetAddressIsLinkLocalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsLinkLocalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsLinkLocalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsLinkLocal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsLinkLocalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo o,
AttrTransferTypeConstraint InetAddressIsLinkLocalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsLinkLocalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsLinkLocalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsLinkLocalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isLinkLocal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isLinkLocal"
})
#endif
getInetAddressIsLoopback :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsLoopback :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsLoopback o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-loopback"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsLoopbackPropertyInfo
instance AttrInfo InetAddressIsLoopbackPropertyInfo where
type AttrAllowedOps InetAddressIsLoopbackPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsLoopbackPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsLoopbackPropertyInfo = (~) ()
type AttrTransferType InetAddressIsLoopbackPropertyInfo = ()
type AttrGetType InetAddressIsLoopbackPropertyInfo = Bool
type AttrLabel InetAddressIsLoopbackPropertyInfo = "is-loopback"
type AttrOrigin InetAddressIsLoopbackPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsLoopbackPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsLoopbackPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsLoopback
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo o,
AttrSetTypeConstraint InetAddressIsLoopbackPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo o,
AttrTransferTypeConstraint InetAddressIsLoopbackPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsLoopbackPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsLoopbackPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo o,
AttrSetTypeConstraint InetAddressIsLoopbackPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isLoopback"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isLoopback"
})
#endif
getInetAddressIsMcGlobal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcGlobal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcGlobal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-mc-global"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsMcGlobalPropertyInfo
instance AttrInfo InetAddressIsMcGlobalPropertyInfo where
type AttrAllowedOps InetAddressIsMcGlobalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsMcGlobalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsMcGlobalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsMcGlobalPropertyInfo = ()
type AttrGetType InetAddressIsMcGlobalPropertyInfo = Bool
type AttrLabel InetAddressIsMcGlobalPropertyInfo = "is-mc-global"
type AttrOrigin InetAddressIsMcGlobalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsMcGlobalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsMcGlobalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcGlobal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcGlobalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo o,
AttrTransferTypeConstraint InetAddressIsMcGlobalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsMcGlobalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsMcGlobalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcGlobalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isMcGlobal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isMcGlobal"
})
#endif
getInetAddressIsMcLinkLocal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcLinkLocal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcLinkLocal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-mc-link-local"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsMcLinkLocalPropertyInfo
instance AttrInfo InetAddressIsMcLinkLocalPropertyInfo where
type AttrAllowedOps InetAddressIsMcLinkLocalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsMcLinkLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsMcLinkLocalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsMcLinkLocalPropertyInfo = ()
type AttrGetType InetAddressIsMcLinkLocalPropertyInfo = Bool
type AttrLabel InetAddressIsMcLinkLocalPropertyInfo = "is-mc-link-local"
type AttrOrigin InetAddressIsMcLinkLocalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsMcLinkLocalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsMcLinkLocalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcLinkLocal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcLinkLocalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo o,
AttrTransferTypeConstraint
InetAddressIsMcLinkLocalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsMcLinkLocalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsMcLinkLocalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcLinkLocalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isMcLinkLocal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isMcLinkLocal"
})
#endif
getInetAddressIsMcNodeLocal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcNodeLocal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcNodeLocal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-mc-node-local"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsMcNodeLocalPropertyInfo
instance AttrInfo InetAddressIsMcNodeLocalPropertyInfo where
type AttrAllowedOps InetAddressIsMcNodeLocalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsMcNodeLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsMcNodeLocalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsMcNodeLocalPropertyInfo = ()
type AttrGetType InetAddressIsMcNodeLocalPropertyInfo = Bool
type AttrLabel InetAddressIsMcNodeLocalPropertyInfo = "is-mc-node-local"
type AttrOrigin InetAddressIsMcNodeLocalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsMcNodeLocalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsMcNodeLocalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcNodeLocal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcNodeLocalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo o,
AttrTransferTypeConstraint
InetAddressIsMcNodeLocalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsMcNodeLocalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsMcNodeLocalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcNodeLocalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isMcNodeLocal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isMcNodeLocal"
})
#endif
getInetAddressIsMcOrgLocal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcOrgLocal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcOrgLocal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-mc-org-local"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsMcOrgLocalPropertyInfo
instance AttrInfo InetAddressIsMcOrgLocalPropertyInfo where
type AttrAllowedOps InetAddressIsMcOrgLocalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsMcOrgLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsMcOrgLocalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsMcOrgLocalPropertyInfo = ()
type AttrGetType InetAddressIsMcOrgLocalPropertyInfo = Bool
type AttrLabel InetAddressIsMcOrgLocalPropertyInfo = "is-mc-org-local"
type AttrOrigin InetAddressIsMcOrgLocalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsMcOrgLocalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsMcOrgLocalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcOrgLocal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcOrgLocalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo o,
AttrTransferTypeConstraint
InetAddressIsMcOrgLocalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsMcOrgLocalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsMcOrgLocalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcOrgLocalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isMcOrgLocal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isMcOrgLocal"
})
#endif
getInetAddressIsMcSiteLocal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcSiteLocal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcSiteLocal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-mc-site-local"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsMcSiteLocalPropertyInfo
instance AttrInfo InetAddressIsMcSiteLocalPropertyInfo where
type AttrAllowedOps InetAddressIsMcSiteLocalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsMcSiteLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsMcSiteLocalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsMcSiteLocalPropertyInfo = ()
type AttrGetType InetAddressIsMcSiteLocalPropertyInfo = Bool
type AttrLabel InetAddressIsMcSiteLocalPropertyInfo = "is-mc-site-local"
type AttrOrigin InetAddressIsMcSiteLocalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsMcSiteLocalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsMcSiteLocalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMcSiteLocal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcSiteLocalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo o,
AttrTransferTypeConstraint
InetAddressIsMcSiteLocalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsMcSiteLocalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsMcSiteLocalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMcSiteLocalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isMcSiteLocal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isMcSiteLocal"
})
#endif
getInetAddressIsMulticast :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMulticast :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMulticast o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-multicast"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsMulticastPropertyInfo
instance AttrInfo InetAddressIsMulticastPropertyInfo where
type AttrAllowedOps InetAddressIsMulticastPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsMulticastPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsMulticastPropertyInfo = (~) ()
type AttrTransferType InetAddressIsMulticastPropertyInfo = ()
type AttrGetType InetAddressIsMulticastPropertyInfo = Bool
type AttrLabel InetAddressIsMulticastPropertyInfo = "is-multicast"
type AttrOrigin InetAddressIsMulticastPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsMulticastPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsMulticastPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsMulticast
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMulticastPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo o,
AttrTransferTypeConstraint InetAddressIsMulticastPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsMulticastPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsMulticastPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo o,
AttrSetTypeConstraint InetAddressIsMulticastPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isMulticast"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isMulticast"
})
#endif
getInetAddressIsSiteLocal :: (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsSiteLocal :: forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsSiteLocal o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-site-local"
#if defined(ENABLE_OVERLOADING)
data InetAddressIsSiteLocalPropertyInfo
instance AttrInfo InetAddressIsSiteLocalPropertyInfo where
type AttrAllowedOps InetAddressIsSiteLocalPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo = IsInetAddress
type AttrSetTypeConstraint InetAddressIsSiteLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint InetAddressIsSiteLocalPropertyInfo = (~) ()
type AttrTransferType InetAddressIsSiteLocalPropertyInfo = ()
type AttrGetType InetAddressIsSiteLocalPropertyInfo = Bool
type AttrLabel InetAddressIsSiteLocalPropertyInfo = "is-site-local"
type AttrOrigin InetAddressIsSiteLocalPropertyInfo = InetAddress
attrGet :: forall o.
AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo o =>
o -> IO (AttrGetType InetAddressIsSiteLocalPropertyInfo)
attrGet = o -> IO Bool
o -> IO (AttrGetType InetAddressIsSiteLocalPropertyInfo)
forall (m :: * -> *) o. (MonadIO m, IsInetAddress o) => o -> m Bool
getInetAddressIsSiteLocal
attrSet :: forall o b.
(AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsSiteLocalPropertyInfo b) =>
o -> b -> IO ()
attrSet = o -> b -> IO ()
forall a. HasCallStack => a
undefined
attrTransfer :: forall o b.
(AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo o,
AttrTransferTypeConstraint InetAddressIsSiteLocalPropertyInfo b) =>
Proxy o
-> b -> IO (AttrTransferType InetAddressIsSiteLocalPropertyInfo)
attrTransfer Proxy o
_ = b -> IO (AttrTransferType InetAddressIsSiteLocalPropertyInfo)
() -> IO ()
forall a. HasCallStack => a
undefined
attrConstruct :: forall o b.
(AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo o,
AttrSetTypeConstraint InetAddressIsSiteLocalPropertyInfo b) =>
b -> IO (GValueConstruct o)
attrConstruct = b -> IO (GValueConstruct o)
forall a. HasCallStack => a
undefined
attrClear :: forall o.
AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo o =>
o -> IO ()
attrClear = o -> IO ()
forall a. HasCallStack => a
undefined
dbgAttrInfo :: Maybe ResolvedSymbolInfo
dbgAttrInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.isSiteLocal"
, resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#g:attr:isSiteLocal"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InetAddress
type instance O.AttributeList InetAddress = InetAddressAttributeList
type InetAddressAttributeList = ('[ '("bytes", InetAddressBytesPropertyInfo), '("family", InetAddressFamilyPropertyInfo), '("isAny", InetAddressIsAnyPropertyInfo), '("isLinkLocal", InetAddressIsLinkLocalPropertyInfo), '("isLoopback", InetAddressIsLoopbackPropertyInfo), '("isMcGlobal", InetAddressIsMcGlobalPropertyInfo), '("isMcLinkLocal", InetAddressIsMcLinkLocalPropertyInfo), '("isMcNodeLocal", InetAddressIsMcNodeLocalPropertyInfo), '("isMcOrgLocal", InetAddressIsMcOrgLocalPropertyInfo), '("isMcSiteLocal", InetAddressIsMcSiteLocalPropertyInfo), '("isMulticast", InetAddressIsMulticastPropertyInfo), '("isSiteLocal", InetAddressIsSiteLocalPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
inetAddressBytes :: AttrLabelProxy "bytes"
inetAddressBytes :: AttrLabelProxy "bytes"
inetAddressBytes = AttrLabelProxy "bytes"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressFamily :: AttrLabelProxy "family"
inetAddressFamily :: AttrLabelProxy "family"
inetAddressFamily = AttrLabelProxy "family"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsAny :: AttrLabelProxy "isAny"
inetAddressIsAny :: AttrLabelProxy "isAny"
inetAddressIsAny = AttrLabelProxy "isAny"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsLinkLocal :: AttrLabelProxy "isLinkLocal"
inetAddressIsLinkLocal :: AttrLabelProxy "isLinkLocal"
inetAddressIsLinkLocal = AttrLabelProxy "isLinkLocal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsLoopback :: AttrLabelProxy "isLoopback"
inetAddressIsLoopback :: AttrLabelProxy "isLoopback"
inetAddressIsLoopback = AttrLabelProxy "isLoopback"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsMcGlobal :: AttrLabelProxy "isMcGlobal"
inetAddressIsMcGlobal :: AttrLabelProxy "isMcGlobal"
inetAddressIsMcGlobal = AttrLabelProxy "isMcGlobal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsMcLinkLocal :: AttrLabelProxy "isMcLinkLocal"
inetAddressIsMcLinkLocal :: AttrLabelProxy "isMcLinkLocal"
inetAddressIsMcLinkLocal = AttrLabelProxy "isMcLinkLocal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsMcNodeLocal :: AttrLabelProxy "isMcNodeLocal"
inetAddressIsMcNodeLocal :: AttrLabelProxy "isMcNodeLocal"
inetAddressIsMcNodeLocal = AttrLabelProxy "isMcNodeLocal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsMcOrgLocal :: AttrLabelProxy "isMcOrgLocal"
inetAddressIsMcOrgLocal :: AttrLabelProxy "isMcOrgLocal"
inetAddressIsMcOrgLocal = AttrLabelProxy "isMcOrgLocal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsMcSiteLocal :: AttrLabelProxy "isMcSiteLocal"
inetAddressIsMcSiteLocal :: AttrLabelProxy "isMcSiteLocal"
inetAddressIsMcSiteLocal = AttrLabelProxy "isMcSiteLocal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsMulticast :: AttrLabelProxy "isMulticast"
inetAddressIsMulticast :: AttrLabelProxy "isMulticast"
inetAddressIsMulticast = AttrLabelProxy "isMulticast"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
inetAddressIsSiteLocal :: AttrLabelProxy "isSiteLocal"
inetAddressIsSiteLocal :: AttrLabelProxy "isSiteLocal"
inetAddressIsSiteLocal = AttrLabelProxy "isSiteLocal"
forall (a :: Symbol). AttrLabelProxy a
AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList InetAddress = InetAddressSignalList
type InetAddressSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "g_inet_address_new_any" g_inet_address_new_any ::
CUInt ->
IO (Ptr InetAddress)
inetAddressNewAny ::
(B.CallStack.HasCallStack, MonadIO m) =>
Gio.Enums.SocketFamily
-> m InetAddress
inetAddressNewAny :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SocketFamily -> m InetAddress
inetAddressNewAny SocketFamily
family = IO InetAddress -> m InetAddress
forall a. IO a -> m a
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
let family' :: CUInt
family' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketFamily -> Int) -> SocketFamily -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketFamily -> Int
forall a. Enum a => a -> Int
fromEnum) SocketFamily
family
result <- CUInt -> IO (Ptr InetAddress)
g_inet_address_new_any CUInt
family'
checkUnexpectedReturnNULL "inetAddressNewAny" result
result' <- (wrapObject InetAddress) result
return result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_inet_address_new_from_bytes" g_inet_address_new_from_bytes ::
Ptr Word8 ->
CUInt ->
IO (Ptr InetAddress)
inetAddressNewFromBytes ::
(B.CallStack.HasCallStack, MonadIO m) =>
Ptr Word8
-> Gio.Enums.SocketFamily
-> m InetAddress
inetAddressNewFromBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr Word8 -> SocketFamily -> m InetAddress
inetAddressNewFromBytes Ptr Word8
bytes SocketFamily
family = IO InetAddress -> m InetAddress
forall a. IO a -> m a
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
let family' :: CUInt
family' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketFamily -> Int) -> SocketFamily -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketFamily -> Int
forall a. Enum a => a -> Int
fromEnum) SocketFamily
family
result <- Ptr Word8 -> CUInt -> IO (Ptr InetAddress)
g_inet_address_new_from_bytes Ptr Word8
bytes CUInt
family'
checkUnexpectedReturnNULL "inetAddressNewFromBytes" result
result' <- (wrapObject InetAddress) result
return result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_inet_address_new_from_string" g_inet_address_new_from_string ::
CString ->
IO (Ptr InetAddress)
inetAddressNewFromString ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> m (Maybe InetAddress)
inetAddressNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe InetAddress)
inetAddressNewFromString Text
string = IO (Maybe InetAddress) -> m (Maybe InetAddress)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InetAddress) -> m (Maybe InetAddress))
-> IO (Maybe InetAddress) -> m (Maybe InetAddress)
forall a b. (a -> b) -> a -> b
$ do
string' <- Text -> IO CString
textToCString Text
string
result <- g_inet_address_new_from_string string'
maybeResult <- convertIfNonNull result $ \Ptr InetAddress
result' -> do
result'' <- ((ManagedPtr InetAddress -> InetAddress)
-> Ptr InetAddress -> IO InetAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InetAddress -> InetAddress
InetAddress) Ptr InetAddress
result'
return result''
freeMem string'
return maybeResult
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_inet_address_new_loopback" g_inet_address_new_loopback ::
CUInt ->
IO (Ptr InetAddress)
inetAddressNewLoopback ::
(B.CallStack.HasCallStack, MonadIO m) =>
Gio.Enums.SocketFamily
-> m InetAddress
inetAddressNewLoopback :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SocketFamily -> m InetAddress
inetAddressNewLoopback SocketFamily
family = IO InetAddress -> m InetAddress
forall a. IO a -> m a
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
let family' :: CUInt
family' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketFamily -> Int) -> SocketFamily -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketFamily -> Int
forall a. Enum a => a -> Int
fromEnum) SocketFamily
family
result <- CUInt -> IO (Ptr InetAddress)
g_inet_address_new_loopback CUInt
family'
checkUnexpectedReturnNULL "inetAddressNewLoopback" result
result' <- (wrapObject InetAddress) result
return result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_inet_address_equal" g_inet_address_equal ::
Ptr InetAddress ->
Ptr InetAddress ->
IO CInt
inetAddressEqual ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a, IsInetAddress b) =>
a
-> b
-> m Bool
inetAddressEqual :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInetAddress a, IsInetAddress b) =>
a -> b -> m Bool
inetAddressEqual a
address b
otherAddress = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
otherAddress' <- unsafeManagedPtrCastPtr otherAddress
result <- g_inet_address_equal address' otherAddress'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
touchManagedPtr otherAddress
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressEqualMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsInetAddress a, IsInetAddress b) => O.OverloadedMethod InetAddressEqualMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> b -> m Bool
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInetAddress a, IsInetAddress b) =>
a -> b -> m Bool
inetAddressEqual
instance O.OverloadedMethodInfo InetAddressEqualMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressEqual",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressEqual"
})
#endif
foreign import ccall "g_inet_address_get_family" g_inet_address_get_family ::
Ptr InetAddress ->
IO CUInt
inetAddressGetFamily ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Gio.Enums.SocketFamily
inetAddressGetFamily :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m SocketFamily
inetAddressGetFamily a
address = IO SocketFamily -> m SocketFamily
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketFamily -> m SocketFamily)
-> IO SocketFamily -> m SocketFamily
forall a b. (a -> b) -> a -> b
$ do
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_family address'
let result' = (Int -> SocketFamily
forall a. Enum a => Int -> a
toEnum (Int -> SocketFamily) -> (CUInt -> Int) -> CUInt -> SocketFamily
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetFamilyMethodInfo
instance (signature ~ (m Gio.Enums.SocketFamily), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetFamilyMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m SocketFamily
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m SocketFamily
inetAddressGetFamily
instance O.OverloadedMethodInfo InetAddressGetFamilyMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetFamily",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetFamily"
})
#endif
foreign import ccall "g_inet_address_get_is_any" g_inet_address_get_is_any ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsAny ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsAny :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsAny a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_any address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsAnyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsAnyMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsAny
instance O.OverloadedMethodInfo InetAddressGetIsAnyMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsAny",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsAny"
})
#endif
foreign import ccall "g_inet_address_get_is_link_local" g_inet_address_get_is_link_local ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsLinkLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsLinkLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsLinkLocal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_link_local address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsLinkLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsLinkLocalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsLinkLocal
instance O.OverloadedMethodInfo InetAddressGetIsLinkLocalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsLinkLocal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsLinkLocal"
})
#endif
foreign import ccall "g_inet_address_get_is_loopback" g_inet_address_get_is_loopback ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsLoopback ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsLoopback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsLoopback a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_loopback address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsLoopbackMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsLoopbackMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsLoopback
instance O.OverloadedMethodInfo InetAddressGetIsLoopbackMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsLoopback",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsLoopback"
})
#endif
foreign import ccall "g_inet_address_get_is_mc_global" g_inet_address_get_is_mc_global ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsMcGlobal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsMcGlobal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcGlobal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_mc_global address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsMcGlobalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsMcGlobalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcGlobal
instance O.OverloadedMethodInfo InetAddressGetIsMcGlobalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsMcGlobal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsMcGlobal"
})
#endif
foreign import ccall "g_inet_address_get_is_mc_link_local" g_inet_address_get_is_mc_link_local ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsMcLinkLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsMcLinkLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcLinkLocal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_mc_link_local address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsMcLinkLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsMcLinkLocalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcLinkLocal
instance O.OverloadedMethodInfo InetAddressGetIsMcLinkLocalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsMcLinkLocal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsMcLinkLocal"
})
#endif
foreign import ccall "g_inet_address_get_is_mc_node_local" g_inet_address_get_is_mc_node_local ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsMcNodeLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsMcNodeLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcNodeLocal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_mc_node_local address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsMcNodeLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsMcNodeLocalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcNodeLocal
instance O.OverloadedMethodInfo InetAddressGetIsMcNodeLocalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsMcNodeLocal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsMcNodeLocal"
})
#endif
foreign import ccall "g_inet_address_get_is_mc_org_local" g_inet_address_get_is_mc_org_local ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsMcOrgLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsMcOrgLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcOrgLocal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_mc_org_local address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsMcOrgLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsMcOrgLocalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcOrgLocal
instance O.OverloadedMethodInfo InetAddressGetIsMcOrgLocalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsMcOrgLocal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsMcOrgLocal"
})
#endif
foreign import ccall "g_inet_address_get_is_mc_site_local" g_inet_address_get_is_mc_site_local ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsMcSiteLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsMcSiteLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcSiteLocal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_mc_site_local address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsMcSiteLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsMcSiteLocalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMcSiteLocal
instance O.OverloadedMethodInfo InetAddressGetIsMcSiteLocalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsMcSiteLocal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsMcSiteLocal"
})
#endif
foreign import ccall "g_inet_address_get_is_multicast" g_inet_address_get_is_multicast ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsMulticast ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsMulticast :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMulticast a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_multicast address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsMulticastMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsMulticastMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsMulticast
instance O.OverloadedMethodInfo InetAddressGetIsMulticastMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsMulticast",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsMulticast"
})
#endif
foreign import ccall "g_inet_address_get_is_site_local" g_inet_address_get_is_site_local ::
Ptr InetAddress ->
IO CInt
inetAddressGetIsSiteLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m Bool
inetAddressGetIsSiteLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsSiteLocal a
address = 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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_is_site_local address'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressGetIsSiteLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetIsSiteLocalMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Bool
inetAddressGetIsSiteLocal
instance O.OverloadedMethodInfo InetAddressGetIsSiteLocalMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetIsSiteLocal",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetIsSiteLocal"
})
#endif
foreign import ccall "g_inet_address_get_native_size" g_inet_address_get_native_size ::
Ptr InetAddress ->
IO FCT.CSize
inetAddressGetNativeSize ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m FCT.CSize
inetAddressGetNativeSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m CSize
inetAddressGetNativeSize a
address = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ do
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_get_native_size address'
touchManagedPtr address
return result
#if defined(ENABLE_OVERLOADING)
data InetAddressGetNativeSizeMethodInfo
instance (signature ~ (m FCT.CSize), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressGetNativeSizeMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m CSize
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m CSize
inetAddressGetNativeSize
instance O.OverloadedMethodInfo InetAddressGetNativeSizeMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressGetNativeSize",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressGetNativeSize"
})
#endif
foreign import ccall "g_inet_address_to_string" g_inet_address_to_string ::
Ptr InetAddress ->
IO CString
inetAddressToString ::
(B.CallStack.HasCallStack, MonadIO m, IsInetAddress a) =>
a
-> m T.Text
inetAddressToString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Text
inetAddressToString a
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
address' <- a -> IO (Ptr InetAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
address
result <- g_inet_address_to_string address'
checkUnexpectedReturnNULL "inetAddressToString" result
result' <- cstringToText result
freeMem result
touchManagedPtr address
return result'
#if defined(ENABLE_OVERLOADING)
data InetAddressToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsInetAddress a) => O.OverloadedMethod InetAddressToStringMethodInfo a signature where
overloadedMethod :: a -> signature
overloadedMethod = a -> signature
a -> m Text
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInetAddress a) =>
a -> m Text
inetAddressToString
instance O.OverloadedMethodInfo InetAddressToStringMethodInfo a where
overloadedMethodInfo :: Maybe ResolvedSymbolInfo
overloadedMethodInfo = ResolvedSymbolInfo -> Maybe ResolvedSymbolInfo
forall a. a -> Maybe a
P.Just (O.ResolvedSymbolInfo {
resolvedSymbolName :: Text
O.resolvedSymbolName = Text
"GI.Gio.Objects.InetAddress.inetAddressToString",
resolvedSymbolURL :: Text
O.resolvedSymbolURL = Text
"https://hackage.haskell.org/package/gi-gio-2.0.38/docs/GI-Gio-Objects-InetAddress.html#v:inetAddressToString"
})
#endif