{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Structure used for scatter\/gather data input when receiving multiple
-- messages or packets in one go. You generally pass in an array of empty
-- @/GInputVectors/@ and the operation will use all the buffers as if they
-- were one buffer, and will set /@bytesReceived@/ to the total number of bytes
-- received across all @/GInputVectors/@.
-- 
-- This structure closely mirrors @struct mmsghdr@ and @struct msghdr@ from
-- the POSIX sockets API (see @man 2 recvmmsg@).
-- 
-- If /@address@/ is non-'P.Nothing' then it is set to the source address the message
-- was received from, and the caller must free it afterwards.
-- 
-- If /@controlMessages@/ is non-'P.Nothing' then it is set to an array of control
-- messages received with the message (if any), and the caller must free it
-- afterwards. /@numControlMessages@/ is set to the number of elements in
-- this array, which may be zero.
-- 
-- Flags relevant to this message will be returned in /@flags@/. For example,
-- @MSG_EOR@ or @MSG_TRUNC@.
-- 
-- /Since: 2.48/

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

module GI.Gio.Structs.InputMessage
    ( 

-- * Exported types
    InputMessage(..)                        ,
    newZeroInputMessage                     ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveInputMessageMethod               ,
#endif



 -- * Properties


-- ** address #attr:address#
-- | return location
--   for a t'GI.Gio.Objects.SocketAddress.SocketAddress', or 'P.Nothing'

    clearInputMessageAddress                ,
    getInputMessageAddress                  ,
#if defined(ENABLE_OVERLOADING)
    inputMessage_address                    ,
#endif
    setInputMessageAddress                  ,


-- ** bytesReceived #attr:bytesReceived#
-- | will be set to the number of bytes that have been
--   received

    getInputMessageBytesReceived            ,
#if defined(ENABLE_OVERLOADING)
    inputMessage_bytesReceived              ,
#endif
    setInputMessageBytesReceived            ,


-- ** flags #attr:flags#
-- | collection of t'GI.Gio.Flags.SocketMsgFlags' for the received message,
--   outputted by the call

    getInputMessageFlags                    ,
#if defined(ENABLE_OVERLOADING)
    inputMessage_flags                      ,
#endif
    setInputMessageFlags                    ,


-- ** numControlMessages #attr:numControlMessages#
-- | return location for the number of
--   elements in /@controlMessages@/

    getInputMessageNumControlMessages       ,
#if defined(ENABLE_OVERLOADING)
    inputMessage_numControlMessages         ,
#endif
    setInputMessageNumControlMessages       ,


-- ** numVectors #attr:numVectors#
-- | the number of input vectors pointed to by /@vectors@/

    getInputMessageNumVectors               ,
#if defined(ENABLE_OVERLOADING)
    inputMessage_numVectors                 ,
#endif
    setInputMessageNumVectors               ,




    ) 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 {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress

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

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

instance BoxedPtr InputMessage where
    boxedPtrCopy :: InputMessage -> IO InputMessage
boxedPtrCopy = \InputMessage
p -> InputMessage
-> (Ptr InputMessage -> IO InputMessage) -> IO InputMessage
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr InputMessage
p (Int -> Ptr InputMessage -> IO (Ptr InputMessage)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
56 (Ptr InputMessage -> IO (Ptr InputMessage))
-> (Ptr InputMessage -> IO InputMessage)
-> Ptr InputMessage
-> IO InputMessage
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr InputMessage -> InputMessage)
-> Ptr InputMessage -> IO InputMessage
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr InputMessage -> InputMessage
InputMessage)
    boxedPtrFree :: InputMessage -> IO ()
boxedPtrFree = \InputMessage
x -> InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr InputMessage
x Ptr InputMessage -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr InputMessage where
    boxedPtrCalloc :: IO (Ptr InputMessage)
boxedPtrCalloc = Int -> IO (Ptr InputMessage)
forall a. Int -> IO (Ptr a)
callocBytes Int
56


-- | Construct a `InputMessage` struct initialized to zero.
newZeroInputMessage :: MonadIO m => m InputMessage
newZeroInputMessage :: forall (m :: * -> *). MonadIO m => m InputMessage
newZeroInputMessage = IO InputMessage -> m InputMessage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputMessage -> m InputMessage)
-> IO InputMessage -> m InputMessage
forall a b. (a -> b) -> a -> b
$ IO (Ptr InputMessage)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr InputMessage)
-> (Ptr InputMessage -> IO InputMessage) -> IO InputMessage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr InputMessage -> InputMessage)
-> Ptr InputMessage -> IO InputMessage
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr InputMessage -> InputMessage
InputMessage

