{-# LANGUAGE TypeFamilies, FlexibleInstances #-}

-- |
-- Module     : Simulation.Aivika.RealTime.Internal.Event
-- Copyright  : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines an event queue.
--
module Simulation.Aivika.RealTime.Internal.Event () where

import Data.Maybe
import Data.IORef
import Data.Time.Clock

import System.Timeout

import Control.Monad
import Control.Monad.Trans
import Control.Exception

import qualified Simulation.Aivika.PriorityQueue.EventQueue as PQ

import Simulation.Aivika.Trans
import Simulation.Aivika.Trans.Internal.Types

import Simulation.Aivika.RealTime.Internal.Channel
import Simulation.Aivika.RealTime.Internal.RT

-- | An implementation of the 'EventQueueing' type class.
instance MonadIO m => EventQueueing (RT m) where

  {-# SPECIALIZE instance EventQueueing (RT IO) #-}

  -- | The event queue type.
  data EventQueue (RT m) =
    EventQueueRT { forall (m :: * -> *).
EventQueue (RT m) -> PriorityQueue (Point (RT m) -> RT m ())
queuePQ :: PQ.PriorityQueue (Point (RT m) -> RT m ()),
                   -- ^ the underlying priority queue
                   forall (m :: * -> *). EventQueue (RT m) -> IORef Bool
queueBusy :: IORef Bool,
                   -- ^ whether the queue is currently processing events
                   forall (m :: * -> *). EventQueue (RT m) -> IORef Double
queueTime :: IORef Double,
                   -- ^ the actual time of the event queue
                   forall (m :: * -> *). EventQueue (RT m) -> UTCTime
queueStartUTCTime :: UTCTime
                   -- ^ the system time of starting the simulation
                 }

  newEventQueue :: Specs (RT m) -> RT m (EventQueue (RT m))
newEventQueue Specs (RT m)
specs =
    do UTCTime
t0 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
       IORef Double
t  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Specs m -> Double
spcStartTime Specs (RT m)
specs
       IORef Bool
f  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Bool
False
       PriorityQueue (Point (RT m) -> RT m ())
pq <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (PriorityQueue a)
PQ.newQueue
       forall (m :: * -> *) a. Monad m => a -> m a
return EventQueueRT { queuePQ :: PriorityQueue (Point (RT m) -> RT m ())
queuePQ   = PriorityQueue (Point (RT m) -> RT m ())
pq,
                             queueBusy :: IORef Bool
queueBusy = IORef Bool
f,
                             queueTime :: IORef Double
queueTime = IORef Double
t,
                             queueStartUTCTime :: UTCTime
queueStartUTCTime = UTCTime
t0 }

  enqueueEventWithPriority :: Double -> Int -> Event (RT m) () -> Event (RT m) ()
enqueueEventWithPriority Double
t Int
priority (Event Point (RT m) -> RT m ()
m) =
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
    let pq :: PriorityQueue (Point (RT m) -> RT m ())
pq = forall (m :: * -> *).
EventQueue (RT m) -> PriorityQueue (Point (RT m) -> RT m ())
queuePQ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Run m -> EventQueue m
runEventQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p
    in forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> Double -> Int -> a -> IO ()
PQ.enqueue PriorityQueue (Point (RT m) -> RT m ())
pq Double
t Int
priority Point (RT m) -> RT m ()
m

  runEventWith :: forall a. EventProcessing -> Event (RT m) a -> Dynamics (RT m) a
runEventWith EventProcessing
processing (Event Point (RT m) -> RT m a
e) =
    forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
    do forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point (RT m)
p forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
EventProcessing -> Dynamics (RT m) ()
processEvents EventProcessing
processing
       Point (RT m) -> RT m a
e Point (RT m)
p

  eventQueueCount :: Event (RT m) Int
eventQueueCount =
    forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
    let pq :: PriorityQueue (Point (RT m) -> RT m ())
pq = forall (m :: * -> *).
EventQueue (RT m) -> PriorityQueue (Point (RT m) -> RT m ())
queuePQ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Run m -> EventQueue m
runEventQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p
    in forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO Int
PQ.queueCount PriorityQueue (Point (RT m) -> RT m ())
pq

-- | Return the current event point.
currentEventPoint :: MonadIO m => Event (RT m) (Point (RT m))
{-# INLINE currentEventPoint #-}
currentEventPoint :: forall (m :: * -> *). MonadIO m => Event (RT m) (Point (RT m))
currentEventPoint =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
  do let q :: EventQueue (RT m)
q = forall (m :: * -> *). Run m -> EventQueue m
runEventQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p
     Double
t' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef (forall (m :: * -> *). EventQueue (RT m) -> IORef Double
queueTime EventQueue (RT m)
q)
     if Double
t' forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Double
pointTime Point (RT m)
p
       then forall (m :: * -> *) a. Monad m => a -> m a
return Point (RT m)
p
       else let sc :: Specs (RT m)
sc = forall (m :: * -> *). Point m -> Specs m
pointSpecs Point (RT m)
p
                t0 :: Double
t0 = forall (m :: * -> *). Specs m -> Double
spcStartTime Specs (RT m)
sc
                dt :: Double
dt = forall (m :: * -> *). Specs m -> Double
spcDT Specs (RT m)
sc
                n' :: Int
n' = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
t' forall a. Num a => a -> a -> a
- Double
t0) forall a. Fractional a => a -> a -> a
/ Double
dt)
            in forall (m :: * -> *) a. Monad m => a -> m a
