{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gio.Objects.SocketConnection
(
SocketConnection(..) ,
IsSocketConnection ,
toSocketConnection ,
#if defined(ENABLE_OVERLOADING)
ResolveSocketConnectionMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
SocketConnectionConnectMethodInfo ,
#endif
socketConnectionConnect ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionConnectAsyncMethodInfo ,
#endif
socketConnectionConnectAsync ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionConnectFinishMethodInfo ,
#endif
socketConnectionConnectFinish ,
socketConnectionFactoryLookupType ,
socketConnectionFactoryRegisterType ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionGetLocalAddressMethodInfo,
#endif
socketConnectionGetLocalAddress ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionGetRemoteAddressMethodInfo,
#endif
socketConnectionGetRemoteAddress ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionGetSocketMethodInfo ,
#endif
socketConnectionGetSocket ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionIsConnectedMethodInfo ,
#endif
socketConnectionIsConnected ,
#if defined(ENABLE_OVERLOADING)
SocketConnectionSocketPropertyInfo ,
#endif
constructSocketConnectionSocket ,
getSocketConnectionSocket ,
#if defined(ENABLE_OVERLOADING)
socketConnectionSocket ,
#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 qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.Socket as Gio.Socket
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress
newtype SocketConnection = SocketConnection (SP.ManagedPtr SocketConnection)
deriving (SocketConnection -> SocketConnection -> Bool
(SocketConnection -> SocketConnection -> Bool)
-> (SocketConnection -> SocketConnection -> Bool)
-> Eq SocketConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocketConnection -> SocketConnection -> Bool
$c/= :: SocketConnection -> SocketConnection -> Bool
== :: SocketConnection -> SocketConnection -> Bool
$c== :: SocketConnection -> SocketConnection -> Bool
Eq)
instance SP.ManagedPtrNewtype SocketConnection where
toManagedPtr :: SocketConnection -> ManagedPtr SocketConnection
toManagedPtr (SocketConnection ManagedPtr SocketConnection
p) = ManagedPtr SocketConnection
p
foreign import ccall "g_socket_connection_get_type"
c_g_socket_connection_get_type :: IO B.Types.GType
instance B.Types.TypedObject SocketConnection where
glibType :: IO GType
glibType = IO GType
c_g_socket_connection_get_type
instance B.Types.GObject SocketConnection
class (SP.GObject o, O.IsDescendantOf SocketConnection o) => IsSocketConnection o
instance (SP.GObject o, O.IsDescendantOf SocketConnection o) => IsSocketConnection o
instance O.HasParentTypes SocketConnection
type instance O.ParentTypes SocketConnection = '[Gio.IOStream.IOStream, GObject.Object.Object]
toSocketConnection :: (MIO.MonadIO m, IsSocketConnection o) => o -> m SocketConnection
toSocketConnection :: forall (m :: * -> *) o.
(MonadIO m, IsSocketConnection o) =>
o -> m SocketConnection
toSocketConnection = IO SocketConnection -> m SocketConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SocketConnection -> m SocketConnection)
-> (o -> IO SocketConnection) -> o -> m SocketConnection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SocketConnection -> SocketConnection)
-> o -> IO SocketConnection
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SocketConnection -> SocketConnection
SocketConnection
instance B.GValue.IsGValue (Maybe SocketConnection) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_socket_connection_get_type
gvalueSet_ :: Ptr GValue -> Maybe SocketConnection -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SocketConnection
P.Nothing = Ptr GValue -> Ptr SocketConnection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SocketConnection
forall a. Ptr a
FP.nullPtr :: FP.Ptr SocketConnection)
gvalueSet_ Ptr GValue
gv (P.Just SocketConnection
obj) = SocketConnection -> (Ptr SocketConnection -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SocketConnection
obj (Ptr GValue -> Ptr SocketConnection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe SocketConnection)
gvalueGet_ Ptr GValue
gv = do
Ptr SocketConnection
ptr <- Ptr GValue -> IO (Ptr SocketConnection)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SocketConnection)
if Ptr SocketConnection
ptr Ptr SocketConnection -> Ptr SocketConnection -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SocketConnection
forall a. Ptr a
FP.nullPtr
then SocketConnection -> Maybe SocketConnection
forall a. a -> Maybe a
P.Just (SocketConnection -> Maybe SocketConnection)
-> IO SocketConnection -> IO (Maybe SocketConnection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SocketConnection -> SocketConnection)
-> Ptr SocketConnection -> IO SocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SocketConnection -> SocketConnection
SocketConnection Ptr SocketConnection
ptr
else Maybe SocketConnection -> IO (Maybe SocketConnection)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SocketConnection
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveSocketConnectionMethod (t :: Symbol) (o :: *) :: * where
ResolveSocketConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveSocketConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveSocketConnectionMethod "clearPending" o = Gio.IOStream.IOStreamClearPendingMethodInfo
ResolveSocketConnectionMethod "close" o = Gio.IOStream.IOStreamCloseMethodInfo
ResolveSocketConnectionMethod "closeAsync" o = Gio.IOStream.IOStreamCloseAsyncMethodInfo
ResolveSocketConnectionMethod "closeFinish" o = Gio.IOStream.IOStreamCloseFinishMethodInfo
ResolveSocketConnectionMethod "connect" o = SocketConnectionConnectMethodInfo
ResolveSocketConnectionMethod "connectAsync" o = SocketConnectionConnectAsyncMethodInfo
ResolveSocketConnectionMethod "connectFinish" o = SocketConnectionConnectFinishMethodInfo
ResolveSocketConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveSocketConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveSocketConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveSocketConnectionMethod "hasPending" o = Gio.IOStream.IOStreamHasPendingMethodInfo
ResolveSocketConnectionMethod "isClosed" o = Gio.IOStream.IOStreamIsClosedMethodInfo
ResolveSocketConnectionMethod "isConnected" o = SocketConnectionIsConnectedMethodInfo
ResolveSocketConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveSocketConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveSocketConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveSocketConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveSocketConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveSocketConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveSocketConnectionMethod "spliceAsync" o = Gio.IOStream.IOStreamSpliceAsyncMethodInfo
ResolveSocketConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveSocketConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveSocketConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveSocketConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveSocketConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveSocketConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveSocketConnectionMethod "getInputStream" o = Gio.IOStream.IOStreamGetInputStreamMethodInfo
ResolveSocketConnectionMethod "getLocalAddress" o = SocketConnectionGetLocalAddressMethodInfo
ResolveSocketConnectionMethod "getOutputStream" o = Gio.IOStream.IOStreamGetOutputStreamMethodInfo
ResolveSocketConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveSocketConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveSocketConnectionMethod "getRemoteAddress" o = SocketConnectionGetRemoteAddressMethodInfo
ResolveSocketConnectionMethod "getSocket" o = SocketConnectionGetSocketMethodInfo
ResolveSocketConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveSocketConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveSocketConnectionMethod "setPending" o = Gio.IOStream.IOStreamSetPendingMethodInfo
ResolveSocketConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveSocketConnectionMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveSocketConnectionMethod t SocketConnection, O.OverloadedMethod info SocketConnection p) => OL.IsLabel t (SocketConnection -> 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 ~ ResolveSocketConnectionMethod t SocketConnection, O.OverloadedMethod info SocketConnection p, R.HasField t SocketConnection p) => R.HasField t SocketConnection p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveSocketConnectionMethod t SocketConnection, O.OverloadedMethodInfo info SocketConnection) => OL.IsLabel t (O.MethodProxy info SocketConnection) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getSocketConnectionSocket :: (MonadIO m, IsSocketConnection o) => o -> m Gio.Socket.Socket
getSocketConnectionSocket :: forall (m :: * -> *) o.
(MonadIO m, IsSocketConnection o) =>
o -> m Socket
getSocketConnectionSocket o
obj = IO Socket -> m Socket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Socket) -> IO Socket
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSocketConnectionSocket" (IO (Maybe Socket) -> IO Socket) -> IO (Maybe Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Socket -> Socket) -> IO (Maybe Socket)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"socket" ManagedPtr Socket -> Socket
Gio.Socket.Socket
constructSocketConnectionSocket :: (IsSocketConnection o, MIO.MonadIO m, Gio.Socket.IsSocket a) => a -> m (GValueConstruct o)
constructSocketConnectionSocket :: forall o (m :: * -> *) a.
(IsSocketConnection o, MonadIO m, IsSocket a) =>
a -> m (GValueConstruct o)
constructSocketConnectionSocket 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
"socket" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data SocketConnectionSocketPropertyInfo
instance AttrInfo SocketConnectionSocketPropertyInfo where
type AttrAllowedOps SocketConnectionSocketPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SocketConnectionSocketPropertyInfo = IsSocketConnection
type AttrSetTypeConstraint SocketConnectionSocketPropertyInfo = Gio.Socket.IsSocket
type AttrTransferTypeConstraint SocketConnectionSocketPropertyInfo = Gio.Socket.IsSocket
type AttrTransferType SocketConnectionSocketPropertyInfo = Gio.Socket.Socket
type AttrGetType SocketConnectionSocketPropertyInfo = Gio.Socket.Socket
type AttrLabel SocketConnectionSocketPropertyInfo = "socket"
type AttrOrigin SocketConnectionSocketPropertyInfo = SocketConnection
attrGet = getSocketConnectionSocket
attrSet = undefined
attrTransfer _ v = do
unsafeCastTo Gio.Socket.Socket v
attrConstruct = constructSocketConnectionSocket
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socket"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#g:attr:socket"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SocketConnection
type instance O.AttributeList SocketConnection = SocketConnectionAttributeList
type SocketConnectionAttributeList = ('[ '("closed", Gio.IOStream.IOStreamClosedPropertyInfo), '("inputStream", Gio.IOStream.IOStreamInputStreamPropertyInfo), '("outputStream", Gio.IOStream.IOStreamOutputStreamPropertyInfo), '("socket", SocketConnectionSocketPropertyInfo)] :: [(Symbol, *)])
#endif
#if defined(ENABLE_OVERLOADING)
socketConnectionSocket :: AttrLabelProxy "socket"
socketConnectionSocket = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SocketConnection = SocketConnectionSignalList
type SocketConnectionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "g_socket_connection_connect" g_socket_connection_connect ::
Ptr SocketConnection ->
Ptr Gio.SocketAddress.SocketAddress ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
socketConnectionConnect ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) =>
a
-> b
-> Maybe (c)
-> m ()
socketConnectionConnect :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSocketConnection a, IsSocketAddress b,
IsCancellable c) =>
a -> b -> Maybe c -> m ()
socketConnectionConnect a
connection b
address Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr SocketAddress
address' <- b -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
address
Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
Just c
jCancellable -> do
Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection
-> Ptr SocketAddress
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_socket_connection_connect Ptr SocketConnection
connection' Ptr SocketAddress
address' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
address
Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data SocketConnectionConnectMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SocketConnectionConnectMethodInfo a signature where
overloadedMethod = socketConnectionConnect
instance O.OverloadedMethodInfo SocketConnectionConnectMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionConnect",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionConnect"
})
#endif
foreign import ccall "g_socket_connection_connect_async" g_socket_connection_connect_async ::
Ptr SocketConnection ->
Ptr Gio.SocketAddress.SocketAddress ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
socketConnectionConnectAsync ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) =>
a
-> b
-> Maybe (c)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
socketConnectionConnectAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSocketConnection a, IsSocketAddress b,
IsCancellable c) =>
a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
socketConnectionConnectAsync a
connection b
address Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr SocketAddress
address' <- b -> IO (Ptr SocketAddress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
address
Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
Just c
jCancellable -> do
Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
Just AsyncReadyCallback
jCallback -> do
Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
Ptr SocketConnection
-> Ptr SocketAddress
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_socket_connection_connect_async Ptr SocketConnection
connection' Ptr SocketAddress
address' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
address
Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data SocketConnectionConnectAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSocketConnection a, Gio.SocketAddress.IsSocketAddress b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SocketConnectionConnectAsyncMethodInfo a signature where
overloadedMethod = socketConnectionConnectAsync
instance O.OverloadedMethodInfo SocketConnectionConnectAsyncMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionConnectAsync",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionConnectAsync"
})
#endif
foreign import ccall "g_socket_connection_connect_finish" g_socket_connection_connect_finish ::
Ptr SocketConnection ->
Ptr Gio.AsyncResult.AsyncResult ->
Ptr (Ptr GError) ->
IO CInt
socketConnectionConnectFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m ()
socketConnectionConnectFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSocketConnection a, IsAsyncResult b) =>
a -> b -> m ()
socketConnectionConnectFinish a
connection b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_socket_connection_connect_finish Ptr SocketConnection
connection' Ptr AsyncResult
result_'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data SocketConnectionConnectFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSocketConnection a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod SocketConnectionConnectFinishMethodInfo a signature where
overloadedMethod = socketConnectionConnectFinish
instance O.OverloadedMethodInfo SocketConnectionConnectFinishMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionConnectFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionConnectFinish"
})
#endif
foreign import ccall "g_socket_connection_get_local_address" g_socket_connection_get_local_address ::
Ptr SocketConnection ->
Ptr (Ptr GError) ->
IO (Ptr Gio.SocketAddress.SocketAddress)
socketConnectionGetLocalAddress ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
a
-> m Gio.SocketAddress.SocketAddress
socketConnectionGetLocalAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketConnection a) =>
a -> m SocketAddress
socketConnectionGetLocalAddress a
connection = IO SocketAddress -> m SocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketAddress -> m SocketAddress)
-> IO SocketAddress -> m SocketAddress
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
IO SocketAddress -> IO () -> IO SocketAddress
forall a b. IO a -> IO b -> IO a
onException (do
Ptr SocketAddress
result <- (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress))
-> (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection -> Ptr (Ptr GError) -> IO (Ptr SocketAddress)
g_socket_connection_get_local_address Ptr SocketConnection
connection'
Text -> Ptr SocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketConnectionGetLocalAddress" Ptr SocketAddress
result
SocketAddress
result' <- ((ManagedPtr SocketAddress -> SocketAddress)
-> Ptr SocketAddress -> IO SocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketAddress -> SocketAddress
Gio.SocketAddress.SocketAddress) Ptr SocketAddress
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
SocketAddress -> IO SocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return SocketAddress
result'
) (do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data SocketConnectionGetLocalAddressMethodInfo
instance (signature ~ (m Gio.SocketAddress.SocketAddress), MonadIO m, IsSocketConnection a) => O.OverloadedMethod SocketConnectionGetLocalAddressMethodInfo a signature where
overloadedMethod = socketConnectionGetLocalAddress
instance O.OverloadedMethodInfo SocketConnectionGetLocalAddressMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionGetLocalAddress",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionGetLocalAddress"
})
#endif
foreign import ccall "g_socket_connection_get_remote_address" g_socket_connection_get_remote_address ::
Ptr SocketConnection ->
Ptr (Ptr GError) ->
IO (Ptr Gio.SocketAddress.SocketAddress)
socketConnectionGetRemoteAddress ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
a
-> m Gio.SocketAddress.SocketAddress
socketConnectionGetRemoteAddress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketConnection a) =>
a -> m SocketAddress
socketConnectionGetRemoteAddress a
connection = IO SocketAddress -> m SocketAddress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketAddress -> m SocketAddress)
-> IO SocketAddress -> m SocketAddress
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
IO SocketAddress -> IO () -> IO SocketAddress
forall a b. IO a -> IO b -> IO a
onException (do
Ptr SocketAddress
result <- (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress))
-> (Ptr (Ptr GError) -> IO (Ptr SocketAddress))
-> IO (Ptr SocketAddress)
forall a b. (a -> b) -> a -> b
$ Ptr SocketConnection -> Ptr (Ptr GError) -> IO (Ptr SocketAddress)
g_socket_connection_get_remote_address Ptr SocketConnection
connection'
Text -> Ptr SocketAddress -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketConnectionGetRemoteAddress" Ptr SocketAddress
result
SocketAddress
result' <- ((ManagedPtr SocketAddress -> SocketAddress)
-> Ptr SocketAddress -> IO SocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SocketAddress -> SocketAddress
Gio.SocketAddress.SocketAddress) Ptr SocketAddress
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
SocketAddress -> IO SocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return SocketAddress
result'
) (do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data SocketConnectionGetRemoteAddressMethodInfo
instance (signature ~ (m Gio.SocketAddress.SocketAddress), MonadIO m, IsSocketConnection a) => O.OverloadedMethod SocketConnectionGetRemoteAddressMethodInfo a signature where
overloadedMethod = socketConnectionGetRemoteAddress
instance O.OverloadedMethodInfo SocketConnectionGetRemoteAddressMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionGetRemoteAddress",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionGetRemoteAddress"
})
#endif
foreign import ccall "g_socket_connection_get_socket" g_socket_connection_get_socket ::
Ptr SocketConnection ->
IO (Ptr Gio.Socket.Socket)
socketConnectionGetSocket ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
a
-> m Gio.Socket.Socket
socketConnectionGetSocket :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketConnection a) =>
a -> m Socket
socketConnectionGetSocket a
connection = IO Socket -> m Socket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr Socket
result <- Ptr SocketConnection -> IO (Ptr Socket)
g_socket_connection_get_socket Ptr SocketConnection
connection'
Text -> Ptr Socket -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"socketConnectionGetSocket" Ptr Socket
result
Socket
result' <- ((ManagedPtr Socket -> Socket) -> Ptr Socket -> IO Socket
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Socket -> Socket
Gio.Socket.Socket) Ptr Socket
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
result'
#if defined(ENABLE_OVERLOADING)
data SocketConnectionGetSocketMethodInfo
instance (signature ~ (m Gio.Socket.Socket), MonadIO m, IsSocketConnection a) => O.OverloadedMethod SocketConnectionGetSocketMethodInfo a signature where
overloadedMethod = socketConnectionGetSocket
instance O.OverloadedMethodInfo SocketConnectionGetSocketMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionGetSocket",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionGetSocket"
})
#endif
foreign import ccall "g_socket_connection_is_connected" g_socket_connection_is_connected ::
Ptr SocketConnection ->
IO CInt
socketConnectionIsConnected ::
(B.CallStack.HasCallStack, MonadIO m, IsSocketConnection a) =>
a
-> m Bool
socketConnectionIsConnected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSocketConnection a) =>
a -> m Bool
socketConnectionIsConnected a
connection = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
Ptr SocketConnection
connection' <- a -> IO (Ptr SocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CInt
result <- Ptr SocketConnection -> IO CInt
g_socket_connection_is_connected Ptr SocketConnection
connection'
let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data SocketConnectionIsConnectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSocketConnection a) => O.OverloadedMethod SocketConnectionIsConnectedMethodInfo a signature where
overloadedMethod = socketConnectionIsConnected
instance O.OverloadedMethodInfo SocketConnectionIsConnectedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gio.Objects.SocketConnection.socketConnectionIsConnected",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-SocketConnection.html#v:socketConnectionIsConnected"
})
#endif
foreign import ccall "g_socket_connection_factory_lookup_type" g_socket_connection_factory_lookup_type ::
CUInt ->
CUInt ->
Int32 ->
IO CGType
socketConnectionFactoryLookupType ::
(B.CallStack.HasCallStack, MonadIO m) =>
Gio.Enums.SocketFamily
-> Gio.Enums.SocketType
-> Int32
-> m GType
socketConnectionFactoryLookupType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SocketFamily -> SocketType -> Int32 -> m GType
socketConnectionFactoryLookupType SocketFamily
family SocketType
type_ Int32
protocolId = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
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
let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketType -> Int) -> SocketType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketType -> Int
forall a. Enum a => a -> Int
fromEnum) SocketType
type_
CGType
result <- CUInt -> CUInt -> Int32 -> IO CGType
g_socket_connection_factory_lookup_type CUInt
family' CUInt
type_' Int32
protocolId
let result' :: GType
result' = CGType -> GType
GType CGType
result
GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "g_socket_connection_factory_register_type" g_socket_connection_factory_register_type ::
CGType ->
CUInt ->
CUInt ->
Int32 ->
IO ()
socketConnectionFactoryRegisterType ::
(B.CallStack.HasCallStack, MonadIO m) =>
GType
-> Gio.Enums.SocketFamily
-> Gio.Enums.SocketType
-> Int32
-> m ()
socketConnectionFactoryRegisterType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> SocketFamily -> SocketType -> Int32 -> m ()
socketConnectionFactoryRegisterType GType
gType SocketFamily
family SocketType
type_ Int32
protocol = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let gType' :: CGType
gType' = GType -> CGType
gtypeToCGType GType
gType
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
let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SocketType -> Int) -> SocketType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SocketType -> Int
forall a. Enum a => a -> Int
fromEnum) SocketType
type_
CGType -> CUInt -> CUInt -> Int32 -> IO ()
g_socket_connection_factory_register_type CGType
gType' CUInt
family' CUInt
type_' Int32
protocol
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
#endif