diff --git a/examples/redblack.hs b/examples/redblack.hs
new file mode 100644
--- /dev/null
+++ b/examples/redblack.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+import Control.Applicative
+import Data.Unfoldable
+import Data.Unfolder
+
+import Data.Maybe
+import System.Random
+import Data.List (intercalate)
+
+-- red-black tree implementation adapted from https://gist.github.com/2660297
+data Nat = Zero | Succ Nat deriving (Eq, Ord, Show)
+data NatW :: Nat -> * where
+  ZeroW :: NatW Zero
+  SuccW :: NatW n -> NatW (Succ n)
+
+data RedBlack = Black | Red deriving (Eq, Ord, Show)
+
+data RedBlackTree a where 
+  T :: Node Black n a -> RedBlackTree a
+deriving instance Show a => Show (RedBlackTree a)
+
+data Node :: RedBlack -> Nat -> * -> * where
+  Leaf :: Node Black Zero a
+  B :: Node cL    n a -> a -> Node cR    n a -> Node Black (Succ n) a
+  R :: Node Black n a -> a -> Node Black n a -> Node Red    n       a
+deriving instance Show a => Show (Node c n a)
+
+instance Unfoldable RedBlackTree where
+  unfold = u ZeroW
+    where
+      u :: forall n f a. (Unfoldable (Node Black n), Unfolder f) 
+        => NatW n -> f a -> f (RedBlackTree a)
+      u n fa = choose 
+        [ T <$> (unfold :: Unfolder f => f a -> f (Node Black n a)) fa
+        , u (SuccW n) fa
+        ]
+  
+instance Unfoldable (Node Black Zero) where
+  unfold _ = choose [ pure Leaf ]
+
+instance Unfoldable (Node Black n) => Unfoldable (Node Black (Succ n)) where
+  unfold = u
+    where
+      u :: forall f a. Unfolder f => f a -> f (Node Black (Succ n) a)
+      u fa = choose 
+        [ B <$> b <*> fa <*> b
+        , B <$> b <*> fa <*> r
+        , B <$> r <*> fa <*> b
+        , B <$> r <*> fa <*> r
+        ]
+        where
+          r :: Unfolder f => f (Node Red n a)
+          r = unfold fa
+          b :: Unfolder f => f (Node Black n a)
+          b = unfold fa
+
+instance Unfoldable (Node Black n) => Unfoldable (Node Red n) where
+  unfold fa = choose [ R <$> unfold fa <*> fa <*> unfold fa ]
+
+rbtree :: Int -> RedBlackTree Int
+rbtree l = fromJust $ fromList [0..l]
+
+rbtreeShapes :: Int -> [RedBlackTree ()]
+rbtreeShapes d = limitDepth d unfold_
+
+randomRBTree :: IO (RedBlackTree Bool)
+randomRBTree = getStdRandom randomDefault
+
+newtype Formula = Formula [Integer]
+instance Show Formula where
+  show (Formula xs) 
+    | all (== 0) xs = "0"
+    | otherwise = intercalate " + " $ map showOne $ filter ((/=0) . fst) $ zip xs [0..]
+        where
+          showOne (x, 0) = show x
+          showOne (1, 1) = "x"
+          showOne (x, 1) = show x ++ "x"
+          showOne (1, n) = "x^" ++ show n
+          showOne (x, n) = show x ++ "x^" ++ show n
+
+add, mul :: [Integer] -> [Integer] -> [Integer]
+add xs [] = xs
+add [] ys = ys
+add (x:xs) (y:ys) = (x + y) : add xs ys
+mul _ [] = []
+mul [] _ = []
+mul (x:xs) (y:ys) = (x * y) : add (map (x*) ys) (add (map (y*) xs) (0 : mul xs ys))
+
+instance Num Formula where
+  fromInteger x = Formula [x]
+  Formula xs + Formula ys = Formula (add xs ys)
+  Formula xs * Formula ys = Formula (mul xs ys)
+
+x :: Formula
+x = Formula [0, 1]
+
+-- See http://oeis.org/A001137
+rbFormula :: Int -> NumConst Formula (RedBlackTree a)
+rbFormula d = ala (limitDepth d) unfold (NumConst x)
diff --git a/src/Data/Biunfoldable.hs b/src/Data/Biunfoldable.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Biunfoldable.hs
@@ -0,0 +1,112 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Biunfoldable
+-- Copyright   :  (c) Sjoerd Visscher 2012
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Class of data structures with 2 type arguments that can be unfolded.
+-----------------------------------------------------------------------------
+module Data.Biunfoldable 
+  (
+
+  -- * Biunfoldable
+    Biunfoldable(..)
+  , biunfold_
+  , biunfoldBF
+  , biunfoldBF_
+
+  -- ** Specific unfolds
+  , biunfoldr
+  , fromLists
+  , randomDefault
+  , arbitraryDefault
+
+  ) 
+  where
+
+import Control.Applicative
+import Data.Unfolder
+import Data.Functor.Constant
+import Control.Monad.Trans.State
+import qualified System.Random as R
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+import Test.QuickCheck.Gen (Gen(..))
+import Data.Maybe
+
+-- | Data structures with 2 type arguments (kind @* -> * -> *@) that can be unfolded.
+--
+-- For example, given a data type
+--
+-- > data Tree a b = Empty | Leaf a | Node (Tree a b) b (Tree a b)
+--
+-- a suitable instance would be
+--
+-- > instance Biunfoldable Tree where
+-- >   biunfold fa fb = choose
+-- >     [ pure Empty
+-- >     , Leaf <$> fa
+-- >     , Node <$> biunfold fa fb <*> fb <*> biunfold fa fb
+-- >     ]
+--
+-- i.e. it follows closely the instance for 'Bitraversable', but instead of matching on an input value,
+-- we 'choose' from a list of all cases.
+class Biunfoldable t where
+  -- | Given a way to generate elements, return a way to generate structures containing those elements.
+  biunfold :: Unfolder f => f a -> f b -> f (t a b)
+
+-- | Unfold the structure, always using @()@ as elements.
+biunfold_ :: (Biunfoldable t, Unfolder f) => f (t () ())
+biunfold_ = biunfold (pure ()) (pure ())
+
+-- | Breadth-first unfold, which orders the result by the number of 'choose' calls.
+biunfoldBF :: (Biunfoldable t, Unfolder f) => f a -> f b -> f (t a b)
+biunfoldBF = ala2 bfs biunfold
+
+-- | Unfold the structure breadth-first, always using @()@ as elements.
+biunfoldBF_ :: (Biunfoldable t, Unfolder f) => f (t () ())
+biunfoldBF_ = bfs biunfold_
+
+-- | @biunfoldr@ builds a data structure from a seed value.
+biunfoldr :: Biunfoldable t => (c -> Maybe (a, c)) -> (c -> Maybe (b, c)) -> c -> Maybe (t a b)
+biunfoldr fa fb z = terminate . flip runStateT z $ biunfoldBF (StateT $ maybeToList . fa) (StateT $ maybeToList . fb)
+  where
+    terminate [] = Nothing
+    terminate ((t, c):ts) = if isNothing (fa c) && isNothing (fb c) then Just t else terminate ts
+
+-- | Create a data structure using the lists as input.
+-- This can fail because there might not be a data structure with the same number
+-- of element positions as the number of elements in the lists.
+fromLists :: Biunfoldable t => [a] -> [b] -> Maybe (t a b)
+fromLists = curry $ biunfoldr unconsA unconsB
+  where
+    unconsA ([], _) = Nothing
+    unconsA (a:as, bs) = Just (a, (as, bs))
+    unconsB (_, []) = Nothing
+    unconsB (as, b:bs) = Just (b, (as, bs))
+
+-- | Generate a random value, can be used as default instance for 'R.Random'.
+randomDefault :: (R.Random a, R.Random b, R.RandomGen g, Biunfoldable t) => g -> (t a b, g)
+randomDefault = runState . getRandom $ biunfold (Random . state $ R.random) (Random . state $ R.random)
+
+-- | Provides a QuickCheck generator, can be used as default instance for 'Arbitrary'.
+arbitraryDefault :: (Arbitrary a, Arbitrary b, Biunfoldable t) => Gen (t a b)
+arbitraryDefault = MkGen $ \r n -> let Arb _ f = biunfold arbUnit arbUnit in 
+  fromMaybe (error "Failed to generate a value.") (f r (n + 1))
+
+instance Biunfoldable Either where
+  biunfold fa fb = choose 
+    [ Left <$> fa
+    , Right <$> fb
+    ]
+
+instance Biunfoldable (,) where
+  biunfold fa fb = choose 
+    [ (,) <$> fa <*> fb ]
+
+instance Biunfoldable Constant where
+  biunfold fa _ = choose 
+    [ Constant <$> fa ]
diff --git a/src/Data/Unfoldable.hs b/src/Data/Unfoldable.hs
--- a/src/Data/Unfoldable.hs
+++ b/src/Data/Unfoldable.hs
@@ -25,6 +25,7 @@
   , leftMost
   , rightMost
   , allDepthFirst