return Point (RT m)
p { pointTime :: Double
pointTime = Double
t',
                          pointIteration :: Int
pointIteration = Int
n',
                          pointPhase :: Int
pointPhase = -Int
1 }

-- | Process the pending events.
processPendingEventsCore :: MonadIO m => Bool -> Dynamics (RT m) ()
{-# INLINE processPendingEventsCore #-}
processPendingEventsCore :: forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEventsCore Bool
includingCurrentEvents = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point (RT m) -> RT m ()
r where
  r :: Point (RT m) -> RT m ()
r Point (RT m)
p =
    do let q :: EventQueue (RT m)
q = forall (m :: * -> *). Run m -> EventQueue m
runEventQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p
           f :: IORef Bool
f = forall (m :: * -> *). EventQueue (RT m) -> IORef Bool
queueBusy EventQueue (RT m)
q
       Bool
f' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Bool
f
       if Bool
f'
         then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
              [Char]
"Detected an event loop, which may indicate to " forall a. [a] -> [a] -> [a]
++
              [Char]
"a logical error in the model: processPendingEventsCore"
         else do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
f Bool
True
                 EventQueue (RT m) -> Point (RT m) -> Point (RT m) -> RT m ()
call EventQueue (RT m)
q Point (RT m)
p Point (RT m)
p
                 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
f Bool
False
  call :: EventQueue (RT m) -> Point (RT m) -> Point (RT m) -> RT m ()
call EventQueue (RT m)
q Point (RT m)
p Point (RT m)
p0 =
    do let pq :: PriorityQueue (Point (RT m) -> RT m ())
pq = forall (m :: * -> *).
EventQueue (RT m) -> PriorityQueue (Point (RT m) -> RT m ())
queuePQ EventQueue (RT m)
q
           r :: Run (RT m)
r  = forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p
       -- process external actions
       Point (RT m)
p1 <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point (RT m)
p0 forall (m :: * -> *). MonadIO m => Event (RT m) (Point (RT m))
currentEventPoint
       forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point (RT m)
p1 forall (m :: * -> *). MonadIO m => Event (RT m) ()
processChannelActions
       -- proceed with processing the events
       Bool
f <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO Bool
PQ.queueNull PriorityQueue (Point (RT m) -> RT m ())
pq
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
         do (Double
t2, Int
priority2, Point (RT m) -> RT m ()
c2) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO (Double, Int, a)
PQ.queueFront PriorityQueue (Point (RT m) -> RT m ())
pq
            let t :: IORef Double
t = forall (m :: * -> *). EventQueue (RT m) -> IORef Double
queueTime EventQueue (RT m)
q
            Double
t' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Double
t
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
t2 forall a. Ord a => a -> a -> Bool
< Double
t') forall a b. (a -> b) -> a -> b
$ 
              -- error "The time value is too small: processPendingEventsCore"
              forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
              [Char]
"The time value is too small (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
t2 forall a. [a] -> [a] -> [a]
++
              [Char]
" < " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Double
t' forall a. [a] -> [a] -> [a]
++ [Char]
"): processPendingEventsCore"
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Double
t2 forall a. Ord a => a -> a -> Bool
< forall (m :: * -> *). Point m -> Double
pointTime Point (RT m)
p) Bool -> Bool -> Bool
||
                  (Bool
includingCurrentEvents Bool -> Bool -> Bool
&& (Double
t2 forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Point m -> Double
pointTime Point (RT m)
p))) forall a b. (a -> b) -> a -> b
$
              do Bool
