-- | Timeout, implemented independently of socket timeout setting.
module Sound.Osc.Time.Timeout where

import System.Timeout {- base -}

import Sound.Osc.Packet {- hsoc -}
import Sound.Osc.Transport.Fd {- hosc -}

-- | Variant of 'timeout' where time is given in fractional seconds.
timeout_r :: Double -> IO a -> IO (Maybe a)
timeout_r :: forall a. Double -> IO a -> IO (Maybe a)
timeout_r = forall a. Int -> IO a -> IO (Maybe a)
timeout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Double
1000000)

-- | Variant of 'recvPacket' that implements an /n/ second 'timeout'.
recvPacketTimeout :: Transport t => Double -> t -> IO (Maybe Packet)
recvPacketTimeout :: forall t. Transport t => Double -> t -> IO (Maybe Packet)
recvPacketTimeout Double
n t
fd = forall a. Double -> IO a -> IO (Maybe a)
timeout_r Double
n (forall t. Transport t => t -> IO Packet
recvPacket t
fd)