diff --git a/Control/Monad/Trans/Loop.hs b/Control/Monad/Trans/Loop.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Trans/Loop.hs
@@ -0,0 +1,189 @@
+-- |
+-- Module       : Control.Monad.Trans.Loop
+-- Copyright    : (c) Joseph Adams 2012
+-- License      : BSD3
+-- Maintainer   : joeyadams3.14159@gmail.com
+--
+
+{-# LANGUAGE Rank2Types #-}
+
+-- Needed for the MonadBase instance
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Control.Monad.Trans.Loop (
+    -- * The LoopT monad transformer
+    LoopT(..),
+    stepLoopT,
+
+    -- * continue and exit
+    continue,
+    exit,
+    continueWith,
+    exitWith,
+
+    -- * Looping constructs
+    foreach,
+    while,
+    doWhile,
+    once,
+    repeatLoopT,
+    iterateLoopT,
+
+    -- * Lifting other operations
+    liftLocalLoopT,
+) where
+
+import Control.Applicative          (Applicative(pure, (<*>)))
+import Control.Monad.Base           (MonadBase(liftBase), liftBaseDefault)
+import Control.Monad.IO.Class       (MonadIO(liftIO))
+import Control.Monad.Trans.Class    (MonadTrans(lift))
+
+-- | 'LoopT' is a monad transformer for the loop body.  It provides two
+-- capabilities:
+--
+--  * 'continue' to the next iteration.
+--
+--  * 'exit' the whole loop.
+newtype LoopT c e m a = LoopT
+    { runLoopT :: forall r.     -- This universal quantification forces the
+                                -- LoopT computation to call one of the
+                                -- following continuations.
+                  (c -> m r)    -- continue
+               -> (e -> m r)    -- exit
+               -> (a -> m r)    -- return a value
+               -> m r
+    }
+
+instance Functor (LoopT c e m) where
+    fmap f m = LoopT $ \next fin cont -> runLoopT m next fin (cont . f)
+
+instance Applicative (LoopT c e m) where
+    pure a    = LoopT $ \_    _   cont -> cont a
+    f1 <*> f2 = LoopT $ \next fin cont ->
+                runLoopT f1 next fin $ \f ->
+                runLoopT f2 next fin (cont . f)
+
+instance Monad (LoopT c e m) where
+    return a = LoopT $ \_    _   cont -> cont a
+    m >>= k  = LoopT $ \next fin cont ->
+               runLoopT m next fin $ \a ->
+               runLoopT (k a) next fin cont
+
+instance MonadTrans (LoopT c e) where
+    lift m = LoopT $ \_ _ cont -> m >>= cont
+
+instance MonadIO m => MonadIO (LoopT c e m) where
+    liftIO = lift . liftIO
+
+instance MonadBase b m => MonadBase b (LoopT c e m) where
+    liftBase = liftBaseDefault
+
+-- | Call a loop body, passing it a continuation for the next iteration.
+-- This can be used to construct custom looping constructs.  For example,
+-- here is the definition of 'foreach':
+--
+-- >foreach list body = loop list
+-- >  where loop []     = return ()
+-- >        loop (x:xs) = stepLoopT (body x) (\_ -> loop xs)
+stepLoopT :: Monad m => LoopT c e m c -> (c -> m e) -> m e
+stepLoopT body next = runLoopT body next return next
+
+------------------------------------------------------------------------
+-- continue and exit
+
+
+-- | Skip the rest of the loop body and go to the next iteration.
+continue :: LoopT () e m a
+continue = continueWith ()
+
+-- | Break out of the loop entirely.
+exit :: LoopT c () m a
+exit = exitWith ()
+
+-- | Like 'continue', but return a value from the loop body.
+continueWith :: c -> LoopT c e m a
+continueWith c = LoopT $ \next _ _ -> next c
+
+-- | Like 'exit', but return a value from the loop as a whole.
+-- See the documentation of 'iterateLoopT' for an example.
+exitWith :: e -> LoopT c e m a
+exitWith e = LoopT $ \_ fin _ -> fin e
+
+
+------------------------------------------------------------------------
+-- Looping constructs
+
+
+-- | Call the loop body with each item in the list.
+--
+-- If you do not need to 'continue' or 'exit' the loop, consider using
+-- 'Control.Monad.forM_' instead.
+foreach :: Monad m => [a] -> (a -> LoopT c () m c) -> m ()
+foreach list body = loop list
+  where loop []     = return ()
+        loop (x:xs) = stepLoopT (body x) (\_ -> loop xs)
+
+-- | Repeat the loop body while the predicate holds.  Like a @while@ loop in C,
+-- the condition is tested first.
+while :: Monad m => m Bool -> LoopT c () m c -> m ()
+while cond body = loop
+  where loop = do b <- cond
+                  if b then stepLoopT body (\_ -> loop)
+                       else return ()
+
+-- | Like a @do while@ loop in C, where the condition is tested after
+-- the loop body.
+--
+-- 'doWhile' returns the result of the last iteration.  This is possible
+-- because, unlike 'foreach' and 'while', the loop body is guaranteed to be
+-- executed at least once.
+doWhile :: Monad m => LoopT a a m a -> m Bool -> m a
+doWhile body cond = loop
+  where loop = stepLoopT body $ \a -> do
+            b <- cond
+            if b then loop
+                 else return a
+
+-- | Execute the loop body once.  This is a convenient way to introduce early
+-- exit support to a block of code.
+--
+-- 'continue' and 'exit' do the same thing inside of 'once'.
+once :: Monad m => LoopT a a m a -> m a
+once body = runLoopT body return return return
+
+-- | Execute the loop body again and again.  The only way to exit 'repeatLoopT'
+-- is to call 'exit' or 'exitWith'.
+repeatLoopT :: Monad m => LoopT c e m a -> m e
+repeatLoopT body = loop
+  where loop = runLoopT body (\_ -> loop) return (\_ -> loop)
+
+-- | Call the loop body again and again, passing it the result of the previous
+-- iteration each time around.  The only way to exit 'iterateLoopT' is to call
+-- 'exit' or 'exitWith'.
+--
+-- Example:
+--
+-- >count :: Int -> IO Int
+-- >count n = iterateLoopT 0 $ \i ->
+-- >    if i < n
+-- >        then do
+-- >            lift $ print i
+-- >            return $ i+1
+-- >        else exitWith i
+iterateLoopT :: Monad m => c -> (c -> LoopT c e m c) -> m e
+iterateLoopT z body = loop z
+  where loop c = stepLoopT (body c) loop
+
+
+------------------------------------------------------------------------
+-- Lifting other operations
+
+
+-- | Lift a function like 'Control.Monad.Trans.Reader.local' or
+-- 'Control.Exception.mask_'.
+liftLocalLoopT :: Monad m => (forall a. m a -> m a) -> LoopT c e m b -> LoopT c e m b
+liftLocalLoopT f cb = LoopT $ \next fin cont -> do
+    m <- f $ runLoopT cb (return . next) (return . fin) (return . cont)
+    m
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, Joseph Adams
+
+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 Joseph Adams 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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/control-monad-loop.cabal b/control-monad-loop.cabal
new file mode 100644
--- /dev/null
+++ b/control-monad-loop.cabal
@@ -0,0 +1,36 @@
+name:               control-monad-loop
+version:            0.1
+synopsis:           Simple monad transformer for imperative-style loops
+description:
+    A library of looping constructs with @continue@ and @exit@ control flow
+    statements.
+homepage:           https://github.com/joeyadams/haskell-control-monad-loop
+bug-reports:        https://github.com/joeyadams/haskell-control-monad-loop/issues
+license:            BSD3
+license-file:       LICENSE
+author:             Joey Adams
+maintainer:         joeyadams3.14159@gmail.com
+copyright:          Copyright (c) Joseph Adams 2012
+category:           Control
+build-type:         Simple
+cabal-version:      >=1.8
+
+extra-source-files:
+    test/leak.hs
+    test/liftLocal.hs
+    test/lift-continue.hs
+    test/recycled-numbers.hs
+
+source-repository head
+    type:       git
+    location:   git://github.com/joeyadams/haskell-control-monad-loop
+
+library
+    exposed-modules:
+        Control.Monad.Trans.Loop
+
+    build-depends   : base >= 4 && < 5
+                    , transformers
+                    , transformers-base
+
+    ghc-options: -Wall -fwarn-tabs
diff --git a/test/leak.hs b/test/leak.hs
new file mode 100644
--- /dev/null
+++ b/test/leak.hs
@@ -0,0 +1,28 @@
+-- Make sure basic loops don't leak memory
+
+import Control.Monad
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Loop
+import Control.Monad.Trans.State.Strict
+import Data.Int (Int64)
+
+count :: Int64 -> IO Int64
+count n = iterateLoopT 0 $ \i ->
+    if i < n
+        then return $! i+1
+        else exitWith i
+
+sumLoop :: [Int64] -> Int64
+sumLoop list =
+    flip execState 0 $ foreach list $ \i -> do
+        when (i == 10000000) exit
+        lift $ modify' (+i)
+  where
+    modify' f = do
+        x <- get
+        put $! f x
+
+main :: IO ()
+main = do
+    count 100000000 >>= print
+    print $ sumLoop [1..10000000] + 10000000
diff --git a/test/lift-continue.hs b/test/lift-continue.hs
new file mode 100644
--- /dev/null
+++ b/test/lift-continue.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+import Control.Monad
+import Control.Monad.Base
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Loop
+
+main :: IO ()
+main = do
+    foreach [1..10] $ \(i :: Int) -> do
+        foreach [1..10] $ \(j :: Int) -> do
+            when (j > i) $
+                lift continue
+            when (i == 2 && j == 2) $
+                exit
+            when (i == 9 && j == 9) $
+                lift exit
+            liftBase $ print (i, j)
+        liftBase $ putStrLn "Inner loop finished"
+    putStrLn "Outer loop finished"
diff --git a/test/liftLocal.hs b/test/liftLocal.hs
new file mode 100644
--- /dev/null
+++ b/test/liftLocal.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+import Prelude hiding (log)
+
+import Control.Monad.Trans.Loop
+
+import Control.Exception
+import Control.Monad.Reader
+import Control.Monad.Writer
+
+test1 :: IO ()
+test1 =
+    foreach [1..4] $ \(i :: Int) -> do
+        let log msg = liftIO $ putStrLn $ "test1: " ++ show i ++ ": " ++ msg
+
+            logMaskingState = do
+                b <- lift getMaskingState
+                log $ "getMaskingState: " ++ show b
+
+        logMaskingState
+
+        liftLocalLoopT mask_ $ do
+            logMaskingState
+            when (i == 3) $ do
+                log "continue"
+                continue
+            logMaskingState
+
+-- This test is interesting because we're using mtl's 'local', which in this
+-- context walks up the WriterT too.
+test2 :: IO ()
+test2 =
+    mapM_ putStrLn $
+    flip runReader (0 :: Int) $
+    execWriterT $
+    foreach [1..4] $ \(i :: Int) -> do
+        let log msg = lift $ tell ["test2: " ++ show i ++ ": " ++ msg]
+
+            logAsk = do
+                n <- lift ask
+                log $ "ask: " ++ show n
+
+        logAsk
+
+        liftLocalLoopT (local (+1)) $ do
+            logAsk
+            when (i == 3) $ do
+                log "continue"
+                continue
+            logAsk
diff --git a/test/recycled-numbers.hs b/test/recycled-numbers.hs
new file mode 100644
--- /dev/null
+++ b/test/recycled-numbers.hs
@@ -0,0 +1,70 @@
+-- This solves Google Code Jam 2012 Qualification Problem C "Recycled Numbers" [1].
+-- The problem is: given a range of numbers with the same number of digits,
+-- count how many pairs of them are the same modulo rotation of digits.
+--
+--  [1]: http://code.google.com/codejam/contest/1460488/dashboard#s=p2
+{-# LANGUAGE ScopedTypeVariables #-}
+import Control.Monad.Trans.Loop
+
+import Control.Applicative          ((<$>))
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.Trans.Class
+import Data.Array.ST
+import Data.STRef
+
+recycledNumbers :: (Int, Int) -> Int
+recycledNumbers (lb, ub)
+    | not (1 <= lb && lb <= ub && factor == rotateFactor ub)
+    = error "recycledNumbers: invalid bounds"
+    | otherwise = runST $ do
+        bmp   <- newArray (lb, ub) False :: ST s (STUArray s Int Bool)
+        total <- newSTRef 0
+        forM_ [lb..ub] $ \i -> do
+            count <- newSTRef 0
+            foreach (iterate rotate i) $ \j -> do
+                when (not $ j >= i && j <= ub)
+                    continue
+                whenM (lift $ readArray bmp j)
+                    exit
+                lift $ writeArray bmp j True
+                lift $ modifySTRef' count (+1)
+            readSTRef count >>= modifySTRef' total . (+) . numPairs
+        readSTRef total
+  where
+    factor = rotateFactor lb
+
+    rotate x = let (n, d) = x `divMod` 10
+                in d*factor + n
+
+    numPairs n = (n-1) * n `div` 2
+
+main :: IO ()
+main = do
+    t <- readLn
+    forM_ [1..t] $ \(x :: Int) -> do
+        [a, b] <- map read . words <$> getLine
+        let y = recycledNumbers (a, b)
+        putStrLn $ "Case #" ++ show x ++ ": " ++ show y
+
+------------------------------------------------------------------------
+-- Helper functions
+
+-- | Return the power of 10 corresponding to the most significant digit in the
+-- number.
+rotateFactor :: Int -> Int
+rotateFactor n | n < 1     = error "rotateFactor: n < 1"
+               | otherwise = loop 1
+  where
+    loop p | p' > n    = p
+           | p' < p    = p     -- in case of overflow
+           | otherwise = loop p'
+      where p' = p * 10
+
+modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
+modifySTRef' ref f = do
+    x <- readSTRef ref
+    writeSTRef ref $! f x
+
+whenM :: Monad m => m Bool -> m () -> m ()
+whenM p m = p >>= \b -> if b then m else return ()