module Delay 
    ( doLater
    , cancelAction
    , newCancelVar
    , CancelVar
    ) where

import Control.Concurrent
import Control.Concurrent.MVar

--------------------

newtype CancelVar = C (MVar (Maybe ThreadId))

newCancelVar :: IO CancelVar
newCancelVar = fmap C $ newMVar Nothing

cancelAction :: CancelVar -> IO ()
cancelAction (C v) = do
    swapMVar v Nothing
    return ()

doLater :: RealFrac t => CancelVar -> t -> IO () -> IO ()
doLater (C v) t action = do
    tid <- forkIO $ do
        threadDelay $ round $ 1000000 * t
        mytid <- myThreadId
        b <- readMVar v
        case b of
            Just tid | tid == mytid -> action
            _                       -> return ()
    swapMVar v (Just tid)
    return ()