timers 0.1.0.1 → 0.2.0.0
raw patch · 4 files changed
+233/−121 lines, 4 files
Files
- src/Control/Concurrent/Timer.hs +112/−60
- src/Control/Concurrent/Timer/Lifted.hs +114/−59
- src/Control/Concurrent/Timer/Types.hs +6/−1
- timers.cabal +1/−1
src/Control/Concurrent/Timer.hs view
@@ -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
src/Control/Concurrent/Timer/Lifted.hs view
@@ -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 #-}
src/Control/Concurrent/Timer/Types.hs view
@@ -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 }
timers.cabal view
@@ -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