instance tag ~ 'AttrSet => Constructible InputMessage tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr InputMessage -> InputMessage)
-> [AttrOp InputMessage tag] -> m InputMessage
new ManagedPtr InputMessage -> InputMessage
_ [AttrOp InputMessage tag]
attrs = do
        InputMessage
o <- m InputMessage
forall (m :: * -> *). MonadIO m => m InputMessage
newZeroInputMessage
        InputMessage -> [AttrOp InputMessage 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set InputMessage
o [AttrOp InputMessage tag]
[AttrOp InputMessage 'AttrSet]
attrs
        InputMessage -> m InputMessage
forall (m :: * -> *) a. Monad m => a -> m a
return InputMessage
o


-- | Get the value of the “@address@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMessage #address
-- @
getInputMessageAddress :: MonadIO m => InputMessage -> m (Maybe Gio.SocketAddress.SocketAddress)
getInputMessageAddress :: forall (m :: * -> *).
MonadIO m =>
InputMessage -> m (Maybe SocketAddress)
getInputMessageAddress InputMessage
s = IO (Maybe SocketAddress) -> m (Maybe SocketAddress)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SocketAddress) -> m (Maybe SocketAddress))
-> IO (Maybe SocketAddress) -> m (Maybe SocketAddress)
forall a b. (a -> b) -> a -> b
$ InputMessage
-> (Ptr InputMessage -> IO (Maybe SocketAddress))
-> IO (Maybe SocketAddress)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO (Maybe SocketAddress))
 -> IO (Maybe SocketAddress))
-> (Ptr InputMessage -> IO (Maybe SocketAddress))
-> IO (Maybe SocketAddress)
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr SocketAddress
val <- Ptr (Ptr SocketAddress) -> IO (Ptr SocketAddress)
forall a. Storable a => Ptr a -> IO a
peek (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr (Ptr SocketAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr Gio.SocketAddress.SocketAddress)
    Maybe SocketAddress
result <- Ptr SocketAddress
-> (Ptr SocketAddress -> IO SocketAddress)
-> IO (Maybe SocketAddress)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr SocketAddress
val ((Ptr SocketAddress -> IO SocketAddress)
 -> IO (Maybe SocketAddress))
-> (Ptr SocketAddress -> IO SocketAddress)
-> IO (Maybe SocketAddress)
forall a b. (a -> b) -> a -> b
$ \Ptr SocketAddress
val' -> do
        SocketAddress
val'' <- ((ManagedPtr SocketAddress -> SocketAddress)
-> Ptr SocketAddress -> IO SocketAddress
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SocketAddress -> SocketAddress
Gio.SocketAddress.SocketAddress) Ptr SocketAddress
val'
        SocketAddress -> IO SocketAddress
forall (m :: * -> *) a. Monad m => a -> m a
return SocketAddress
val''
    Maybe SocketAddress -> IO (Maybe SocketAddress)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SocketAddress
result

-- | Set the value of the “@address@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMessage [ #address 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMessageAddress :: MonadIO m => InputMessage -> Ptr Gio.SocketAddress.SocketAddress -> m ()
setInputMessageAddress :: forall (m :: * -> *).
MonadIO m =>
InputMessage -> Ptr SocketAddress -> m ()
setInputMessageAddress InputMessage
s Ptr SocketAddress
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO ()) -> IO ())
-> (Ptr InputMessage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr (Ptr SocketAddress) -> Ptr SocketAddress -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr (Ptr SocketAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr SocketAddress
val :: Ptr Gio.SocketAddress.SocketAddress)

-- | Set the value of the “@address@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #address
-- @
clearInputMessageAddress :: MonadIO m => InputMessage -> m ()
clearInputMessageAddress :: forall (m :: * -> *). MonadIO m => InputMessage -> m ()
clearInputMessageAddress InputMessage
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO ()) -> IO ())
-> (Ptr InputMessage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr (Ptr SocketAddress) -> Ptr SocketAddress -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr (Ptr SocketAddress)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr SocketAddress
forall a. Ptr a
FP.nullPtr :: Ptr Gio.SocketAddress.SocketAddress)