+  , allToDepth
   , allBreadthFirst
   , randomDefault
   , arbitraryDefault
@@ -72,11 +73,11 @@
 
 -- | Breadth-first unfold, which orders the result by the number of 'choose' calls.
 unfoldBF :: (Unfoldable t, Unfolder f) => f a -> f (t a)
-unfoldBF = runBFS . unfold . packBFS
+unfoldBF = ala bfs unfold
 
 -- | Unfold the structure breadth-first, always using @()@ as elements.
 unfoldBF_ :: (Unfoldable t, Unfolder f) => f (t ())
-unfoldBF_ = unfoldBF (pure ())
+unfoldBF_ = bfs unfold_
 
 -- | @unfoldr@ builds a data structure from a seed value. It can be specified as:
 -- 
@@ -104,11 +105,15 @@
 rightMost :: Unfoldable t => Maybe (t ())
 rightMost = getDualA unfold_
 
--- | Generate all the values depth first.
+-- | Generate all the values depth-first.
 allDepthFirst :: Unfoldable t => [t ()]
 allDepthFirst = unfold_
 
--- | Generate all the values breadth first.
+-- | Generate all the values upto a given depth, depth-first.
+allToDepth :: Unfoldable t => Int -> [t ()]
+allToDepth d = limitDepth d unfold_
+
+-- | Generate all the values breadth-first.
 allBreadthFirst :: Unfoldable t => [t ()]
 allBreadthFirst = unfoldBF_
 
@@ -122,37 +127,43 @@
   fromMaybe (error "Failed to generate a value.") (f r (n + 1))
 
 instance Unfoldable [] where
-  unfold f = choose 
+  unfold fa = choose 
     [ pure []
-    , (:) <$> f <*> unfold f
+    , (:) <$> fa <*> unfold fa
     ]
 
 instance Unfoldable Maybe where
-  unfold f = choose 
+  unfold fa = choose 
     [ pure Nothing
-    , Just <$> f
+    , Just <$> fa
     ]
 
 instance (Bounded a, Enum a) => Unfoldable (Either a) where
-  unfold f = choose 
+  unfold fa = choose 
     [ Left <$> boundedEnum
-    , Right <$> f
+    , Right <$> fa
     ]
 
 instance (Bounded a, Enum a) => Unfoldable ((,) a) where
-  unfold f = (,) <$> boundedEnum <*> f
+  unfold fa = choose 
+    [ (,) <$> boundedEnum <*> fa ]
 
 instance Unfoldable Identity where
-  unfold = fmap Identity
+  unfold fa = choose 
+    [ Identity <$> fa ]
 
 instance (Bounded a, Enum a) => Unfoldable (Constant a) where
-  unfold = fmap Constant . const boundedEnum
+  unfold _ = choose 
+    [ Constant <$> boundedEnum ]
   
 instance (Unfoldable p, Unfoldable q) => Unfoldable (Product p q) where
-  unfold f = Pair <$> unfold f <*> unfold f
+  unfold fa = choose
+    [ Pair <$> unfold fa <*> unfold fa ]
 
 instance (Unfoldable p, Unfoldable q) => Unfoldable (Compose p q) where
-  unfold = fmap Compose . unfold . unfold
+  unfold fa = choose
+    [ Compose <$> unfold (unfold fa) ]
 
 instance Unfoldable f => Unfoldable (Reverse f) where
-  unfold = fmap Reverse . getDualA . unfold . DualA
+  unfold fa = choose
+    [ Reverse <$> getDualA (unfold (DualA fa)) ]
diff --git a/src/Data/Unfolder.hs b/src/Data/Unfolder.hs
--- a/src/Data/Unfolder.hs
+++ b/src/Data/Unfolder.hs
@@ -16,6 +16,7 @@
 {-# LANGUAGE 
     ScopedTypeVariables
   , GeneralizedNewtypeDeriving
+  , RankNTypes
   #-}
 module Data.Unfolder 
   (
@@ -27,16 +28,28 @@
   , boundedEnum
   
   -- ** Unfolder instances
-  , DualA(..)
   , Random(..)
 
-  , BFS(..)
-  , runBFS
-  , packBFS
-  
   , Arb(..)
   , arbUnit
   
+  , NumConst(..)
+  
+  -- * UnfolderTransformer
+  , UnfolderTransformer(..)
+  , ala
+  , ala2
+  
+  -- ** UnfolderTransformer instances
+  , DualA(..)
+
+  , NT(..)
+  , WithRec(..)
+  , withRec
+  , limitDepth
+  
+  , BFS(..)
+  , bfs
   ) 
   where 
 
@@ -61,7 +74,7 @@
 import Test.QuickCheck.Arbitrary (Arbitrary(..))
 import Test.QuickCheck.Gen (Gen(..))
 
-import Data.Monoid (Monoid)
+import Data.Monoid (Monoid(..))
 import Data.Maybe (catMaybes, listToMaybe)
 import Data.Foldable (asum)
 import Data.Traversable (traverse)
@@ -83,6 +96,7 @@
 chooseMonadDefault ms = chooseInt (length ms) >>= (ms !!)
 
 -- | If a datatype is bounded and enumerable, we can use 'chooseInt' to generate a value.
+-- This is the function to use if you want to unfold a datatype that has no type arguments (has kind *).
 boundedEnum :: forall f a. (Unfolder f, Bounded a, Enum a) => f a
 boundedEnum = (\x -> toEnum (x + lb)) <$> chooseInt (1 + ub - lb)
   where
@@ -107,26 +121,12 @@
   chooseInt 0 = Nothing
   chooseInt _ = Just 0
 
--- | 'DualA' flips the '(<|>)' operator.
-newtype DualA f a = DualA { getDualA :: f a }
-  deriving (Functor, Applicative)
-instance Alternative f => Alternative (DualA f) where
-  empty = DualA empty
-  DualA a <|> DualA b = DualA (b <|> a)
--- | Reverse the list passed to choose.
-instance Unfolder f => Unfolder (DualA f) where
-  choose = DualA . choose . reverse . map getDualA
-  chooseInt n = DualA $ (\x -> n - 1 - x) <$> chooseInt n
-
-fstP :: Product p q a -> p a
-fstP (Pair p _) = p
-
-sndP :: Product p q a -> q a
-sndP (Pair _ q) = q
-
 -- | Derived instance.
 instance (Unfolder p, Unfolder q) => Unfolder (Product p q) where
   choose ps = Pair (choose $ map fstP ps) (choose $ map sndP ps)
+    where
+      fstP (Pair p _) = p
+      sndP (Pair _ q) = q
   chooseInt n = Pair (chooseInt n) (chooseInt n)
 
 -- | Derived instance.
@@ -157,7 +157,7 @@
 
 -- | Derived instance.
 instance (Functor m, Monad m) => Unfolder (MaybeT m) where
-  choose ms = MaybeT $ fmap (listToMaybe . catMaybes) (mapM runMaybeT ms)
+  choose ms = MaybeT $ listToMaybe . catMaybes <$> mapM runMaybeT ms
   chooseInt 0 = MaybeT $ return Nothing
   chooseInt _ = MaybeT $ return (Just 0)
   
@@ -194,6 +194,64 @@
   chooseInt n = Random . StateT $ return . R.randomR (0, n - 1)
 
 
+-- | An 'UnfolderTransformer' changes the way an 'Unfolder' unfolds. 
+class UnfolderTransformer t where
+  -- | Lift a computation from the argument unfolder to the constructed unfolder.
+  lift :: Unfolder f => f a -> t f a
+
+-- | Run an unfolding function with one argument using an 'UnfolderTransformer', given a way to run the transformer.
+ala :: (UnfolderTransformer t, Unfolder f) => (t f b -> f b) -> (t f a -> t f b) -> f a -> f b
+ala lower f = lower . f . lift
+
+-- | Run an unfolding function with two arguments using an 'UnfolderTransformer', given a way to run the transformer.
+ala2 :: (UnfolderTransformer t, Unfolder f) => (t f c -> f c) -> (t f a -> t f b -> t f c) -> f a -> f b -> f c
+ala2 lower f = ala lower . f . lift
+
+
+-- | 'DualA' flips the @\<|>@ operator from `Alternative`.
+newtype DualA f a = DualA { getDualA :: f a }
+  deriving (Eq, Show, Functor, Applicative)
+
+instance Alternative f => Alternative (DualA f) where
+  empty = DualA empty
+  DualA a <|> DualA b = DualA (b <|> a)
+
+-- | Reverse the list passed to choose.
+instance Unfolder f => Unfolder (DualA f) where
+  choose = DualA . choose . reverse . map getDualA
+  chooseInt n = DualA $ (\x -> n - 1 - x) <$> chooseInt n
+
+instance UnfolderTransformer DualA where
+  lift = DualA
+
+
+-- | Natural transformations
+data NT f g = NT { getNT :: forall a. f a -> g a }
+
+newtype WithRec f a = WithRec { getWithRec :: ReaderT (Int -> NT f f) f a }
+  deriving (Functor, Applicative, Alternative)
+
+-- | Applies a certain function depending on the depth at every recursive position.
+instance Unfolder f => Unfolder (WithRec f) where
+  choose ms = WithRec . ReaderT $ \f -> 
+    getNT (f 0) $ choose (map (\(WithRec (ReaderT m)) -> m (f . succ)) ms)
+
+instance UnfolderTransformer WithRec where
+  lift = WithRec . ReaderT . const
+
+-- | Apply a certain function of type @f a -> f a@ to the result of a 'choose'.
+-- The depth is passed as 'Int', so you can apply a different function at each depth.
+-- Because of a @forall@, the function needs to be wrapped in a 'NT' constructor.
+-- See 'limitDepth' for an example how to use this function.
+withRec :: (Int -> NT f f) -> WithRec f a -> f a
+withRec f = (`runReaderT` f) . getWithRec
+
+-- | Limit the depth of an unfolding.
+limitDepth :: Unfolder f => Int -> WithRec f a -> f a
+limitDepth m = withRec (\d -> NT $ if d == m then const empty else id)
+
+
+
 -- | Return a generator of values of a given depth.
 -- Returns 'Nothing' if there are no values of that depth or deeper.
 -- The depth is the number of 'choose' calls.
@@ -216,9 +274,13 @@
 instance Applicative f => Unfolder (BFS f) where
   choose ms = BFS $ \d -> if d == 0 then Just [] else flattenBFS (map (`getBFS` (d - 1)) ms)
 
-runBFS :: Unfolder f => BFS f x -> f x
-runBFS (BFS f) = choose (loop 0) where loop d = maybe [] (++ loop (d + 1)) (f d)
+instance UnfolderTransformer BFS where
+  lift = packBFS
 
+-- | Change the order of unfolding to be breadth-first.
+bfs :: Unfolder f => BFS f x -> f x
+bfs (BFS f) = choose (loop 0) where loop d = maybe [] (++ loop (d + 1)) (f d)
+
 packBFS :: f x -> BFS f x
 packBFS r = BFS $ \d -> if d == 0 then Just [r] else Nothing
 
@@ -261,3 +323,18 @@
 
 arbUnit :: Arbitrary a => Arb a
 arbUnit = Arb 0 (\r n -> Just $ unGen arbitrary r n)
+
+-- | Variant of 'Data.Functor.Constant' that does multiplication of the constants for @\<*>@ and addition for @\<|>@.
+newtype NumConst a x = NumConst { getNumConst :: a } deriving (Eq, Show)
+instance Functor (NumConst a) where
+  fmap _ (NumConst a) = NumConst a
+instance Num a => Applicative (NumConst a) where
+  pure _ = NumConst 1
+  NumConst a <*> NumConst b = NumConst $ a * b
+instance Num a => Alternative (NumConst a) where
+  empty = NumConst 0
+  NumConst a <|> NumConst b = NumConst $ a + b
+-- | Unfolds to a constant numeric value. Useful for counting shapes.
+instance Num a => Unfolder (NumConst a) where
+  choose [] = empty
+  choose as = foldr1 (<|>) as
diff --git a/unfoldable.cabal b/unfoldable.cabal
--- a/unfoldable.cabal
+++ b/unfoldable.cabal
@@ -1,5 +1,5 @@
 Name:                 unfoldable
-Version:              0.5.0
+Version:              0.6.0
 Synopsis:             Class of data structures that can be unfolded.
 Description:          Just as there's a Foldable class, there should also be an Unfoldable class. 
                       .
@@ -30,7 +30,8 @@
   
   Exposed-modules:
     Data.Unfolder
-    Data.Unfoldable  
+    Data.Unfoldable
+    Data.Biunfoldable
   
   Build-depends:
       base         >= 4   && < 5