module Test.Hspec.Core.Timer (withTimer) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Control.Exception
import           Control.Concurrent.Async

import           Test.Hspec.Core.Clock

withTimer :: Seconds -> (IO Bool -> IO a) -> IO a
withTimer :: Seconds -> (IO Bool -> IO a) -> IO a
withTimer Seconds
delay IO Bool -> IO a
action = do
  IORef Bool
ref <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  IO (Async ()) -> (Async () -> IO ()) -> (Async () -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Seconds -> IORef Bool -> IO ()
worker Seconds
delay IORef Bool
ref) Async () -> IO ()
forall a. Async a -> IO ()
cancel ((Async () -> IO a) -> IO a) -> (Async () -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Async ()
_ -> do
    IO Bool -> IO a
action (IO Bool -> IO a) -> IO Bool -> IO a
forall a b. (a -> b) -> a -> b
$ IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Bool
ref (\Bool
a -> (Bool
False, Bool
a))

worker :: Seconds -> IORef Bool -> IO ()
worker :: Seconds -> IORef Bool -> IO ()
worker Seconds
delay IORef Bool
ref = do
  IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Seconds -> IO ()
sleep Seconds
delay
    IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Bool
ref Bool
True