{-# LINE 1 "Bindings/Reliable/IO.hsc" #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Bindings.Reliable.IO where
import Data.Word (Word8, Word16, Word64)
import Foreign.C.String (CString)
import Foreign.C.Types (CChar(..), CInt(..), CFloat(..), CDouble(..))
import Foreign.Marshal.Array (peekArray, pokeArray)
import Foreign.Ptr (Ptr, FunPtr, plusPtr)
import Foreign.Storable (Storable(..))
import Prelude ( IO, Eq, Show, Num
, ($)
, div, undefined, return, take
)
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_SENT = 0
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_SENT :: (Num a) => a
{-# LINE 44 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_RECEIVED = 1
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_RECEIVED :: (Num a) => a
{-# LINE 45 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_ACKED = 2
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_ACKED :: (Num a) => a
{-# LINE 46 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_STALE = 3
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_STALE :: (Num a) => a
{-# LINE 47 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_INVALID = 4
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_INVALID :: (Num a) => a
{-# LINE 48 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_TOO_LARGE_TO_SEND = 5
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_TOO_LARGE_TO_SEND :: (Num a) => a
{-# LINE 49 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_TOO_LARGE_TO_RECEIVE = 6
c'RELIABLE_ENDPOINT_COUNTER_NUM_PACKETS_TOO_LARGE_TO_RECEIVE :: (Num a) => a
{-# LINE 50 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_SENT = 7
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_SENT :: (Num a) => a
{-# LINE 51 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_RECEIVED = 8
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_RECEIVED :: (Num a) => a
{-# LINE 52 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_INVALID = 9
c'RELIABLE_ENDPOINT_COUNTER_NUM_FRAGMENTS_INVALID :: (Num a) => a
{-# LINE 53 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ENDPOINT_NUM_COUNTERS = 10
c'RELIABLE_ENDPOINT_NUM_COUNTERS :: (Num a) => a
{-# LINE 54 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_LOG_LEVEL_NONE = 0
c'RELIABLE_LOG_LEVEL_NONE :: (Num a) => a
{-# LINE 56 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_LOG_LEVEL_ERROR = 1
c'RELIABLE_LOG_LEVEL_ERROR :: (Num a) => a
{-# LINE 57 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_LOG_LEVEL_INFO = 2
c'RELIABLE_LOG_LEVEL_INFO :: (Num a) => a
{-# LINE 58 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_LOG_LEVEL_DEBUG = 3
c'RELIABLE_LOG_LEVEL_DEBUG :: (Num a) => a
{-# LINE 59 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_OK = 1
c'RELIABLE_OK :: (Num a) => a
{-# LINE 61 "Bindings/Reliable/IO.hsc" #-}
c'RELIABLE_ERROR = 0
c'RELIABLE_ERROR :: (Num a) => a
{-# LINE 62 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_init" c'reliable_init
:: IO CInt
foreign import ccall "&reliable_init" p'reliable_init
:: FunPtr (IO CInt)
{-# LINE 64 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_term" c'reliable_term
:: IO ()
foreign import ccall "&reliable_term" p'reliable_term
:: FunPtr (IO ())
{-# LINE 65 "Bindings/Reliable/IO.hsc" #-}
type C'allocate_function_t = FunPtr (Ptr () -> Word64 -> IO (Ptr ()))
foreign import ccall "wrapper" mk'allocate_function_t
:: (Ptr () -> Word64 -> IO (Ptr ())) -> IO C'allocate_function_t
foreign import ccall "dynamic" mK'allocate_function_t
:: C'allocate_function_t -> (Ptr () -> Word64 -> IO (Ptr ()))
{-# LINE 67 "Bindings/Reliable/IO.hsc" #-}
type C'free_function_t = FunPtr (Ptr () -> Ptr () -> IO ())
foreign import ccall "wrapper" mk'free_function_t
:: (Ptr () -> Ptr () -> IO ()) -> IO C'free_function_t
foreign import ccall "dynamic" mK'free_function_t
:: C'free_function_t -> (Ptr () -> Ptr () -> IO ())
{-# LINE 68 "Bindings/Reliable/IO.hsc" #-}
type C'transmit_packet_function_t = FunPtr (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO ())
foreign import ccall "wrapper" mk'transmit_packet_function_t
:: (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO ()) -> IO C'transmit_packet_function_t
foreign import ccall "dynamic" mK'transmit_packet_function_t
:: C'transmit_packet_function_t -> (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO ())
{-# LINE 69 "Bindings/Reliable/IO.hsc" #-}
type C'process_packet_function_t = FunPtr (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO CInt)
foreign import ccall "wrapper" mk'process_packet_function_t
:: (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO CInt) -> IO C'process_packet_function_t
foreign import ccall "dynamic" mK'process_packet_function_t
:: C'process_packet_function_t -> (Ptr () -> CInt -> Word16 -> Ptr Word8 -> CInt -> IO CInt)
{-# LINE 70 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 72 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 73 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 74 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 75 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 76 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 77 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 78 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 79 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 80 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 81 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 82 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 83 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 84 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 85 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 86 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 87 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 88 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 89 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 90 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 91 "Bindings/Reliable/IO.hsc" #-}
{-# LINE 92 "Bindings/Reliable/IO.hsc" #-}
data C'reliable_config_t = C'reliable_config_t{
c'reliable_config_t'name :: [CChar],
c'reliable_config_t'context :: Ptr (),
c'reliable_config_t'index :: CInt,
c'reliable_config_t'max_packet_size :: CInt,
c'reliable_config_t'fragment_above :: CInt,
c'reliable_config_t'max_fragments :: CInt,
c'reliable_config_t'fragment_size :: CInt,
c'reliable_config_t'ack_buffer_size :: CInt,
c'reliable_config_t'sent_packets_buffer_size :: CInt,
c'reliable_config_t'received_packets_buffer_size :: CInt,
c'reliable_config_t'fragment_reassembly_buffer_size :: CInt,
c'reliable_config_t'rtt_smoothing_factor :: CFloat,
c'reliable_config_t'packet_loss_smoothing_factor :: CFloat,
c'reliable_config_t'bandwidth_smoothing_factor :: CFloat,
c'reliable_config_t'packet_header_size :: CInt,
c'reliable_config_t'transmit_packet_function :: C'transmit_packet_function_t,
c'reliable_config_t'process_packet_function :: C'process_packet_function_t,
c'reliable_config_t'allocator_context :: Ptr (),
c'reliable_config_t'allocate_function :: C'allocate_function_t,
c'reliable_config_t'free_function :: C'free_function_t
} deriving (Eq,Show)
p'reliable_config_t'name p = plusPtr p 0
p'reliable_config_t'name :: Ptr (C'reliable_config_t) -> Ptr (CChar)
p'reliable_config_t'context p = plusPtr p 256
p'reliable_config_t'context :: Ptr (C'reliable_config_t) -> Ptr (Ptr ())
p'reliable_config_t'index p = plusPtr p 264
p'reliable_config_t'index :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'max_packet_size p = plusPtr p 268
p'reliable_config_t'max_packet_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'fragment_above p = plusPtr p 272
p'reliable_config_t'fragment_above :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'max_fragments p = plusPtr p 276
p'reliable_config_t'max_fragments :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'fragment_size p = plusPtr p 280
p'reliable_config_t'fragment_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'ack_buffer_size p = plusPtr p 284
p'reliable_config_t'ack_buffer_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'sent_packets_buffer_size p = plusPtr p 288
p'reliable_config_t'sent_packets_buffer_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'received_packets_buffer_size p = plusPtr p 292
p'reliable_config_t'received_packets_buffer_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'fragment_reassembly_buffer_size p = plusPtr p 296
p'reliable_config_t'fragment_reassembly_buffer_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'rtt_smoothing_factor p = plusPtr p 300
p'reliable_config_t'rtt_smoothing_factor :: Ptr (C'reliable_config_t) -> Ptr (CFloat)
p'reliable_config_t'packet_loss_smoothing_factor p = plusPtr p 304
p'reliable_config_t'packet_loss_smoothing_factor :: Ptr (C'reliable_config_t) -> Ptr (CFloat)
p'reliable_config_t'bandwidth_smoothing_factor p = plusPtr p 308
p'reliable_config_t'bandwidth_smoothing_factor :: Ptr (C'reliable_config_t) -> Ptr (CFloat)
p'reliable_config_t'packet_header_size p = plusPtr p 312
p'reliable_config_t'packet_header_size :: Ptr (C'reliable_config_t) -> Ptr (CInt)
p'reliable_config_t'transmit_packet_function p = plusPtr p 320
p'reliable_config_t'transmit_packet_function :: Ptr (C'reliable_config_t) -> Ptr (C'transmit_packet_function_t)
p'reliable_config_t'process_packet_function p = plusPtr p 328
p'reliable_config_t'process_packet_function :: Ptr (C'reliable_config_t) -> Ptr (C'process_packet_function_t)
p'reliable_config_t'allocator_context p = plusPtr p 336
p'reliable_config_t'allocator_context :: Ptr (C'reliable_config_t) -> Ptr (Ptr ())
p'reliable_config_t'allocate_function p = plusPtr p 344
p'reliable_config_t'allocate_function :: Ptr (C'reliable_config_t) -> Ptr (C'allocate_function_t)
p'reliable_config_t'free_function p = plusPtr p 352
p'reliable_config_t'free_function :: Ptr (C'reliable_config_t) -> Ptr (C'free_function_t)
instance Storable C'reliable_config_t where
sizeOf _ = 360
alignment _ = 8
peek _p = do
v0 <- let s0 = div 256 $ sizeOf $ (undefined :: CChar) in peekArray s0 (plusPtr _p 0)
v1 <- peekByteOff _p 256
v2 <- peekByteOff _p 264
v3 <- peekByteOff _p 268
v4 <- peekByteOff _p 272
v5 <- peekByteOff _p 276
v6 <- peekByteOff _p 280
v7 <- peekByteOff _p 284
v8 <- peekByteOff _p 288
v9 <- peekByteOff _p 292
v10 <- peekByteOff _p 296
v11 <- peekByteOff _p 300
v12 <- peekByteOff _p 304
v13 <- peekByteOff _p 308
v14 <- peekByteOff _p 312
v15 <- peekByteOff _p 320
v16 <- peekByteOff _p 328
v17 <- peekByteOff _p 336
v18 <- peekByteOff _p 344
v19 <- peekByteOff _p 352
return $ C'reliable_config_t v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 v17 v18 v19
poke _p (C'reliable_config_t v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 v17 v18 v19) = do
let s0 = div 256 $ sizeOf $ (undefined :: CChar)
pokeArray (plusPtr _p 0) (take s0 v0)
pokeByteOff _p 256 v1
pokeByteOff _p 264 v2
pokeByteOff _p 268 v3
pokeByteOff _p 272 v4
pokeByteOff _p 276 v5
pokeByteOff _p 280 v6
pokeByteOff _p 284 v7
pokeByteOff _p 288 v8
pokeByteOff _p 292 v9
pokeByteOff _p 296 v10
pokeByteOff _p 300 v11
pokeByteOff _p 304 v12
pokeByteOff _p 308 v13
pokeByteOff _p 312 v14
pokeByteOff _p 320 v15
pokeByteOff _p 328 v16
pokeByteOff _p 336 v17
pokeByteOff _p 344 v18
pokeByteOff _p 352 v19
return ()
{-# LINE 93 "Bindings/Reliable/IO.hsc" #-}
data C'reliable_endpoint_t = C'reliable_endpoint_t
{-# LINE 95 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_default_config" c'reliable_default_config
:: Ptr C'reliable_config_t -> IO ()
foreign import ccall "&reliable_default_config" p'reliable_default_config
:: FunPtr (Ptr C'reliable_config_t -> IO ())
{-# LINE 97 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_create" c'reliable_endpoint_create
:: Ptr C'reliable_config_t -> CDouble -> IO (Ptr C'reliable_endpoint_t)
foreign import ccall "&reliable_endpoint_create" p'reliable_endpoint_create
:: FunPtr (Ptr C'reliable_config_t -> CDouble -> IO (Ptr C'reliable_endpoint_t))
{-# LINE 98 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_next_packet_sequence" c'reliable_endpoint_next_packet_sequence
:: Ptr C'reliable_endpoint_t -> IO Word16
foreign import ccall "&reliable_endpoint_next_packet_sequence" p'reliable_endpoint_next_packet_sequence
:: FunPtr (Ptr C'reliable_endpoint_t -> IO Word16)
{-# LINE 99 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_send_packet" c'reliable_endpoint_send_packet
:: Ptr C'reliable_endpoint_t -> Ptr Word8 -> CInt -> IO ()
foreign import ccall "&reliable_endpoint_send_packet" p'reliable_endpoint_send_packet
:: FunPtr (Ptr C'reliable_endpoint_t -> Ptr Word8 -> CInt -> IO ())
{-# LINE 100 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_receive_packet" c'reliable_endpoint_receive_packet
:: Ptr C'reliable_endpoint_t -> Ptr Word8 -> CInt -> IO ()
foreign import ccall "&reliable_endpoint_receive_packet" p'reliable_endpoint_receive_packet
:: FunPtr (Ptr C'reliable_endpoint_t -> Ptr Word8 -> CInt -> IO ())
{-# LINE 101 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_get_acks" c'reliable_endpoint_get_acks
:: Ptr C'reliable_endpoint_t -> Ptr CInt -> IO (Ptr Word16)
foreign import ccall "&reliable_endpoint_get_acks" p'reliable_endpoint_get_acks
:: FunPtr (Ptr C'reliable_endpoint_t -> Ptr CInt -> IO (Ptr Word16))
{-# LINE 102 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_clear_acks" c'reliable_endpoint_clear_acks
:: Ptr C'reliable_endpoint_t -> IO ()
foreign import ccall "&reliable_endpoint_clear_acks" p'reliable_endpoint_clear_acks
:: FunPtr (Ptr C'reliable_endpoint_t -> IO ())
{-# LINE 103 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_reset" c'reliable_endpoint_reset
:: Ptr C'reliable_endpoint_t -> IO ()
foreign import ccall "&reliable_endpoint_reset" p'reliable_endpoint_reset
:: FunPtr (Ptr C'reliable_endpoint_t -> IO ())
{-# LINE 104 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_update" c'reliable_endpoint_update
:: Ptr C'reliable_endpoint_t -> CDouble -> IO ()
foreign import ccall "&reliable_endpoint_update" p'reliable_endpoint_update
:: FunPtr (Ptr C'reliable_endpoint_t -> CDouble -> IO ())
{-# LINE 105 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_rtt" c'reliable_endpoint_rtt
:: Ptr C'reliable_endpoint_t -> IO CFloat
foreign import ccall "&reliable_endpoint_rtt" p'reliable_endpoint_rtt
:: FunPtr (Ptr C'reliable_endpoint_t -> IO CFloat)
{-# LINE 106 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_packet_loss" c'reliable_endpoint_packet_loss
:: Ptr C'reliable_endpoint_t -> IO CFloat
foreign import ccall "&reliable_endpoint_packet_loss" p'reliable_endpoint_packet_loss
:: FunPtr (Ptr C'reliable_endpoint_t -> IO CFloat)
{-# LINE 107 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_bandwidth" c'reliable_endpoint_bandwidth
:: Ptr C'reliable_endpoint_t -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ()
foreign import ccall "&reliable_endpoint_bandwidth" p'reliable_endpoint_bandwidth
:: FunPtr (Ptr C'reliable_endpoint_t -> Ptr CFloat -> Ptr CFloat -> Ptr CFloat -> IO ())
{-# LINE 108 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_counters" c'reliable_endpoint_counters
:: Ptr C'reliable_endpoint_t -> IO (Ptr Word64)
foreign import ccall "&reliable_endpoint_counters" p'reliable_endpoint_counters
:: FunPtr (Ptr C'reliable_endpoint_t -> IO (Ptr Word64))
{-# LINE 109 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_destroy" c'reliable_endpoint_destroy
:: Ptr C'reliable_endpoint_t -> IO ()
foreign import ccall "&reliable_endpoint_destroy" p'reliable_endpoint_destroy
:: FunPtr (Ptr C'reliable_endpoint_t -> IO ())
{-# LINE 110 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_log_level" c'reliable_log_level
:: CInt -> IO ()
foreign import ccall "&reliable_log_level" p'reliable_log_level
:: FunPtr (CInt -> IO ())
{-# LINE 111 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_endpoint_free_packet" c'reliable_endpoint_free_packet
:: Ptr C'reliable_endpoint_t -> Ptr () -> IO ()
foreign import ccall "&reliable_endpoint_free_packet" p'reliable_endpoint_free_packet
:: FunPtr (Ptr C'reliable_endpoint_t -> Ptr () -> IO ())
{-# LINE 114 "Bindings/Reliable/IO.hsc" #-}
type C'assert_function_t = FunPtr (CString -> CString -> CString -> CInt -> IO ())
foreign import ccall "wrapper" mk'assert_function_t
:: (CString -> CString -> CString -> CInt -> IO ()) -> IO C'assert_function_t
foreign import ccall "dynamic" mK'assert_function_t
:: C'assert_function_t -> (CString -> CString -> CString -> CInt -> IO ())
{-# LINE 118 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_set_assert_function" c'reliable_set_assert_function
:: C'assert_function_t -> IO ()
foreign import ccall "&reliable_set_assert_function" p'reliable_set_assert_function
:: FunPtr (C'assert_function_t -> IO ())
{-# LINE 119 "Bindings/Reliable/IO.hsc" #-}
foreign import ccall "reliable_test" c'reliable_test
:: IO ()
foreign import ccall "&reliable_test" p'reliable_test
:: FunPtr (IO ())
{-# LINE 122 "Bindings/Reliable/IO.hsc" #-}