#if defined(ENABLE_OVERLOADING)
data InputMessageAddressFieldInfo
instance AttrInfo InputMessageAddressFieldInfo where
    type AttrBaseTypeConstraint InputMessageAddressFieldInfo = (~) InputMessage
    type AttrAllowedOps InputMessageAddressFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint InputMessageAddressFieldInfo = (~) (Ptr Gio.SocketAddress.SocketAddress)
    type AttrTransferTypeConstraint InputMessageAddressFieldInfo = (~)(Ptr Gio.SocketAddress.SocketAddress)
    type AttrTransferType InputMessageAddressFieldInfo = (Ptr Gio.SocketAddress.SocketAddress)
    type AttrGetType InputMessageAddressFieldInfo = Maybe Gio.SocketAddress.SocketAddress
    type AttrLabel InputMessageAddressFieldInfo = "address"
    type AttrOrigin InputMessageAddressFieldInfo = InputMessage
    attrGet = getInputMessageAddress
    attrSet = setInputMessageAddress
    attrConstruct = undefined
    attrClear = clearInputMessageAddress
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.InputMessage.address"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-InputMessage.html#g:attr:address"
        })

inputMessage_address :: AttrLabelProxy "address"
inputMessage_address = AttrLabelProxy

#endif


-- XXX Skipped attribute for "InputMessage:vectors"
-- Not implemented: Don't know how to unpack C array of type TCArray False (-1) 2 (TInterface (Name {namespace = "Gio", name = "InputVector"}))
-- | Get the value of the “@num_vectors@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMessage #numVectors
-- @
getInputMessageNumVectors :: MonadIO m => InputMessage -> m Word32
getInputMessageNumVectors :: forall (m :: * -> *). MonadIO m => InputMessage -> m Word32
getInputMessageNumVectors InputMessage
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO Word32) -> IO Word32)
-> (Ptr InputMessage -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@num_vectors@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMessage [ #numVectors 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMessageNumVectors :: MonadIO m => InputMessage -> Word32 -> m ()
setInputMessageNumVectors :: forall (m :: * -> *). MonadIO m => InputMessage -> Word32 -> m ()
setInputMessageNumVectors InputMessage
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO ()) -> IO ())
-> (Ptr InputMessage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data InputMessageNumVectorsFieldInfo
instance AttrInfo InputMessageNumVectorsFieldInfo where
    type AttrBaseTypeConstraint InputMessageNumVectorsFieldInfo = (~) InputMessage
    type AttrAllowedOps InputMessageNumVectorsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint InputMessageNumVectorsFieldInfo = (~) Word32
    type AttrTransferTypeConstraint InputMessageNumVectorsFieldInfo = (~)Word32
    type AttrTransferType InputMessageNumVectorsFieldInfo = Word32
    type AttrGetType InputMessageNumVectorsFieldInfo = Word32
    type AttrLabel InputMessageNumVectorsFieldInfo = "num_vectors"
    type AttrOrigin InputMessageNumVectorsFieldInfo = InputMessage
    attrGet = getInputMessageNumVectors
    attrSet = setInputMessageNumVectors
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.InputMessage.numVectors"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-InputMessage.html#g:attr:numVectors"
        })

inputMessage_numVectors :: AttrLabelProxy "numVectors"
inputMessage_numVectors = AttrLabelProxy

#endif


-- | Get the value of the “@bytes_received@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMessage #bytesReceived
-- @
getInputMessageBytesReceived :: MonadIO m => InputMessage -> m Word64
getInputMessageBytesReceived :: forall (m :: * -> *). MonadIO m => InputMessage -> m Word64
getInputMessageBytesReceived InputMessage
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO Word64) -> IO Word64)
-> (Ptr InputMessage -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

-- | Set the value of the “@bytes_received@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMessage [ #bytesReceived 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMessageBytesReceived :: MonadIO m => InputMessage -> Word64 -> m ()
setInputMessageBytesReceived :: forall (m :: * -> *). MonadIO m => InputMessage -> Word64 -> m ()
setInputMessageBytesReceived InputMessage
s Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO ()) -> IO ())
-> (Ptr InputMessage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data InputMessageBytesReceivedFieldInfo
instance AttrInfo InputMessageBytesReceivedFieldInfo where
    type AttrBaseTypeConstraint InputMessageBytesReceivedFieldInfo = (~) InputMessage
    type AttrAllowedOps InputMessageBytesReceivedFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint InputMessageBytesReceivedFieldInfo = (~) Word64
    type AttrTransferTypeConstraint InputMessageBytesReceivedFieldInfo = (~)Word64
    type AttrTransferType InputMessageBytesReceivedFieldInfo = Word64
    type AttrGetType InputMessageBytesReceivedFieldInfo = Word64
    type AttrLabel InputMessageBytesReceivedFieldInfo = "bytes_received"
    type AttrOrigin InputMessageBytesReceivedFieldInfo = InputMessage
    attrGet = getInputMessageBytesReceived
    attrSet = setInputMessageBytesReceived
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.InputMessage.bytesReceived"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-InputMessage.html#g:attr:bytesReceived"
        })