emulated <- forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point (RT m)
p1 forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Double -> Event (RT m) Bool
emulateRealTimeDelay Double
t2
                 if Bool
emulated
                   then do let sc :: Specs (RT m)
sc = forall (m :: * -> *). Point m -> Specs m
pointSpecs Point (RT m)
p
                               t0 :: Double
t0 = forall (m :: * -> *). Specs m -> Double
spcStartTime Specs (RT m)
sc
                               dt :: Double
dt = forall (m :: * -> *). Specs m -> Double
spcDT Specs (RT m)
sc
                               n2 :: Int
n2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
t2 forall a. Num a => a -> a -> a
- Double
t0) forall a. Fractional a => a -> a -> a
/ Double
dt)
                               p2 :: Point (RT m)
p2 = Point (RT m)
p { pointTime :: Double
pointTime = Double
t2,
                                        pointPriority :: Int
pointPriority = Int
priority2,
                                        pointIteration :: Int
pointIteration = Int
n2,
                                        pointPhase :: Int
pointPhase = -Int
1 }
                           forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Double
t Double
t2
                           forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PriorityQueue a -> IO ()
PQ.dequeue PriorityQueue (Point (RT m) -> RT m ())
pq
                           Point (RT m) -> RT m ()
c2 Point (RT m)
p2
                           EventQueue (RT m) -> Point (RT m) -> Point (RT m) -> RT m ()
call EventQueue (RT m)
q Point (RT m)
p Point (RT m)
p2
                   else EventQueue (RT m) -> Point (RT m) -> Point (RT m) -> RT m ()
call EventQueue (RT m)
q Point (RT m)
p Point (RT m)
p1

