monad-loops-stm (empty) → 0.4

raw patch · 3 files changed

+70/−0 lines, 3 filesdep +basedep +stmsetup-changed

Dependencies added: base, stm

Files

• Setup.lhs +5/−0
• monad-loops-stm.cabal +24/−0
• src/Control/Monad/Loops/STM.hs +41/−0

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain+

@@ -0,0 +1,24 @@+name:                   monad-loops-stm+version:                0.4+stability:              provisional+license:                PublicDomain++cabal-version:          >= 1.6+build-type:             Simple++author:                 James Cook <mokus@deepbondi.net>+maintainer:             James Cook <mokus@deepbondi.net>+homepage:               https://github.com/mokus0/monad-loops-stm++category:               Control+synopsis:               Monadic loops for STM+description:            Some useful control operators for looping.++source-repository head+  type: git+  location: git://github.com/mokus0/monad-loops-stm.git++Library+  hs-source-dirs:       src+  exposed-modules:      Control.Monad.Loops.STM+  build-depends:        base >= 2 && < 5, stm

@@ -0,0 +1,41 @@+module Control.Monad.Loops.STM where++import Control.Concurrent+import Control.Concurrent.STM++import Control.Monad (forever) -- for the benefit of haddock+import Data.Maybe++-- |'Control.Monad.forever' and 'Control.Concurrent.STM.atomically' rolled+-- into one.+atomLoop :: STM a -> IO ()+atomLoop x = go+    where go = atomically x >> go++-- |'atomLoop' with a 'forkIO'+forkAtomLoop :: STM a -> IO ThreadId+forkAtomLoop = forkIO . atomLoop++-- |'Control.Concurrent.STM.retry' until the given condition is true of+-- the given value.  Then return the value that satisfied the condition.+waitFor :: (a -> Bool) -> STM a -> STM a+waitFor p events = do+        event <- events+        if p event+                then return event+                else retry++-- |'Control.Concurrent.STM.retry' until the given value is True.+waitForTrue :: STM Bool -> STM ()+waitForTrue p = waitFor id p >> return ()++-- |'Control.Concurrent.STM.retry' until the given value is 'Just' _, returning+-- the contained value.+waitForJust :: STM (Maybe a) -> STM a+waitForJust m = fmap fromJust (waitFor isJust m)++-- |'waitFor' a value satisfying a condition to come out of a+-- 'Control.Concurrent.STM.TChan', reading and discarding everything else.+-- Returns the winner.+waitForEvent :: (a -> Bool) -> TChan a -> STM a+waitForEvent p events = waitFor p (readTChan events)