inputMessage_bytesReceived :: AttrLabelProxy "bytesReceived"
inputMessage_bytesReceived = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMessage #flags
-- @
getInputMessageFlags :: MonadIO m => InputMessage -> m Int32
getInputMessageFlags :: forall (m :: * -> *). MonadIO m => InputMessage -> m Int32
getInputMessageFlags InputMessage
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO Int32) -> IO Int32)
-> (Ptr InputMessage -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMessage [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMessageFlags :: MonadIO m => InputMessage -> Int32 -> m ()
setInputMessageFlags :: forall (m :: * -> *). MonadIO m => InputMessage -> Int32 -> m ()
setInputMessageFlags InputMessage
s Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO ()) -> IO ())
-> (Ptr InputMessage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data InputMessageFlagsFieldInfo
instance AttrInfo InputMessageFlagsFieldInfo where
    type AttrBaseTypeConstraint InputMessageFlagsFieldInfo = (~) InputMessage
    type AttrAllowedOps InputMessageFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint InputMessageFlagsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint InputMessageFlagsFieldInfo = (~)Int32
    type AttrTransferType InputMessageFlagsFieldInfo = Int32
    type AttrGetType InputMessageFlagsFieldInfo = Int32
    type AttrLabel InputMessageFlagsFieldInfo = "flags"
    type AttrOrigin InputMessageFlagsFieldInfo = InputMessage
    attrGet = getInputMessageFlags
    attrSet = setInputMessageFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.InputMessage.flags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-InputMessage.html#g:attr:flags"
        })

inputMessage_flags :: AttrLabelProxy "flags"
inputMessage_flags = AttrLabelProxy

#endif


-- XXX Skipped attribute for "InputMessage:control_messages"
-- Not implemented: Don't know how to unpack C array of type TCArray False (-1) 6 (TInterface (Name {namespace = "Gio", name = "SocketControlMessage"}))
-- | Get the value of the “@num_control_messages@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMessage #numControlMessages
-- @
getInputMessageNumControlMessages :: MonadIO m => InputMessage -> m Word32
getInputMessageNumControlMessages :: forall (m :: * -> *). MonadIO m => InputMessage -> m Word32
getInputMessageNumControlMessages InputMessage
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO Word32) -> IO Word32)
-> (Ptr InputMessage -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@num_control_messages@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMessage [ #numControlMessages 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMessageNumControlMessages :: MonadIO m => InputMessage -> Word32 -> m ()
setInputMessageNumControlMessages :: forall (m :: * -> *). MonadIO m => InputMessage -> Word32 -> m ()
setInputMessageNumControlMessages InputMessage
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InputMessage -> (Ptr InputMessage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr InputMessage
s ((Ptr InputMessage -> IO ()) -> IO ())
-> (Ptr InputMessage -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr InputMessage
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr InputMessage
ptr Ptr InputMessage -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data InputMessageNumControlMessagesFieldInfo
instance AttrInfo InputMessageNumControlMessagesFieldInfo where
    type AttrBaseTypeConstraint InputMessageNumControlMessagesFieldInfo = (~) InputMessage
    type AttrAllowedOps InputMessageNumControlMessagesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint InputMessageNumControlMessagesFieldInfo = (~) Word32
    type AttrTransferTypeConstraint InputMessageNumControlMessagesFieldInfo = (~)Word32
    type AttrTransferType InputMessageNumControlMessagesFieldInfo = Word32
    type AttrGetType InputMessageNumControlMessagesFieldInfo = Word32
    type AttrLabel InputMessageNumControlMessagesFieldInfo = "num_control_messages"
    type AttrOrigin InputMessageNumControlMessagesFieldInfo = InputMessage
    attrGet = getInputMessageNumControlMessages
    attrSet = setInputMessageNumControlMessages
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.InputMessage.numControlMessages"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Structs-InputMessage.html#g:attr:numControlMessages"
        })

inputMessage_numControlMessages :: AttrLabelProxy "numControlMessages"
inputMessage_numControlMessages = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InputMessage
type instance O.AttributeList InputMessage = InputMessageAttributeList
type InputMessageAttributeList = ('[ '("address", InputMessageAddressFieldInfo), '("numVectors", InputMessageNumVectorsFieldInfo), '("bytesReceived", InputMessageBytesReceivedFieldInfo), '("flags", InputMessageFlagsFieldInfo), '("numControlMessages", InputMessageNumControlMessagesFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveInputMessageMethod (t :: Symbol) (o :: *) :: * where
    ResolveInputMessageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif