diff --git a/examples/v1/RoseTree.hs b/examples/v1/RoseTree.hs
new file mode 100644
--- /dev/null
+++ b/examples/v1/RoseTree.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE Arrows                #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+module Main where
+
+import           Control.Arrow
+
+import           Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+
+import qualified Database.PostgreSQL.Simple as PSQL
+
+import           Opaleye
+import           Opaleye.Trans
+
+
+data Rose a = Node a [Rose a]
+    deriving (Show, Eq)
+
+
+instance Functor Rose where
+    fmap f (Node x rs) = Node (f x) (map (fmap f) rs)
+
+
+data NodeP i b n a = NodeP
+    { nodeId       :: i
+    , nodeBranchId :: b
+    , nextBranchId :: n
+    , value        :: a
+    } deriving (Show, Eq)
+
+
+type WriteNode a = NodeP (Maybe (Column PGInt4)) (Column PGInt4) (Column PGInt4) (Column a)
+type ReadNode a = NodeP (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column a)
+
+
+data BranchP i = BranchP
+    { branchId :: i
+    } deriving (Show, Eq)
+
+
+type WriteBranch = BranchP (Maybe (Column PGInt4))
+type ReadBranch = BranchP (Column PGInt4)
+
+
+data TreeP i r = TreeP
+    { treeId :: i
+    , rootId :: r
+    } deriving (Show, Eq)
+
+
+type WriteTree = TreeP (Maybe (Column PGInt4)) (Column PGInt4)
+type ReadTree = TreeP (Column PGInt4) (Column PGInt4)
+
+
+makeAdaptorAndInstance "pNode" ''NodeP
+makeAdaptorAndInstance "pBranch" ''BranchP
+makeAdaptorAndInstance "pTree" ''TreeP
+
+
+nodeTable :: Table (WriteNode a) (ReadNode a)
+nodeTable = Table "node" $ pNode NodeP
+    { nodeId = optional "id"
+    , nodeBranchId = required "branch_id"
+    , nextBranchId = required "next_branch_id"
+    , value = required "value"
+    }
+
+
+branchTable :: Table WriteBranch ReadBranch
+branchTable = Table "branch" $ pBranch (BranchP (optional "id"))
+
+
+treeTable :: Table WriteTree ReadTree
+treeTable = Table "rosetree" $ pTree TreeP
+    { treeId = optional "id"
+    , rootId = required "root_id"
+    }
+
+
+newTree :: Int -> Transaction (Maybe Int)
+newTree rootId = insertReturningFirst treeTable treeId (TreeP Nothing (pgInt4 rootId))
+
+
+newBranch :: Transaction (Maybe Int)
+newBranch = insertReturningFirst branchTable branchId (BranchP Nothing)
+
+
+insertNode :: Int -> Int -> Int -> Transaction (Maybe Int)
+insertNode bid nbid x =
+    insertReturningFirst nodeTable nodeId
+        (NodeP Nothing (pgInt4 bid) (pgInt4 nbid) (pgInt4 x))
+
+
+insertTree :: MonadBase IO m => Rose Int -> OpaleyeT m Int
+insertTree (Node x xs) = transaction $ do
+    Just bid <- newBranch
+    Just rootId <- insertNode 0 bid x
+    Just treeId <- newTree rootId
+
+    mapM_ (insertTree' bid) xs
+
+    return treeId
+
+
+insertTree' :: Int -> Rose Int -> Transaction ()
+insertTree' bid (Node x xs) = do
+    Just nbid <- newBranch
+    insertNode bid nbid x
+    mapM_ (insertTree' nbid) xs
+
+
+selectTree :: Int -> Transaction (Rose Int)
+selectTree treeId = do
+    Just rootId <- selectRootNode treeId
+    Just (NodeP _ _ nbid x) <- selectNode rootId
+    xs <- selectBranch nbid
+    return (Node x xs)
+
+
+selectRootNode :: Int -> Transaction (Maybe Int)
+selectRootNode tid = queryFirst rootNode
+  where
+    rootNode :: Query (Column PGInt4)
+    rootNode = proc () -> do
+        tree <- queryTable treeTable -< ()
+        restrict -< treeId tree .== pgInt4 tid
+        returnA -< rootId tree
+
+
+selectNode :: Int -> Transaction (Maybe (NodeP Int Int Int Int))
+selectNode nid = queryFirst nodeById
+  where
+    nodeById :: Query (ReadNode PGInt4)
+    nodeById = proc () -> do
+        node <- queryTable nodeTable -< ()
+        restrict -< nodeId node .== pgInt4 nid
+        returnA -< node
+
+
+selectBranch :: Int -> Transaction [Rose Int]
+selectBranch bid = do
+    nodes <- query nodeByBranchId
+    sequence (mkNode <$> nodes)
+  where
+    nodeByBranchId :: Query (ReadNode PGInt4)
+    nodeByBranchId = proc () -> do
+        row@(NodeP _ bid' _ _) <- queryTable nodeTable -< ()
+        restrict -< bid' .== pgInt4 bid
+        returnA -< row
+
+    mkNode :: NodeP Int Int Int Int -> Transaction (Rose Int)
+    mkNode (NodeP _ _ nbid x) = do
+        xs <- selectBranch nbid
+        return (Node x xs)
+
+
+main :: IO ()
+main = do
+    conn <- PSQL.connectPostgreSQL "dbname='rosetree' user='postgres'"
+
+    let tree :: Rose Int
+        tree =
+            Node 6
+                [ Node 7
+                    [ Node 1425
+                        [ Node 42 []
+                        , Node 2354 []
+                        , Node 4245 []]]
+                , Node 10 []
+                , Node 6
+                    [ Node 12 []
+                    , Node 14 []]]
+
+    tree' <- runOpaleyeT conn $ run . selectTree =<< insertTree tree
+
+    print (tree, tree')
+    print (tree == tree')
diff --git a/examples/v2/RoseTree.hs b/examples/v2/RoseTree.hs
new file mode 100644
--- /dev/null
+++ b/examples/v2/RoseTree.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE Arrows                #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
+
+module Main where
+
+import           Control.Arrow
+import           Control.Monad              (void)
+
+import           Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+
+import qualified Database.PostgreSQL.Simple as PSQL
+
+import           Opaleye
+import           Opaleye.Trans
+
+
+data Rose a
+    = Node a [Rose a]
+    | Leaf a
+    deriving (Show, Eq)
+
+
+instance Functor Rose where
+    fmap f (Node x rs) = Node (f x) (map (fmap f) rs)
+    fmap f (Leaf x) = Leaf (f x)
+
+
+data NodeP i b a = NodeP
+    { nodeId       :: i
+    , nodeBranchId :: b
+    , value        :: a
+    } deriving (Show, Eq)
+
+
+data NodeBranchP i n = NodeBranchP
+    { nodeIdRef    :: i
+    , nextBranchId :: n
+    } deriving (Show, Eq)
+
+
+type WriteNode a = NodeP (Maybe (Column PGInt4)) (Column PGInt4) (Column a)
+type ReadNode a = NodeP (Column PGInt4) (Column PGInt4) (Column a)
+type NodeBranch = NodeBranchP (Column PGInt4) (Column PGInt4)
+type NullableNodeBranch = NodeBranchP (Column (Nullable PGInt4)) (Column (Nullable PGInt4))
+
+
+data BranchP i = BranchP
+    { branchId :: i
+    } deriving (Show, Eq)
+
+
+type WriteBranch = BranchP (Maybe (Column PGInt4))
+type ReadBranch = BranchP (Column PGInt4)
+
+
+data TreeP i r = TreeP
+    { treeId :: i
+    , rootId :: r
+    } deriving (Show, Eq)
+
+
+type WriteTree = TreeP (Maybe (Column PGInt4)) (Column PGInt4)
+type ReadTree = TreeP (Column PGInt4) (Column PGInt4)
+
+
+makeAdaptorAndInstance "pNode" ''NodeP
+makeAdaptorAndInstance "pNodeBranch" ''NodeBranchP
+makeAdaptorAndInstance "pBranch" ''BranchP
+makeAdaptorAndInstance "pTree" ''TreeP
+
+
+nodeTable :: Table (WriteNode a) (ReadNode a)
+nodeTable = Table "node" $ pNode NodeP
+    { nodeId = optional "id"
+    , nodeBranchId = required "branch_id"
+    , value = required "value"
+    }
+
+
+nodeBranchTable :: Table NodeBranch NodeBranch
+nodeBranchTable = Table "node_branch" $ pNodeBranch NodeBranchP
+    { nodeIdRef = required "id"
+    , nextBranchId = required "next_branch_id"
+    }
+
+
+branchTable :: Table WriteBranch ReadBranch
+branchTable = Table "branch" $ pBranch (BranchP (optional "id"))
+
+
+treeTable :: Table WriteTree ReadTree
+treeTable = Table "rosetree" $ pTree TreeP
+    { treeId = optional "id"
+    , rootId = required "root_id"
+    }
+
+
+newTree :: Int -> Transaction (Maybe Int)
+newTree rootId =
+    insertReturningFirst treeTable treeId (TreeP Nothing (pgInt4 rootId))
+
+
+newBranch :: Transaction (Maybe Int)
+newBranch = insertReturningFirst branchTable branchId (BranchP Nothing)
+
+
+insertNode :: Int -> Maybe Int -> Int -> Transaction (Maybe Int)
+insertNode bid (Just nbid) x = do
+    Just nodeId <- insertReturningFirst nodeTable nodeId
+        (NodeP Nothing (pgInt4 bid) (pgInt4 x))
+    insert nodeBranchTable (NodeBranchP (pgInt4 nodeId) (pgInt4 nbid))
+    return (Just nodeId)
+insertNode bid Nothing x =
+    insertReturningFirst nodeTable nodeId
+        (NodeP Nothing (pgInt4 bid) (pgInt4 x))
+
+
+insertTree :: MonadBase IO m => Rose Int -> OpaleyeT m Int
+insertTree (Node x xs) = transaction $ do
+    Just bid <- newBranch
+    Just rootId <- insertNode 0 (Just bid) x
+    Just treeId <- newTree rootId
+
+    mapM_ (insertTree' bid) xs
+
+    return treeId
+insertTree (Leaf x) = transaction $ do
+    Just rootId <- insertNode 0 Nothing x
+    Just treeId <- newTree rootId
+    return treeId
+
+
+insertTree' :: Int -> Rose Int -> Transaction ()
+insertTree' bid (Node x xs) = do
+    Just nbid <- newBranch
+    insertNode bid (Just nbid) x
+    mapM_ (insertTree' nbid) xs
+insertTree' bid (Leaf x) =
+    void (insertNode bid Nothing x)
+
+
+-- TODO Wrong order
+selectTree :: Int -> Transaction (Rose Int)
+selectTree treeId = do
+    Just rootId <- selectRootNode treeId
+    Just (NodeP _ _ x, NodeBranchP _ mbid) <- selectNode rootId
+    case mbid of
+        Just nbid -> do
+            xs <- selectBranch nbid
+            return (Node x xs)
+        Nothing -> return (Leaf x)
+
+
+selectRootNode :: Int -> Transaction (Maybe Int)
+selectRootNode tid = queryFirst rootNode
+  where
+    rootNode :: Query (Column PGInt4)
+    rootNode = proc () -> do
+        tree <- queryTable treeTable -< ()
+        restrict -< treeId tree .== pgInt4 tid
+        returnA -< rootId tree
+
+
+nodeAndBranch :: Query (ReadNode PGInt4, NullableNodeBranch)
+nodeAndBranch = leftJoin allNodes allNodeBranches (uncurry idsEqual)
+  where
+    allNodes = queryTable nodeTable
+    allNodeBranches = queryTable nodeBranchTable
+
+    idsEqual :: ReadNode PGInt4 -> NodeBranch -> Column PGBool
+    idsEqual (NodeP nid' _ _) (NodeBranchP nbid _) = nid' .== nbid
+
+
+byId :: Query a -> (a -> Column PGInt4) -> Int -> Query a
+byId q getId id' = proc () -> do
+    row <- q -< ()
+    restrict -< getId row .== pgInt4 id'
+    returnA -< row
+
+
+selectNode :: Int -> Transaction (Maybe (NodeP Int Int Int, NodeBranchP (Maybe Int) (Maybe Int)))
+selectNode nid = queryFirst nodeById
+  where
+    nodeById :: Query (ReadNode PGInt4, NullableNodeBranch)
+    nodeById = byId nodeAndBranch (nodeId . fst) nid
+
+
+selectBranch :: Int -> Transaction [Rose Int]
+selectBranch bid = do
+    nodes <- query nodeByBranchId
+    sequence (mkNode <$> nodes)
+  where
+    nodeByBranchId :: Query (ReadNode PGInt4, NullableNodeBranch)
+    nodeByBranchId = byId nodeAndBranch (nodeBranchId . fst) bid
+    
+    mkNode 
+        :: (NodeP Int Int Int, NodeBranchP (Maybe Int) (Maybe Int)) 
+        -> Transaction (Rose Int)
+    mkNode (NodeP _ _ x, NodeBranchP Nothing Nothing) = return (Leaf x)
+    mkNode (NodeP _ _ x, NodeBranchP _ (Just nbid)) = do
+        xs <- selectBranch nbid
+        return (Node x xs)
+    mkNode x = error $ "Bad branch select. Who knows?: " ++ show x
+
+
+main :: IO ()
+main = do
+    conn <- PSQL.connectPostgreSQL "dbname='rosetree' user='postgres'"
+
+    let tree :: Rose Int
+        tree =
+            Node 6
+                [ Node 7
+                    [ Node 1425
+                        [ Leaf 42
+                        , Leaf 2354
+                        , Leaf 4245]]
+                , Leaf 10
+                , Node 6
+                    [ Leaf 12
+                    , Leaf 14]]
+
+    tree' <- runOpaleyeT conn $ run . selectTree =<< insertTree tree
+
+    print tree
+    print tree'
+    print (tree == tree')
diff --git a/opaleye-trans.cabal b/opaleye-trans.cabal
--- a/opaleye-trans.cabal
+++ b/opaleye-trans.cabal
@@ -1,5 +1,5 @@
 name:                opaleye-trans
-version:             0.1.1
+version:             0.2.0
 synopsis:            A monad transformer for Opaleye
 description:         A monad transformer for Opaleye
 homepage:            https://github.com/tomjaguarpaw/haskell-opaleye
@@ -17,15 +17,36 @@
   location: https://github.com/WraithM/opaleye-trans
 
 library
+  hs-source-dirs:      src
   exposed-modules:     Opaleye.Trans
   -- other-modules:
+  default-language:    Haskell2010
   build-depends:
     base                >=4.8 && <4.9,
     mtl                 >=2.2 && <2.3,
     transformers-base   >=0.4 && <0.5,
-    monad-control       >=1.0 && <1.1,
     opaleye             >=0.4 && <0.5,
     postgresql-simple   >=0.4 && <0.5,
     product-profunctors >=0.6 && <0.7
-  hs-source-dirs:      src
+
+executable opaleye-rosetree
+  hs-source-dirs:      examples/v1
+  main-is:             RoseTree.hs
   default-language:    Haskell2010
+  build-depends:
+    base                >=4.8 && <4.9,
+    opaleye             >=0.4 && <0.5,
+    postgresql-simple   >=0.4 && <0.5,
+    product-profunctors >=0.6 && <0.7,
+    opaleye-trans
+
+executable opaleye-rosetree2
+  hs-source-dirs:      examples/v2
+  main-is:             RoseTree.hs
+  default-language:    Haskell2010
+  build-depends:
+    base                >=4.8 && <4.9,
+    opaleye             >=0.4 && <0.5,
+    postgresql-simple   >=0.4 && <0.5,
+    product-profunctors >=0.6 && <0.7,
+    opaleye-trans
diff --git a/src/Opaleye/Trans.hs b/src/Opaleye/Trans.hs
--- a/src/Opaleye/Trans.hs
+++ b/src/Opaleye/Trans.hs
@@ -10,7 +10,9 @@
     , runOpaleyeT
 
     , -- * Transactions
-      transaction
+      Transaction
+    , transaction
+    , run
 
     , -- * Queries
       query
@@ -25,13 +27,11 @@
 
     , -- * Utilities
       withConn
-    , withConnIO
 
     , -- * Reexports
       liftBase
     , MonadBase
     , ask
-    , MonadBaseControl
     , Int64
     ) where
 
@@ -39,7 +39,6 @@
 import           Control.Monad.Reader            (MonadReader, ReaderT (..),
                                                   ask)
 import           Control.Monad.Trans             (MonadTrans (..))
-import           Control.Monad.Trans.Control
 
 import           Data.Maybe                      (listToMaybe)
 import           Data.Profunctor.Product.Default (Default)
@@ -66,76 +65,81 @@
 runOpaleyeT c = flip runReaderT c . unOpaleyeT
 -- TODO Handle exceptions
 
--- | With a 'Connection'
-withConn :: Monad m => (Connection -> m a) -> OpaleyeT m a
+
+withConn :: MonadBase IO m => (Connection -> IO a) -> OpaleyeT m a
 withConn f = do
     conn <- ask
-    lift (f conn)
+    liftBase (f conn)
 
 
--- | With a 'Connection'
-withConnIO :: MonadBase IO m => (Connection -> IO a) -> OpaleyeT m a
-withConnIO f = do
-    conn <- ask
-    liftBase $ f conn
+newtype Transaction a = Transaction { unTransaction :: ReaderT Connection IO a }
+    deriving (Functor, Applicative, Monad, MonadReader Connection)
 
 
--- | 'withTransaction' lifted into a 'MonadBaseControl' 'IO' monad
-liftWithTransaction :: MonadBaseControl IO m => Connection -> m a -> m a
-liftWithTransaction conn f =
-    control $ \io -> withTransaction conn (io f)
+-- | Run a postgresql transaction in the 'OpaleyeT' monad
+transaction :: MonadBase IO m => Transaction a -> OpaleyeT m a
+transaction (Transaction t) = withConn $ \conn -> 
+    withTransaction conn (runReaderT t conn)
 
 
--- | Run a postgresql transaction in the 'OpaleyeT' monad
-transaction :: MonadBaseControl IO m => OpaleyeT m a -> OpaleyeT m a
-transaction t = withConn $ \conn ->
-    liftWithTransaction conn (runOpaleyeT conn t)
+-- | Execute a query without a literal transaction
+run :: MonadBase IO m => Transaction a -> OpaleyeT m a
+run (Transaction t) = withConn $ runReaderT t
 
 
+-- | With a 'Connection' in a 'Transaction'
+-- This isn't exposed so that users can't just drop down to IO
+-- in a transaction
+withConnIO :: (Connection -> IO a) -> Transaction a
+withConnIO f = Transaction (ReaderT f)
+
+
 -- | Execute a 'Query'. See 'runQuery'.
-query :: (MonadBase IO m, Default QueryRunner a b) => Query a -> OpaleyeT m [b]
+query :: Default QueryRunner a b => Query a -> Transaction [b]
 query q = withConnIO (`runQuery` q)
 
 
 -- | Retrieve the first result from a 'Query'. Similar to @listToMaybe <$> runQuery@.
-queryFirst :: (MonadBase IO m, Default QueryRunner a b) => Query a -> OpaleyeT m (Maybe b)
+queryFirst :: Default QueryRunner a b => Query a -> Transaction (Maybe b)
 queryFirst q = listToMaybe <$> query q
 
 
 -- | Insert into a 'Table'. See 'runInsert'.
-insert :: MonadBase IO m => Table w r -> w -> OpaleyeT m Int64
+insert :: Table w r -> w -> Transaction Int64
 insert t w = withConnIO (\c -> runInsert c t w)
 
 
 -- | Insert many records into a 'Table'. See 'runInsertMany'.
-insertMany :: MonadBase IO m => Table w r -> [w] -> OpaleyeT m Int64
+insertMany :: Table w r -> [w] -> Transaction Int64
 insertMany t ws = withConnIO (\c -> runInsertMany c t ws)
 
 
 -- | Insert a record into a 'Table' with a return value. See 'runInsertReturning'.
 insertReturning
-    :: (MonadBase IO m, Default QueryRunner a b)
+    :: Default QueryRunner a b
     => Table w r
     -> (r -> a)
     -> w
-    -> OpaleyeT m [b]
+    -> Transaction [b]
 insertReturning t ret w = withConnIO (\c -> runInsertReturning c t w ret)
 
 
 -- | Insert a record into a 'Table' with a return value. Retrieve only the first result.
 -- Similar to @listToMaybe <$> insertReturning@
 insertReturningFirst
-    :: (MonadBase IO m, Default QueryRunner a b)
+    :: Default QueryRunner a b
     => Table w r
     -> (r -> a)
     -> w
-    -> OpaleyeT m (Maybe b)
+    -> Transaction (Maybe b)
 insertReturningFirst t ret w = listToMaybe <$> insertReturning t ret w
 
 
 -- | Insert many records into a 'Table' with a return value for each record.
+--
+-- Maybe not worth defining. This almost certainly does the wrong thing.
 insertManyReturning
-    :: (MonadBaseControl IO m, Default QueryRunner a b)
+    :: (MonadBase IO m, Default QueryRunner a b)
     => Table w r
     -> (r -> a)
     -> [w]