-- | 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 = Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int -> IO a -> IO (Maybe a))
-> (Double -> Int) -> Double -> IO a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
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 (PacketOf Message))
recvPacketTimeout :: forall t.
Transport t =>
Double -> t -> IO (Maybe (PacketOf Message))
recvPacketTimeout Double
n t
fd = Double -> IO (PacketOf Message) -> IO (Maybe (PacketOf Message))
forall a. Double -> IO a -> IO (Maybe a)
timeout_r Double
n (t -> IO (PacketOf Message)
forall t. Transport t => t -> IO (PacketOf Message)
recvPacket t
fd)