-- | Process the pending events synchronously, i.e. without past.
processPendingEvents :: MonadIO m => Bool -> Dynamics (RT m) ()
{-# INLINE processPendingEvents #-}
processPendingEvents :: forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEvents Bool
includingCurrentEvents = forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point (RT m) -> RT m ()
r where
  r :: Point (RT m) -> RT m ()
r Point (RT m)
p =
    do let q :: EventQueue (RT m)
q = forall (m :: * -> *). Run m -> EventQueue m
runEventQueue forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p
           t :: IORef Double
t = forall (m :: * -> *). EventQueue (RT m) -> IORef Double
queueTime EventQueue (RT m)
q
       Double
t' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Double
t
       if forall (m :: * -> *). Point m -> Double
pointTime Point (RT m)
p forall a. Ord a => a -> a -> Bool
< Double
t'
         then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
              [Char]
"The current time is less than " forall a. [a] -> [a] -> [a]
++
              [Char]
"the time in the queue: processPendingEvents"
         else forall (m :: * -> *) a. Point m -> Dynamics m a -> m a
invokeDynamics Point (RT m)
p Dynamics (RT m) ()
m
  m :: Dynamics (RT m) ()
m = forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEventsCore Bool
includingCurrentEvents

-- | A memoized value.
processEventsIncludingCurrent :: MonadIO m => Dynamics (RT m) ()
{-# INLINE processEventsIncludingCurrent #-}
processEventsIncludingCurrent :: forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingCurrent = forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEvents Bool
True

-- | A memoized value.
processEventsIncludingEarlier :: MonadIO m => Dynamics (RT m) ()
{-# INLINE processEventsIncludingEarlier #-}
processEventsIncludingEarlier :: forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingEarlier = forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEvents Bool
False

-- | A memoized value.
processEventsIncludingCurrentCore :: MonadIO m => Dynamics (RT m) ()
{-# INLINE processEventsIncludingCurrentCore #-}
processEventsIncludingCurrentCore :: forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingCurrentCore = forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEventsCore Bool
True

-- | A memoized value.
processEventsIncludingEarlierCore :: MonadIO m => Dynamics (RT m) ()
{-# INLINE processEventsIncludingEarlierCore #-}
processEventsIncludingEarlierCore :: forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingEarlierCore = forall (m :: * -> *). MonadIO m => Bool -> Dynamics (RT m) ()
processPendingEventsCore Bool
True

-- | Process the events.
processEvents :: MonadIO m => EventProcessing -> Dynamics (RT m) ()
{-# INLINABLE processEvents #-}
processEvents :: forall (m :: * -> *).
MonadIO m =>
EventProcessing -> Dynamics (RT m) ()
processEvents EventProcessing
CurrentEvents = forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingCurrent
processEvents EventProcessing
EarlierEvents = forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingEarlier
processEvents EventProcessing
CurrentEventsOrFromPast = forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingCurrentCore
processEvents EventProcessing
EarlierEventsOrFromPast = forall (m :: * -> *). MonadIO m => Dynamics (RT m) ()
processEventsIncludingEarlierCore

-- | Process the channel actions.
processChannelActions :: MonadIO m => Event (RT m) ()
{-# INLINABLE processChannelActions #-}
processChannelActions :: forall (m :: * -> *). MonadIO m => Event (RT m) ()
processChannelActions =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
  do Channel (Event (RT m) ())
ch <- forall (m :: * -> *). Monad m => RT m (Channel (Event (RT m) ()))
rtChannel
     Bool
f  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Channel a -> IO Bool
channelEmpty Channel (Event (RT m) ())
ch
     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
f forall a b. (a -> b) -> a -> b
$
       do [Event (RT m) ()]
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Channel a -> IO [a]
readChannel Channel (Event (RT m) ())
ch
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Event (RT m) ()]
xs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Point m -> Event m a -> m a
invokeEvent Point (RT m)
p

-- | Try to emulate the real time delay till the specified
-- modeling time without interruption.
emulateRealTimeDelay :: MonadIO m => Double -> Event (RT m) Bool
{-# INLINABLE emulateRealTimeDelay #-}
emulateRealTimeDelay :: forall (m :: * -> *). MonadIO m => Double -> Event (RT m) Bool
emulateRealTimeDelay Double
t2 =
  forall (m :: * -> *) a. (Point m -> m a) -> Event m a
Event forall a b. (a -> b) -> a -> b
$ \Point (RT m)
p ->
  do RTParams
ps  <- forall (m :: * -> *). Monad m => RT m RTParams
rtParams
     UTCTime
utc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
     let scaling :: RTScaling
scaling = RTParams -> RTScaling
rtScaling RTParams
ps
         delta :: Double
delta   = RTParams -> Double
rtIntervalDelta RTParams
ps
         sc :: Specs (RT m)
sc = forall (m :: * -> *). Point m -> Specs m
pointSpecs Point (RT m)
p
         t0 :: Double
t0 = forall (m :: * -> *). Specs m -> Double
spcStartTime Specs (RT m)
sc
         t :: Double
t  = forall (m :: * -> *). Point m -> Double
pointTime Point (RT m)
p
         dt :: Double
dt = RTScaling -> Double -> Double -> Double
rtScale RTScaling
scaling Double
t0 Double
t2
         q :: EventQueue (RT m)
q  = forall (m :: * -> *). Run m -> EventQueue m
runEventQueue (forall (m :: * -> *). Point m -> Run m
pointRun Point (RT m)
p)
         utc0 :: UTCTime
utc0 = forall (m :: * -> *). EventQueue (RT m) -> UTCTime
queueStartUTCTime EventQueue (RT m)
q
         utc' :: UTCTime
utc' = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Double
dt) UTCTime
utc0
         rdt :: Double
rdt  = forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
utc' UTCTime
utc)
     if Double
rdt forall a. Ord a => a -> a -> Bool
< Double
delta
       then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       else do Channel (Event (RT m) ())
ch <- forall (m :: * -> *). Monad m => RT m (Channel (Event (RT m) ()))
rtChannel
               let dt :: Int
dt = Double -> Int
secondsToMicroseconds Double
rdt
               Maybe ()
interrupted <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                              forall a. Int -> IO a -> IO (Maybe a)
timeout Int
dt forall a b. (a -> b) -> a -> b
$ forall a. Channel a -> IO ()
awaitChannel Channel (Event (RT m) ())
ch
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing Maybe ()
interrupted

-- | Convert seconds to microseconds.
secondsToMicroseconds :: Double -> Int
secondsToMicroseconds :: Double -> Int
secondsToMicroseconds Double
x = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round (Double
1000000 forall a. Num a => a -> a -> a
* Double
x)