diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,5 @@
+#!/usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
+
diff --git a/monad-loops-stm.cabal b/monad-loops-stm.cabal
new file mode 100644
--- /dev/null
+++ b/monad-loops-stm.cabal
@@ -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
diff --git a/src/Control/Monad/Loops/STM.hs b/src/Control/Monad/Loops/STM.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Loops/STM.hs
@@ -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)