timers (empty) → 0.1.0.0
raw patch · 6 files changed
+334/−0 lines, 6 filesdep +basedep +lifted-basedep +monad-controlsetup-changed
Dependencies added: base, lifted-base, monad-control, suspend, transformers-base
Files
- LICENSE +30/−0
- README.md +0/−0
- Setup.hs +2/−0
- src/Control/Concurrent/Timer.hs +129/−0
- src/Control/Concurrent/Timer/Lifted.hs +137/−0
- timers.cabal +36/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Petr Pilař++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Petr Pilař nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Control/Concurrent/Timer.hs view
@@ -0,0 +1,129 @@+module Control.Concurrent.Timer+( Timer+, TimerIO++, oneShotTimer+, oneShotRestart++, repeatedTimer+, repeatedRestart++, newTimer+, stopTimer+) where++------------------------------------------------------------------------------+import Control.Applicative+import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Concurrent.MVar (newMVar, tryTakeMVar, putMVar, modifyMVar_)+import Control.Concurrent.Suspend (Delay, suspend)+import Control.Monad+------------------------------------------------------------------------------+import Control.Concurrent.Timer.Types (Timer(..))+------------------------------------------------------------------------------++-- | Attempts to restart (or start) a timer making it a one shot timer.+--+-- Returns True if the restrat was successful,+-- otherwise (e.g. other thread is attempting to restart the timer) returns False.+oneShotRestart :: TimerIO+ -> IO Bool+oneShotRestart (Timer action delay threadID) = do+ mtid <- tryTakeMVar threadID+ case mtid of+ Just (Just 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+ return True+ Nothing -> return False+{-# INLINEABLE oneShotRestart #-}++-- | Attempts to restart (or start) a timer making it a repeated timer.+--+-- Returns True if the restrat was successful,+-- otherwise (e.g. other thread is attempting to restart the timer) returns False.+repeatedRestart :: TimerIO+ -> IO Bool+repeatedRestart (Timer action delay threadID) = do+ mtid <- tryTakeMVar threadID+ case mtid of+ Just (Just 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+ return True+ Nothing -> 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 #-}++-- | 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 #-}++-- | 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.+stopTimer :: TimerIO+ -> IO ()+stopTimer (Timer _ _ threadID) = modifyMVar_ threadID $+ maybe (return Nothing)+ (\tid -> killThread tid >> return Nothing)++-- | 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+{-# INLINE newTimer #-}++------------------------------------------------------------------------------+-- | Utility++type TimerIO = Timer IO++-- | Forks a new thread that runs the supplied action+-- (at least) after the given delay.+oneShotAction :: Delay+ -> IO ()+ -> IO ThreadId+oneShotAction d action = fork (suspend d >> action)+{-# INLINE oneShotAction #-}++-- | Forks a new thread that repeats the supplied action+-- with (at least) the given delay between each execution.+repeatedAction :: Delay+ -> IO ()+ -> IO ThreadId+repeatedAction d action = fork (forever $ suspend d >> action)+{-# INLINE repeatedAction #-}++fork :: IO () -> IO ThreadId+fork = forkIO+{-# INLINE fork #-}
+ src/Control/Concurrent/Timer/Lifted.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE FlexibleContexts #-}++module Control.Concurrent.Timer.Lifted+( Timer+, TimerIO++, oneShotTimer+, oneShotRestart++, repeatedTimer+, repeatedRestart++, newTimer+, stopTimer+) where++------------------------------------------------------------------------------+import Control.Applicative+import Control.Concurrent.Lifted (ThreadId, fork, killThread)+import Control.Concurrent.MVar.Lifted (newMVar, tryTakeMVar, putMVar, modifyMVar_)+import Control.Concurrent.Suspend.Lifted (Delay, suspend)+import Control.Monad+import Control.Monad.Base (MonadBase)+import Control.Monad.Trans.Control (MonadBaseControl)+------------------------------------------------------------------------------+import Control.Concurrent.Timer.Types (Timer(..))+------------------------------------------------------------------------------++-- | Attempts to restart (or start) a timer making it a 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+ => Timer m+ -> m Bool+oneShotRestart (Timer action delay threadID) = do+ mtid <- tryTakeMVar threadID+ case mtid of+ Just (Just 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+ return True+ Nothing -> return False+{-# INLINEABLE oneShotRestart #-}++-- | Attempts to restart (or start) a timer making it a 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+ => Timer m+ -> m Bool+repeatedRestart (Timer action delay threadID) = do+ mtid <- tryTakeMVar threadID+ case mtid of+ Just (Just 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+ return True+ Nothing -> 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 (Timer m)+oneShotTimer d action = do+ tid <- oneShotAction d action >>= newMVar . Just+ return Timer { timerAction = action+ , timerDelay = d+ , timerThreadID = tid+ }+{-# INLINEABLE 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 (Timer m)+repeatedTimer d action = do+ tid <- repeatedAction d action >>= newMVar . Just+ return Timer { timerAction = action+ , timerDelay = d+ , timerThreadID = tid+ }+{-# INLINEABLE 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.+stopTimer :: MonadBaseControl IO m+ => Timer m+ -> m ()+stopTimer (Timer _ _ threadID) = modifyMVar_ threadID $+ maybe (return Nothing)+ (\tid -> killThread tid >> return Nothing)++-- | 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+{-# INLINE newTimer #-}++------------------------------------------------------------------------------+-- | Utility++type TimerIO = Timer IO++-- | Forks a new thread that runs the supplied action+-- (at least) after the given delay.+oneShotAction :: MonadBaseControl IO m+ => Delay+ -> m ()+ -> m ThreadId+oneShotAction d action = fork (suspend d >> 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 ThreadId+repeatedAction d action = fork (forever $ suspend d >> action)+{-# INLINE repeatedAction #-}
+ timers.cabal view
@@ -0,0 +1,36 @@+name: timers+version: 0.1.0.0+synopsis: Simple package that implements timers.+description: Simple package that implements timers. Both "one-shot" and "repeating" timers are implemented.+license: BSD3+license-file: LICENSE+author: Petr Pilař+maintainer: Petr Pilař <maintainer+the.palmik@gmail.com>+copyright: Petr Pilař 2012+category: Concurrency+stability: Experimental+build-type: Simple+cabal-version: >=1.8++extra-source-files:+ LICENSE+ , README.md++library+ exposed-modules:+ Control.Concurrent.Timer+ , Control.Concurrent.Timer.Lifted++ build-depends:+ base == 4.5.*+ , lifted-base == 0.1.*+ , monad-control == 0.3.*+ , transformers-base == 0.4.*+ , suspend == 0.1.*++ hs-source-dirs: src+ ghc-options: -Wall -fwarn-unused-imports++source-repository head+ type: git+ location: git://github.com/Palmik/timers.git