diff --git a/src/Control/Concurrent/Timer.hs b/src/Control/Concurrent/Timer.hs --- a/src/Control/Concurrent/Timer.hs +++ b/src/Control/Concurrent/Timer.hs @@ -3,9 +3,11 @@ , TimerIO , oneShotTimer +, oneShotStart , oneShotRestart , repeatedTimer +, repeatedStart , repeatedRestart , newTimer @@ -19,109 +21,159 @@ import Control.Concurrent.Suspend (Delay, suspend) import Control.Monad ------------------------------------------------------------------------------ -import Control.Concurrent.Timer.Types (Timer(..)) +import Control.Concurrent.Timer.Types (Timer(..), TimerImmutable(..)) ------------------------------------------------------------------------------ --- | Attempts to restart (or start) a timer making it a one shot timer. +-- | Attempts to start a timer. +-- The started timer will have the given delay and action associated and will be one-shot timer. -- +-- If the timer was already initialized, it the previous timer will be stoped (the thread killed) and the timer will be started anew. +-- +-- Returns True if the strat was successful, +-- otherwise (e.g. other thread is attempting to manipulate the timer) returns False. +oneShotStart :: TimerIO + -> IO () -- ^ The action the timer will start with. + -> Delay -- ^ The dealy the timer will start with. + -> IO Bool +oneShotStart (Timer mvmtim) a d = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable _ _ tid)) -> do + killThread tid + oneShotTimerImmutable a d >>= putMVar mvmtim . Just + return True + Just (Nothing) -> do + oneShotTimerImmutable a d >>= putMVar mvmtim . Just + return True + Nothing -> return False +{-# INLINEABLE oneShotStart #-} + +-- | Attempts to start a timer. +-- The started timer will have the given delay and action associated and will be repeated timer. +-- +-- If the timer was already initialized, it the previous timer will be stoped (the thread killed) and the timer will be started anew. +-- +-- Returns True if the strat was successful, +-- otherwise (e.g. other thread is attempting to manipulate the timer) returns False. +repeatedStart :: TimerIO + -> IO () -- ^ The action the timer will start with. + -> Delay -- ^ The dealy the timer will start with. + -> IO Bool +repeatedStart (Timer mvmtim) a d = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable _ _ tid)) -> do + killThread tid + repeatedTimerImmutable a d >>= putMVar mvmtim . Just + return True + Just (Nothing) -> do + repeatedTimerImmutable a d >>= putMVar mvmtim . Just + return True + Nothing -> return False +{-# INLINEABLE repeatedStart #-} + +-- | Attempts to restart already initialized timer. +-- The restarted timer will have the same delay and action associated and will be one-shot timer. +-- -- Returns True if the restrat was successful, --- otherwise (e.g. other thread is attempting to restart the timer) returns False. +-- otherwise (e.g. other thread is attempting to manipulate the timer or the timer was not initialized) returns False. oneShotRestart :: TimerIO -> IO Bool -oneShotRestart (Timer action delay threadID) = do - mtid <- tryTakeMVar threadID - case mtid of - Just (Just tid) -> do +oneShotRestart (Timer mvmtim) = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable a d tid)) -> do killThread tid - ntid <- Just <$> oneShotAction delay action - putMVar threadID ntid - return True - Just (Nothing) -> do - ntid <- Just <$> oneShotAction delay action - putMVar threadID ntid + oneShotTimerImmutable a d >>= putMVar mvmtim . Just return True - Nothing -> return False + _ -> return False {-# INLINEABLE oneShotRestart #-} --- | Attempts to restart (or start) a timer making it a repeated timer. +-- | Attempts to restart already initialized timer. +-- The restarted timer will have the same delay and action associated and will be one-shot timer. -- -- Returns True if the restrat was successful, --- otherwise (e.g. other thread is attempting to restart the timer) returns False. +-- otherwise (e.g. other thread is attempting to manipulate the timer or the timer was not initialized) returns False. repeatedRestart :: TimerIO -> IO Bool -repeatedRestart (Timer action delay threadID) = do - mtid <- tryTakeMVar threadID - case mtid of - Just (Just tid) -> do +repeatedRestart (Timer mvmtim) = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable a d tid)) -> do killThread tid - ntid <- Just <$> repeatedAction delay action - putMVar threadID ntid - return True - Just (Nothing) -> do - ntid <- Just <$> repeatedAction delay action - putMVar threadID ntid + repeatedTimerImmutable a d >>= putMVar mvmtim . Just return True - Nothing -> return False + _ -> return False {-# INLINEABLE repeatedRestart #-} -- | Executes the the given action once after the given delay elapsed, no sooner, maybe later. -oneShotTimer :: Delay -- ^ The (minimal) time until the execution in microseconds. - -> IO () -- ^ The action to be executed. - -> IO (TimerIO) -oneShotTimer d action = do - tid <- oneShotAction d action >>= newMVar . Just - return Timer { timerAction = action - , timerDelay = d - , timerThreadID = tid - } -{-# INLINEABLE oneShotTimer #-} +oneShotTimer :: IO () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) time until the execution in microseconds. + -> IO TimerIO +oneShotTimer a d = Timer <$> (oneShotTimerImmutable a d >>= newMVar . Just) +{-# INLINE oneShotTimer #-} -- | Executes the the given action repeatedly with at least the given delay between executions. -repeatedTimer :: Delay -- ^ The (minimal) delay between executions. - -> IO () -- ^ The action to be executed. - -> IO (TimerIO) -repeatedTimer d action = do - tid <- repeatedAction d action >>= newMVar . Just - return Timer { timerAction = action - , timerDelay = d - , timerThreadID = tid - } -{-# INLINEABLE repeatedTimer #-} +repeatedTimer :: IO () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) delay between executions. + -> IO TimerIO +repeatedTimer a d = Timer <$> (repeatedTimerImmutable a d >>= newMVar . Just) +{-# INLINE repeatedTimer #-} -- | This function is blocking. It waits until it can stop the timer --- (until there is a value in the threadID MVar), then it kill the thread. +-- (until there is a value in the MVar), then it kills the timer's thread. +-- +-- After this action completes, the Timer is not innitialized anymore (the MVar contains Nothing). stopTimer :: TimerIO -> IO () -stopTimer (Timer _ _ threadID) = modifyMVar_ threadID $ +stopTimer (Timer mvmtim) = modifyMVar_ mvmtim $ maybe (return Nothing) - (\tid -> killThread tid >> return Nothing) + (\(TimerImmutable _ _ tid) -> killThread tid >> return Nothing) +{-# INLINE stopTimer #-} -- | Creates a new timer. This does not start the timer. -newTimer :: Delay -- ^ The (minimal) delay between executions. - -> IO () -- ^ The action to be executed. - -> IO (TimerIO) -newTimer d action = Timer action d <$> newMVar Nothing +newTimer :: IO TimerIO +newTimer = Timer <$> newMVar Nothing {-# INLINE newTimer #-} ------------------------------------------------------------------------------ -- | Utility type TimerIO = Timer IO +type TimerImmutableIO = TimerImmutable IO -- | Forks a new thread that runs the supplied action +-- (at least) after the given delay and stores the action, +-- delay and thread id in the immutable TimerImmutable value. +oneShotTimerImmutable :: IO () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) time until the execution in microseconds. + -> IO TimerImmutableIO +oneShotTimerImmutable a d = TimerImmutable a d <$> oneShotAction a d +{-# INLINE oneShotTimerImmutable #-} + +-- | Forks a new thread that repeats the supplied action +-- with (at least) the given delay between each execution and stores the action, +-- delay and thread id in the immutable TimerImmutable value. +repeatedTimerImmutable :: IO () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) time until the execution in microseconds. + -> IO TimerImmutableIO +repeatedTimerImmutable a d = TimerImmutable a d <$> repeatedAction a d +{-# INLINE repeatedTimerImmutable #-} + +-- | Forks a new thread that runs the supplied action -- (at least) after the given delay. -oneShotAction :: Delay - -> IO () +oneShotAction :: IO () + -> Delay -> IO ThreadId -oneShotAction d action = fork (suspend d >> action) +oneShotAction action delay = fork (suspend delay >> action) {-# INLINE oneShotAction #-} -- | Forks a new thread that repeats the supplied action -- with (at least) the given delay between each execution. -repeatedAction :: Delay - -> IO () +repeatedAction :: IO () + -> Delay -> IO ThreadId -repeatedAction d action = fork (forever $ suspend d >> action) +repeatedAction action delay = fork (forever $ suspend delay >> action) {-# INLINE repeatedAction #-} fork :: IO () -> IO ThreadId diff --git a/src/Control/Concurrent/Timer/Lifted.hs b/src/Control/Concurrent/Timer/Lifted.hs --- a/src/Control/Concurrent/Timer/Lifted.hs +++ b/src/Control/Concurrent/Timer/Lifted.hs @@ -5,9 +5,11 @@ , TimerIO , oneShotTimer +, oneShotStart , oneShotRestart , repeatedTimer +, repeatedStart , repeatedRestart , newTimer @@ -23,94 +25,127 @@ import Control.Monad.Base (MonadBase) import Control.Monad.Trans.Control (MonadBaseControl) ------------------------------------------------------------------------------ -import Control.Concurrent.Timer.Types (Timer(..)) +import Control.Concurrent.Timer.Types (Timer(..), TimerImmutable(..)) ------------------------------------------------------------------------------ --- | Attempts to restart (or start) a timer making it a one shot timer. +-- | Attempts to start a timer. +-- The started timer will have the given delay and action associated and will be one-shot timer. -- --- Returns True if the restrat was successful, --- otherwise (e.g. other thread is attempting to restart the timer) returns False. -oneShotRestart :: MonadBaseControl IO m +-- If the timer was already initialized, it the previous timer will be stoped (the thread killed) and the timer will be started anew. +-- +-- Returns True if the strat was successful, +-- otherwise (e.g. other thread is attempting to manipulate the timer) returns False. +oneShotStart :: MonadBaseControl IO m => Timer m + -> m () -- ^ The action the timer will start with. + -> Delay -- ^ The dealy the timer will start with. -> m Bool -oneShotRestart (Timer action delay threadID) = do - mtid <- tryTakeMVar threadID - case mtid of - Just (Just tid) -> do +oneShotStart (Timer mvmtim) a d = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable _ _ tid)) -> do killThread tid - ntid <- Just <$> oneShotAction delay action - putMVar threadID ntid + oneShotTimerImmutable a d >>= putMVar mvmtim . Just return True - Just (Nothing) -> do - ntid <- Just <$> oneShotAction delay action - putMVar threadID ntid + Just (Nothing) -> do + oneShotTimerImmutable a d >>= putMVar mvmtim . Just return True Nothing -> return False -{-# INLINEABLE oneShotRestart #-} +{-# INLINEABLE oneShotStart #-} --- | Attempts to restart (or start) a timer making it a repeated timer. +-- | Attempts to start a timer. +-- The started timer will have the given delay and action associated and will be repeated timer. -- --- Returns True if the restrat was successful, --- otherwise (e.g. other thread is attempting to restart the timer) returns False. -repeatedRestart :: MonadBaseControl IO m +-- If the timer was already initialized, it the previous timer will be stoped (the thread killed) and the timer will be started anew. +-- +-- Returns True if the strat was successful, +-- otherwise (e.g. other thread is attempting to manipulate the timer) returns False. +repeatedStart :: MonadBaseControl IO m => Timer m + -> m () -- ^ The action the timer will start with. + -> Delay -- ^ The dealy the timer will start with. -> m Bool -repeatedRestart (Timer action delay threadID) = do - mtid <- tryTakeMVar threadID - case mtid of - Just (Just tid) -> do +repeatedStart (Timer mvmtim) a d = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable _ _ tid)) -> do killThread tid - ntid <- Just <$> repeatedAction delay action - putMVar threadID ntid + repeatedTimerImmutable a d >>= putMVar mvmtim . Just return True - Just (Nothing) -> do - ntid <- Just <$> repeatedAction delay action - putMVar threadID ntid + Just (Nothing) -> do + repeatedTimerImmutable a d >>= putMVar mvmtim . Just return True Nothing -> return False +{-# INLINEABLE repeatedStart #-} + +-- | Attempts to restart already initialized timer. +-- The restarted timer will have the same delay and action associated and will be one-shot timer. +-- +-- Returns True if the restrat was successful, +-- otherwise (e.g. other thread is attempting to manipulate the timer or the timer was not initialized) returns False. +oneShotRestart :: MonadBaseControl IO m + => Timer m + -> m Bool +oneShotRestart (Timer mvmtim) = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable a d tid)) -> do + killThread tid + oneShotTimerImmutable a d >>= putMVar mvmtim . Just + return True + _ -> return False +{-# INLINEABLE oneShotRestart #-} + +-- | Attempts to restart already initialized timer. +-- The restarted timer will have the same delay and action associated and will be one-shot timer. +-- +-- Returns True if the restrat was successful, +-- otherwise (e.g. other thread is attempting to manipulate the timer or the timer was not initialized) returns False. +repeatedRestart :: MonadBaseControl IO m + => Timer m + -> m Bool +repeatedRestart (Timer mvmtim) = do + mtim <- tryTakeMVar mvmtim + case mtim of + Just (Just (TimerImmutable a d tid)) -> do + killThread tid + repeatedTimerImmutable a d >>= putMVar mvmtim . Just + return True + _ -> return False {-# INLINEABLE repeatedRestart #-} -- | Executes the the given action once after the given delay elapsed, no sooner, maybe later. oneShotTimer :: MonadBaseControl IO m - => Delay -- ^ The (minimal) time until the execution in microseconds. - -> m () -- ^ The action to be executed. + => m () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) time until the execution in microseconds. -> m (Timer m) -oneShotTimer d action = do - tid <- oneShotAction d action >>= newMVar . Just - return Timer { timerAction = action - , timerDelay = d - , timerThreadID = tid - } -{-# INLINEABLE oneShotTimer #-} +oneShotTimer a d = Timer <$> (oneShotTimerImmutable a d >>= newMVar . Just) +{-# INLINE oneShotTimer #-} -- | Executes the the given action repeatedly with at least the given delay between executions. repeatedTimer :: MonadBaseControl IO m - => Delay -- ^ The (minimal) delay between executions. - -> m () -- ^ The action to be executed. + => m () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) delay between executions. -> m (Timer m) -repeatedTimer d action = do - tid <- repeatedAction d action >>= newMVar . Just - return Timer { timerAction = action - , timerDelay = d - , timerThreadID = tid - } -{-# INLINEABLE repeatedTimer #-} +repeatedTimer a d = Timer <$> (repeatedTimerImmutable a d >>= newMVar . Just) +{-# INLINE repeatedTimer #-} -- | This function is blocking. It waits until it can stop the timer --- (until there is a value in the threadID MVar), then it kill the thread. +-- (until there is a value in the MVar), then it kills the timer's thread. +-- +-- After this action completes, the Timer is not innitialized anymore (the MVar contains Nothing). stopTimer :: MonadBaseControl IO m => Timer m -> m () -stopTimer (Timer _ _ threadID) = modifyMVar_ threadID $ +stopTimer (Timer mvmtim) = modifyMVar_ mvmtim $ maybe (return Nothing) - (\tid -> killThread tid >> return Nothing) + (\(TimerImmutable _ _ tid) -> killThread tid >> return Nothing) +{-# INLINE stopTimer #-} -- | Creates a new timer. This does not start the timer. newTimer :: MonadBase IO m - => Delay -- ^ The (minimal) delay between executions. - -> m () -- ^ The action to be executed. - -> m (Timer m) -newTimer d action = Timer action d <$> newMVar Nothing + => m (Timer m) +newTimer = Timer <$> newMVar Nothing {-# INLINE newTimer #-} ------------------------------------------------------------------------------ @@ -119,19 +154,39 @@ type TimerIO = Timer IO -- | Forks a new thread that runs the supplied action +-- (at least) after the given delay and stores the action, +-- delay and thread id in the immutable TimerImmutable value. +oneShotTimerImmutable :: MonadBaseControl IO m + => m () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) time until the execution in microseconds. + -> m (TimerImmutable m) +oneShotTimerImmutable a d = TimerImmutable a d <$> oneShotAction a d +{-# INLINE oneShotTimerImmutable #-} + +-- | Forks a new thread that repeats the supplied action +-- with (at least) the given delay between each execution and stores the action, +-- delay and thread id in the immutable TimerImmutable value. +repeatedTimerImmutable :: MonadBaseControl IO m + => m () -- ^ The action to be executed. + -> Delay -- ^ The (minimal) time until the execution in microseconds. + -> m (TimerImmutable m) +repeatedTimerImmutable a d = TimerImmutable a d <$> repeatedAction a d +{-# INLINE repeatedTimerImmutable #-} + +-- | Forks a new thread that runs the supplied action -- (at least) after the given delay. oneShotAction :: MonadBaseControl IO m - => Delay - -> m () + => m () + -> Delay -> m ThreadId -oneShotAction d action = fork (suspend d >> action) +oneShotAction action delay = fork (suspend delay >> action) {-# INLINE oneShotAction #-} -- | Forks a new thread that repeats the supplied action -- with (at least) the given delay between each execution. repeatedAction :: MonadBaseControl IO m - => Delay - -> m () + => m () + -> Delay -> m ThreadId -repeatedAction d action = fork (forever $ suspend d >> action) +repeatedAction action delay = fork (forever $ suspend delay >> action) {-# INLINE repeatedAction #-} diff --git a/src/Control/Concurrent/Timer/Types.hs b/src/Control/Concurrent/Timer/Types.hs --- a/src/Control/Concurrent/Timer/Types.hs +++ b/src/Control/Concurrent/Timer/Types.hs @@ -1,5 +1,6 @@ module Control.Concurrent.Timer.Types ( Timer(..) +, TimerImmutable(..) ) where ------------------------------------------------------------------------------ @@ -12,7 +13,11 @@ -- | The data type representing the timer. -- For now, the action and delay are fixed for the lifetime of the Timer. data Timer m = Timer + { timerImmutable :: MVar (Maybe (TimerImmutable m)) -- ^ If the MVar is empty, someone if mutating the timer. If the MVar contains Nothing, the timer was not started/initialized. + } + +data TimerImmutable m = TimerImmutable { timerAction :: m () , timerDelay :: Delay - , timerThreadID :: MVar (Maybe ThreadId) + , timerThreadID :: ThreadId } diff --git a/timers.cabal b/timers.cabal --- a/timers.cabal +++ b/timers.cabal @@ -1,5 +1,5 @@ name: timers -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Simple package that implements timers. description: Simple package that implements timers. Both "one-shot" and "repeating" timers are implemented. license: BSD3