diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
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.cabal b/monad-loops.cabal
new file mode 100644
--- /dev/null
+++ b/monad-loops.cabal
@@ -0,0 +1,37 @@
+name:                   monad-loops
+version:                0.3
+stability:              provisional
+license:                BSD3
+license-file:           LICENSE
+
+cabal-version:          >= 1.2
+build-type:             Simple
+
+author:                 James Cook <mokus@deepbondi.net>
+maintainer:             James Cook <mokus@deepbondi.net>
+
+category:               Control
+synopsis:               Monadic loops
+description:            Some useful control operators for looping
+
+Flag useSTM
+  Description:          Include instances for STM types
+  Default:              True
+
+Flag base4
+  Description:          Build using base >= 4
+  Default:              True
+
+Library
+  hs-source-dirs:       src
+  exposed-modules:      Control.Monad.Loops
+  if flag(base4)
+    cpp-options:        -Dbase4
+    build-depends:      base >= 4
+  else
+    build-depends:      base < 4
+
+  if flag(useSTM)
+    build-depends:      stm
+    other-modules:      Control.Monad.Loops.STM
+    cpp-options:        -DuseSTM
diff --git a/src/Control/Monad/Loops.hs b/src/Control/Monad/Loops.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Loops.hs
@@ -0,0 +1,340 @@
+{-
+ -      ``Control/Monad/Loops''
+ -}
+{-# LANGUAGE
+        CPP
+  #-}
+
+-- |A collection of loop operators for use in monads (mostly in stateful ones).
+-- 
+-- There is a general naming pattern for many of these:
+-- Functions with names ending in _ discard the results of the loop body
+-- as in the standard Prelude 'mapM' functions.
+-- 
+-- Functions with names ending in ' collect their results into 'MonadPlus'
+-- containers.  Note that any short-circuit effect that those types' 
+-- 'MonadPlus' instances may provide in a lazy context (such as the instance
+-- for 'Maybe') will _not_ cause execution to short-circuit in these loops.
+--
+-- Functions with names ending in neither of those will generally return
+-- just plain old lists.
+
+module Control.Monad.Loops
+        ( module Control.Monad.Loops
+#ifdef useSTM
+        , module Control.Monad.Loops.STM
+#endif
+        ) where
+
+import Control.Monad
+
+import Control.Exception
+import Control.Concurrent
+
+#ifndef base4
+#define SomeException Exception
+#endif
+
+#ifdef useSTM
+import Control.Monad.Loops.STM
+#endif
+
+-- possibly-useful addition? :
+-- concatMapM :: (Monad m, Traversable f, Monoid w) => (a -> m w) -> (f a) -> m w
+
+-- would also like to implement an "interleavable" version of forkMapM (probably
+-- using something other than a list in the return) that can effectively handle
+-- very large or even infinite input lists.
+
+-- |Like 'mapM', but run all the actions in parallel threads, collecting up
+-- the results and returning them all.  Does not return until all actions finish.
+forkMapM :: (a -> IO b) -> [a] -> IO [Either SomeException b]
+forkMapM f xs = do
+        mvars <- forM xs $ \x -> do
+                mvar <- newEmptyMVar
+                forkIO $ do
+                        result <- handle (return . Left) $ do
+                                y <- f x
+                                return (Right y)
+                        putMVar mvar result
+                return mvar
+        
+        mapM takeMVar mvars
+
+-- | like 'forkMapM' but without bothering to keep the return values
+forkMapM_ :: (a -> IO b) -> [a] -> IO [Maybe SomeException]
+forkMapM_ f xs = do
+        mvars <- forM xs $ \x -> do
+                mvar <- newEmptyMVar
+                forkIO $ do
+                        -- in base >=4, need to nail down the type of 'handle'
+                        let handleAny :: (SomeException -> IO a) -> IO a -> IO a
+                            handleAny = handle
+                        result <- handleAny (return . Just) $ do
+                                f x
+                                return Nothing
+                        putMVar mvar result
+                return mvar
+        
+        mapM takeMVar mvars
+
+-- | like 'forkMapM_' but not even bothering to track success or failure
+-- of the child threads.  Still waits for them all though.
+forkMapM__ :: (a -> IO b) -> [a] -> IO ()
+forkMapM__ f xs = do
+        mvars <- forM xs $ \x -> do
+                mvar <- newEmptyMVar
+                forkIO $ do
+                        -- in base >=4, need to nail down the type of 'handle'
+                        let handleAny :: (SomeException -> IO a) -> IO a -> IO a
+                            handleAny = handle
+                        handleAny (\e -> return ()) $ do
+                                f x
+                                return ()
+                        putMVar mvar ()
+                return mvar
+        
+        mapM_ takeMVar mvars
+
+{-# SPECIALIZE whileM  :: IO Bool -> IO a -> IO [a] #-}
+{-# SPECIALIZE whileM' :: Monad m => m Bool -> m a -> m [a] #-}
+{-# SPECIALIZE whileM' :: IO Bool -> IO a -> IO [a] #-}
+{-# SPECIALIZE whileM_ :: IO Bool -> IO a -> IO () #-}
+
+-- |Execute an action repeatedly as long as the given boolean expression
+-- returns True.  The condition is evaluated before the loop body.
+-- Collects the results into a list.
+whileM :: Monad m => m Bool -> m a -> m [a]
+whileM = whileM'
+
+-- |Execute an action repeatedly as long as the given boolean expression
+-- returns True. The condition is evaluated before the loop body.
+-- Collects the results into an arbitrary 'MonadPlus' value.
+whileM' :: (Monad m, MonadPlus f) => m Bool -> m a -> m (f a)
+whileM' p f = do
+        x <- p
+        if x
+                then do
+                        x  <- f
+                        xs <- whileM' p f
+                        return (return x `mplus` xs)
+                else return mzero
+
+-- |Execute an action repeatedly as long as the given boolean expression
+-- returns True.  The condition is evaluated before the loop body.
+-- Discards results.
+whileM_ :: (Monad m) => m Bool -> m a -> m ()
+whileM_ p f = do
+        x <- p
+        if x
+                then do
+                        f
+                        whileM_ p f
+                else return ()
+
+{-# SPECIALIZE untilM  :: IO a -> IO Bool -> IO [a] #-}
+{-# SPECIALIZE untilM' :: Monad m => m a -> m Bool -> m [a] #-}
+{-# SPECIALIZE untilM' :: IO a -> IO Bool -> IO [a] #-}
+{-# SPECIALIZE untilM_ :: IO a -> IO Bool -> IO () #-}
+
+infixr 0 `untilM`
+infixr 0 `untilM'`
+infixr 0 `untilM_`
+
+-- |Execute an action repeatedly until the condition expression returns True.
+-- The condition is evaluated after the loop body.  Collects results into a list.
+-- Parameters are arranged for infix usage.  eg. do {...} `untilM_` ...
+untilM :: Monad m => m a -> m Bool -> m [a]
+untilM = untilM'
+
+-- |Execute an action repeatedly until the condition expression returns True.
+-- The condition is evaluated after the loop body.  Collects results into a
+-- "MonadPlus" value.
+-- Parameters are arranged for infix usage.  eg. do {...} `untilM_` ...
+untilM' :: (Monad m, MonadPlus f) => m a -> m Bool -> m (f a)
+f `untilM'` p = do
+        x  <- f
+        xs <- whileM' (liftM not p) f
+        return (return x `mplus` xs)
+
+-- |Execute an action repeatedly until the condition expression returns True.
+-- The condition is evaluated after the loop body.  Discards results.
+-- Parameters are arranged for infix usage.  eg. do {...} `untilM_` ...
+untilM_ :: (Monad m) => m a -> m Bool -> m ()
+f `untilM_` p = f >> whileM_ (liftM not p) f
+
+{-# SPECIALIZE whileJust  :: IO (Maybe a) -> (a -> IO b) -> IO [b] #-}
+{-# SPECIALIZE whileJust' :: Monad m => m (Maybe a) -> (a -> m b) -> m [b] #-}
+{-# SPECIALIZE whileJust' :: IO (Maybe a) -> (a -> IO b) -> IO [b] #-}
+{-# SPECIALIZE whileJust_ :: IO (Maybe a) -> (a -> IO b) -> IO () #-}
+
+-- |As long as the supplied "Maybe" expression returns "Just _", the loop
+-- body will be called and passed the value contained in the 'Just'.  Results
+-- are collected into a list.
+whileJust :: Monad m => m (Maybe a) -> (a -> m b) -> m [b]
+whileJust = whileJust'
+
+-- |As long as the supplied "Maybe" expression returns "Just _", the loop
+-- body will be called and passed the value contained in the 'Just'.  Results
+-- are collected into an arbitrary MonadPlus container.
+whileJust' :: (Monad m, MonadPlus f) => m (Maybe a) -> (a -> m b) -> m (f b)
+whileJust' p f = do
+        x <- p
+        case x of
+                Nothing -> return mzero
+                Just x  -> do
+                        x  <- f x
+                        xs <- whileJust' p f
+                        return (return x `mplus` xs)
+
+-- |As long as the supplied "Maybe" expression returns "Just _", the loop
+-- body will be called and passed the value contained in the 'Just'.  Results
+-- are discarded.
+whileJust_ :: (Monad m) => m (Maybe a) -> (a -> m b) -> m ()
+whileJust_ p f = do
+        x <- p
+        case x of
+                Nothing -> return ()
+                Just x  -> do
+                        f x
+                        whileJust_ p f
+
+{-# SPECIALIZE unfoldM  :: IO (Maybe a) -> IO [a] #-}
+{-# SPECIALIZE unfoldM' :: (Monad m) => m (Maybe a) -> m [a] #-}
+{-# SPECIALIZE unfoldM' :: IO (Maybe a) -> IO [a] #-}
+{-# SPECIALIZE unfoldM_ :: IO (Maybe a) -> IO () #-}
+
+-- |The supplied "Maybe" expression will be repeatedly called until it
+-- returns 'Nothing'.  All values returned are collected into a list.
+unfoldM :: (Monad m) => m (Maybe a) -> m [a]
+unfoldM = unfoldM'
+
+-- |The supplied "Maybe" expression will be repeatedly called until it
+-- returns 'Nothing'.  All values returned are collected into an arbitrary
+-- 'MonadPlus' thing.
+unfoldM' :: (Monad m, MonadPlus f) => m (Maybe a) -> m (f a)
+unfoldM' m = whileJust' m return
+
+-- |The supplied "Maybe" expression will be repeatedly called until it
+-- returns 'Nothing'.  All values returned are discarded.
+unfoldM_ :: (Monad m) => m (Maybe a) -> m ()
+unfoldM_ m = whileJust_ m return
+
+{-# SPECIALIZE unfoldrM  :: (a -> IO (Maybe (b,a))) -> a -> IO [b] #-}
+{-# SPECIALIZE unfoldrM' :: (Monad m) => (a -> m (Maybe (b,a))) -> a -> m [b] #-}
+{-# SPECIALIZE unfoldrM' :: (a -> IO (Maybe (b,a))) -> a -> IO [b] #-}
+
+-- |See 'Data.List.unfoldr'.  This is a monad-friendly version of that.
+unfoldrM :: (Monad m) => (a -> m (Maybe (b,a))) -> a -> m [b]
+unfoldrM = unfoldrM'
+
+-- |See 'Data.List.unfoldr'.  This is a monad-friendly version of that, with a
+-- twist.  Rather than returning a list, it returns any MonadPlus type of your
+-- choice.
+unfoldrM' :: (Monad m, MonadPlus f) => (a -> m (Maybe (b,a))) -> a -> m (f b)
+unfoldrM' f z = do
+        x <- f z
+        case x of
+                Nothing         -> return mzero
+                Just (x, z)     -> do
+                        xs <- unfoldrM' f z
+                        return (return x `mplus` xs)
+
+{-# SPECIALIZE concatM :: [a -> IO a] -> (a -> IO a) #-}
+
+-- |Compose a list of monadic actions into one action.  Composes using
+-- ('>=>') - that is, the output of each action is fed to the input of
+-- the one after it in the list.
+concatM :: (Monad m) => [a -> m a] -> (a -> m a)
+concatM fs = foldr (>=>) return fs
+
+{-# SPECIALIZE andM :: [IO Bool] -> IO Bool #-}
+{-# SPECIALIZE orM  :: [IO Bool] -> IO Bool #-}
+
+-- |short-circuit 'and' for values of type Monad m => m Bool
+andM :: (Monad m) => [m Bool] -> m Bool
+andM []         = return True
+andM (p:ps)     = do
+        q <- p
+        if q
+                then andM ps
+                else return False
+
+-- |short-circuit 'or' for values of type Monad m => m Bool
+orM :: (Monad m) => [m Bool] -> m Bool
+orM []          = return False
+orM (p:ps)      = do
+        q <- p
+        if q
+                then return True
+                else orM ps
+
+{-# SPECIALIZE anyPM :: [a -> IO Bool] -> (a -> IO Bool) #-}
+{-# SPECIALIZE allPM :: [a -> IO Bool] -> (a -> IO Bool) #-}
+
+-- |short-circuit 'any' with a list of \"monadic predicates\".  Tests the
+-- value presented against each predicate in turn until one passes, then
+-- returns True without any further processing.  If none passes, returns False.
+anyPM :: (Monad m) => [a -> m Bool] -> (a -> m Bool)
+anyPM []     x = return False
+anyPM (p:ps) x = do
+        q <- p x
+        if q
+                then return True
+                else anyPM ps x
+
+-- |short-circuit 'all' with a list of \"monadic predicates\".  Tests the value
+-- presented against each predicate in turn until one fails, then returns False.
+-- if none fail, returns True.
+allPM :: (Monad m) => [a -> m Bool] -> (a -> m Bool)
+allPM []     x = return True
+allPM (p:ps) x = do
+        q <- p x
+        if q
+                then allPM ps x
+                else return False
+
+{-# SPECIALIZE anyM :: (a -> IO Bool) -> [a] -> IO Bool #-}
+{-# SPECIALIZE allM :: (a -> IO Bool) -> [a] -> IO Bool #-}
+
+-- |short-circuit 'any' with a \"monadic predicate\".
+anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+anyM p []       = return False
+anyM p (x:xs)   = do
+        q <- p x
+        if q
+                then return True
+                else anyM p xs
+
+-- |short-circuit 'all' with a \"monadic predicate\".
+allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+allM p []       = return True
+allM p (x:xs)   = do
+        q <- p x
+        if q
+                then allM p xs
+                else return False
+
+dropWhileM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+dropWhileM p []     = return []
+dropWhileM p (x:xs) = do
+        q <- p x
+        if q
+                then dropWhileM p xs
+                else return xs
+
+-- |like 'dropWhileM' but trims both ends of the list.
+trimM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+trimM p xs = do
+        xs <- dropWhileM p xs
+        rxs <- dropWhileM p (reverse xs)
+        return (reverse rxs)
+
+-- |return the first value from a list, if any, satisfying the given predicate.
+firstM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+firstM p [] = return Nothing
+firstM p (x:xs) = do
+        q <- p x
+        if q
+                then return (Just x)
+                else firstM p xs
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,39 @@
+{-
+ -      ``Control/Monad/Loops/STM''
+ -      (c) 2008 Cook, J. MR  SSD, Inc.
+ -}
+
+module Control.Monad.Loops.STM where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+
+import Control.Monad (forever) -- for the benefit of haddock
+
+-- |'Control.Monad.forever' and 'Control.Concurrent.STM.atomically' rolled
+-- into one.
+atomLoop :: STM a -> IO ()
+atomLoop x = atomically x >> atomLoop x
+
+-- |'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 ()
+
+-- |'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)