diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,8 @@
+0.6
+---
+* Fixed the `dfs` `enterVertex` and `exitVertex` order, they were wrong before.
+* Factored out a common visitor model for both `bfs` and `dfs`.
+
 0.5
 ---
 * Added `enterEdge` to `bfs` and `dfs`.
diff --git a/graphs.cabal b/graphs.cabal
--- a/graphs.cabal
+++ b/graphs.cabal
@@ -1,6 +1,6 @@
 name:          graphs
 category:      Algorithms, Data Structures, Graphs
-version:       0.5.0.1
+version:       0.6
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -35,6 +35,7 @@
   exposed-modules:
     Data.Graph.AdjacencyList
     Data.Graph.AdjacencyMatrix
+    Data.Graph.Algorithm
     Data.Graph.Algorithm.DepthFirstSearch
     Data.Graph.Algorithm.BreadthFirstSearch
     Data.Graph.Class
diff --git a/src/Data/Graph/AdjacencyList.hs b/src/Data/Graph/AdjacencyList.hs
--- a/src/Data/Graph/AdjacencyList.hs
+++ b/src/Data/Graph/AdjacencyList.hs
@@ -24,7 +24,7 @@
 import Data.Graph.Class
 import Data.Graph.Class.AdjacencyList
 
-newtype AdjacencyList i a = AdjacencyList { runAdjacencyList :: Array i [i] -> a }  
+newtype AdjacencyList i a = AdjacencyList { runAdjacencyList :: Array i [i] -> a }
 
 ask :: AdjacencyList i (Array i [i])
 ask = AdjacencyList id
@@ -48,8 +48,8 @@
   edgeMap = pure . propertyMap
 
 instance Ix i => AdjacencyListGraph (AdjacencyList i) where
-  adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v 
-                                     then g ! v 
+  adjacentVertices v = AdjacencyList $ \g -> if inRange (bounds g) v
+                                     then g ! v
                                      else []
   source (a, _) = pure a
   target (_, b) = pure b
diff --git a/src/Data/Graph/AdjacencyMatrix.hs b/src/Data/Graph/AdjacencyMatrix.hs
--- a/src/Data/Graph/AdjacencyMatrix.hs
+++ b/src/Data/Graph/AdjacencyMatrix.hs
@@ -24,7 +24,7 @@
 import Data.Graph.Class
 import Data.Graph.Class.AdjacencyMatrix
 
-newtype AdjacencyMatrix arr i a = AdjacencyMatrix { runAdjacencyMatrix :: arr (i,i) Bool -> a } 
+newtype AdjacencyMatrix arr i a = AdjacencyMatrix { runAdjacencyMatrix :: arr (i,i) Bool -> a }
 
 ask :: AdjacencyMatrix arr i (arr (i, i) Bool)
 ask = AdjacencyMatrix id
@@ -43,13 +43,13 @@
 
 instance Ord i => Graph (AdjacencyMatrix arr i) where
   type Vertex (AdjacencyMatrix arr i) = i
-  type Edge (AdjacencyMatrix arr i) = (i, i) 
+  type Edge (AdjacencyMatrix arr i) = (i, i)
   vertexMap = pure . propertyMap
   edgeMap = pure . propertyMap
 
 instance (IArray arr Bool, Ix i) => AdjacencyMatrixGraph (AdjacencyMatrix arr i) where
   edge i j = AdjacencyMatrix $ \a ->
-    if inRange (bounds a) ix && (a ! ix) 
+    if inRange (bounds a) ix && (a ! ix)
     then Just ix
     else Nothing
     where ix = (i, j)
diff --git a/src/Data/Graph/Algorithm.hs b/src/Data/Graph/Algorithm.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Algorithm.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE TypeFamilies #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Graph.Algorithm
+-- Copyright   :  (C) 2011 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  experimental
+-- Portability :  type families
+--
+-- Functions and data structures common to graph search algorithms
+----------------------------------------------------------------------------
+
+module Data.Graph.Algorithm
+  ( GraphSearch(..)
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+
+import Data.Graph.Class
+
+-- | Graph search visitor
+data GraphSearch g m = GraphSearch
+  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered
+  , enterEdge   :: Edge g   -> g m -- called the first time an edge is discovered, before enterVertex
+  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing
+  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex
+  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished
+  }
+
+instance Graph g => Functor (GraphSearch g) where
+  fmap f (GraphSearch a b c d e) = GraphSearch
+    (liftM f . a)
+    (liftM f . b)
+    (liftM f . c)
+    (liftM f . d)
+    (liftM f . e)
+
+instance Graph g => Applicative (GraphSearch g) where
+  pure a = GraphSearch
+    (const (return a))
+    (const (return a))
+    (const (return a))
+    (const (return a))
+    (const (return a))
+
+  m <*> n = GraphSearch
+    (\v -> enterVertex m v `ap` enterVertex n v)
+    (\e -> enterEdge m e `ap`   enterEdge n e)
+    (\e -> grayTarget m e `ap`  grayTarget n e)
+    (\v -> exitVertex m v `ap`  exitVertex n v)
+    (\e -> blackTarget m e `ap` blackTarget n e)
+
+instance Graph g => Monad (GraphSearch g) where
+  return = pure
+  m >>= f = GraphSearch
+    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)
+    (\e -> enterEdge m e >>= ($ e)   . enterEdge . f)
+    (\e -> grayTarget m e >>= ($ e)  . grayTarget . f)
+    (\v -> exitVertex m v >>= ($ v)  . exitVertex . f)
+    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)
+
+instance (Graph g, Monoid m) => Monoid (GraphSearch g m) where
+  mempty = return mempty
+  mappend = liftM2 mappend
diff --git a/src/Data/Graph/Algorithm/BreadthFirstSearch.hs b/src/Data/Graph/Algorithm/BreadthFirstSearch.hs
--- a/src/Data/Graph/Algorithm/BreadthFirstSearch.hs
+++ b/src/Data/Graph/Algorithm/BreadthFirstSearch.hs
@@ -13,10 +13,9 @@
 ----------------------------------------------------------------------------
 
 module Data.Graph.Algorithm.BreadthFirstSearch
-  ( bfs, Bfs(..)
+  ( bfs
   ) where
 
-import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.State.Strict
@@ -24,70 +23,26 @@
 import Data.Monoid
 import Data.Sequence
 
+import Data.Graph.Algorithm
 import Data.Graph.Class
 import Data.Graph.Class.AdjacencyList
 import Data.Graph.PropertyMap
 import Data.Graph.Internal.Color
 
--- | Breadth first search visitor 
-data Bfs g m = Bfs 
-  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered
-  , enterEdge   :: Edge g   -> g m -- called the first time an edge is discovered, before enter
-  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing
-  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex
-  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished
-  } 
-
-instance Graph g => Functor (Bfs g) where
-  fmap f (Bfs a b c d e) = Bfs
-    (liftM f . a)
-    (liftM f . b)
-    (liftM f . c)
-    (liftM f . d)
-    (liftM f . e)
-
-instance Graph g => Applicative (Bfs g) where
-  pure a = Bfs 
-    (const (return a))
-    (const (return a))
-    (const (return a))
-    (const (return a))
-    (const (return a))
-
-  m <*> n = Bfs
-    (\v -> enterVertex m v `ap` enterVertex n v)
-    (\e -> enterEdge m e `ap`   enterEdge n e)
-    (\e -> grayTarget m e `ap`  grayTarget n e)
-    (\v -> exitVertex m v `ap`  exitVertex n v)
-    (\e -> blackTarget m e `ap` blackTarget n e)
-
-instance Graph g => Monad (Bfs g) where
-  return = pure
-  m >>= f = Bfs
-    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)
-    (\e -> enterEdge m e >>= ($ e) . enterEdge . f)
-    (\e -> grayTarget m e >>= ($ e) . grayTarget . f)
-    (\v -> exitVertex m v >>= ($ v) . exitVertex . f)
-    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)
-
-instance (Graph g, Monoid m) => Monoid (Bfs g m) where
-  mempty = return mempty
-  mappend = liftM2 mappend
-
 getS :: Monad g => k -> StateT (Seq v, PropertyMap g k Color) g Color
 getS k = do
-  m <- gets snd 
+  m <- gets snd
   lift (getP m k)
 
 putS :: Monad g => k -> Color -> StateT (Seq v, PropertyMap g k Color) g ()
 putS k v = do
-  m <- gets snd 
+  m <- gets snd
   m' <- lift $ putP m k v
   modify $ \(q,_) -> (q, m')
 
-enqueue :: Graph g 
-        => Bfs g m 
-        -> Vertex g 
+enqueue :: Graph g
+        => GraphSearch g m
+        -> Vertex g
         -> StateT (Seq (Vertex g), PropertyMap g (Vertex g) Color) g m
 enqueue vis v = do
   m <- gets snd
@@ -102,14 +57,14 @@
     EmptyL -> ke
     (a :< q') -> put (q', m) >> ks a
 
-bfs :: (AdjacencyListGraph g, Monoid m) => Bfs g m -> Vertex g -> g m
+bfs :: (AdjacencyListGraph g, Monoid m) => GraphSearch g m -> Vertex g -> g m
 bfs vis v0 = do
-  m <- vertexMap White 
-  evalStateT (enqueue vis v0 >>= pump) (mempty, m) 
+  m <- vertexMap White
+  evalStateT (enqueue vis v0 >>= pump) (mempty, m)
   where
   pump lhs = dequeue (return lhs) $ \ v -> do
     adjs <- lift $ outEdges v
-    children <- foldrM 
+    children <- foldrM
       (\e m -> do
         v' <- target e
         color <- getS v'
@@ -119,5 +74,5 @@
           Black -> lift $ blackTarget vis e
       ) mempty adjs
     putS v Black
-    rhs <- lift $ exitVertex vis v 
+    rhs <- lift $ exitVertex vis v
     pump $ lhs `mappend` children `mappend` rhs
diff --git a/src/Data/Graph/Algorithm/DepthFirstSearch.hs b/src/Data/Graph/Algorithm/DepthFirstSearch.hs
--- a/src/Data/Graph/Algorithm/DepthFirstSearch.hs
+++ b/src/Data/Graph/Algorithm/DepthFirstSearch.hs
@@ -13,95 +13,51 @@
 ----------------------------------------------------------------------------
 
 module Data.Graph.Algorithm.DepthFirstSearch
-  ( dfs, Dfs(..)
+  ( dfs
   ) where
 
-import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.State.Strict
 import Data.Foldable
 import Data.Monoid
 
+import Data.Graph.Algorithm
 import Data.Graph.Class
 import Data.Graph.Class.AdjacencyList
 import Data.Graph.PropertyMap
 import Data.Graph.Internal.Color
 
-data Dfs g m = Dfs 
-  { enterVertex :: Vertex g -> g m -- called the first time a vertex is discovered
-  , enterEdge   :: Edge g   -> g m -- called the first time an edge is discovered, before enterVertex
-  , grayTarget  :: Edge g   -> g m -- called when we encounter a back edge to a vertex we're still processing
-  , exitVertex  :: Vertex g -> g m -- called once we have processed all descendants of a vertex
-  , blackTarget :: Edge g   -> g m -- called when we encounter a cross edge to a vertex we've already finished
-  }
-
-instance Graph g => Functor (Dfs g) where
-  fmap f (Dfs a b c d e) = Dfs
-    (liftM f . a)
-    (liftM f . b)
-    (liftM f . c)
-    (liftM f . d)
-    (liftM f . e)
-
-instance Graph g => Applicative (Dfs g) where
-  pure a = Dfs 
-    (const (return a))
-    (const (return a))
-    (const (return a))
-    (const (return a))
-    (const (return a))
-
-  m <*> n = Dfs
-    (\v -> enterVertex m v `ap` enterVertex n v)
-    (\e -> enterEdge m e `ap`   enterEdge n e)
-    (\e -> grayTarget m e `ap`  grayTarget n e)
-    (\v -> exitVertex m v `ap`  exitVertex n v)
-    (\e -> blackTarget m e `ap` blackTarget n e)
-
-instance Graph g => Monad (Dfs g) where
-  return = pure
-  m >>= f = Dfs
-    (\v -> enterVertex m v >>= ($ v) . enterVertex . f)
-    (\e -> enterEdge m e >>= ($ e) . enterEdge . f)
-    (\e -> grayTarget m e >>= ($ e) . grayTarget . f)
-    (\v -> exitVertex m v >>= ($ v) . exitVertex . f)
-    (\e -> blackTarget m e >>= ($ e) . blackTarget . f)
-
-instance (Graph g, Monoid m) => Monoid (Dfs g m) where
-  mempty = return mempty
-  mappend = liftM2 mappend
-
 getS :: Monad g => k -> StateT (PropertyMap g k v) g v
 getS k = do
-  m <- get 
+  m <- get
   lift (getP m k)
 
 putS :: Monad g => k -> v -> StateT (PropertyMap g k v) g ()
 putS k v = do
-  m <- get 
+  m <- get
   m' <- lift $ putP m k v
   put m'
 
 -- TODO: CPS transform?
-dfs :: (AdjacencyListGraph g, Monoid m) => Dfs g m -> Vertex g -> g m
+dfs :: (AdjacencyListGraph g, Monoid m) => GraphSearch g m -> Vertex g -> g m
 dfs vis v0 = do
-  m <- vertexMap White 
+  m <- vertexMap White
   evalStateT (go v0) m where
   go v = do
     putS v Grey
     lhs <- lift $ enterVertex vis v
-    adjs <- lift $ outEdges v 
-    result <- foldrM 
-      (\e m -> do 
+    adjs <- lift $ outEdges v
+    result <- foldrM
+      (\e m -> do
         v' <- target e
         color <- getS v'
-        liftM (`mappend` m) $ case color of
+        liftM (mappend m) $ case color of
           White -> (liftM2 mappend) (lift $ enterEdge vis e) (go v')
           Grey  -> lift $ grayTarget vis e
           Black -> lift $ blackTarget vis e
-      ) 
-      mempty 
+      )
+      mempty
       adjs
     putS v Black
     rhs <- lift $ exitVertex vis v
diff --git a/src/Data/Graph/Class.hs b/src/Data/Graph/Class.hs
--- a/src/Data/Graph/Class.hs
+++ b/src/Data/Graph/Class.hs
@@ -11,7 +11,7 @@
 --
 ----------------------------------------------------------------------------
 
-module Data.Graph.Class 
+module Data.Graph.Class
   ( Graph(..)
   , VertexMap
   , EdgeMap
@@ -29,7 +29,7 @@
 import Control.Monad.Trans.Identity
 import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.Error
-import Control.Monad.Trans.Reader 
+import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class
 import Data.Functor.Identity
 import Data.Monoid
@@ -41,16 +41,16 @@
 
 class (Monad g, Eq (Vertex g), Eq (Edge g)) => Graph g where
   type Vertex g :: *
-  type Edge g :: * 
+  type Edge g :: *
   vertexMap :: a -> g (VertexMap g a)
   edgeMap   :: a -> g (EdgeMap g a)
 
-liftVertexMap :: (MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g) 
+liftVertexMap :: (MonadTrans t, Graph (t g), Graph g, Vertex (t g) ~ Vertex g)
               => a -> t g (VertexMap (t g) a)
 liftVertexMap = lift . liftM liftPropertyMap . vertexMap
 {-# INLINE liftVertexMap #-}
 
-liftEdgeMap :: (MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g) 
+liftEdgeMap :: (MonadTrans t, Graph (t g), Graph g, Edge (t g) ~ Edge g)
             => a -> t g (EdgeMap (t g) a)
 liftEdgeMap = lift . liftM liftPropertyMap . edgeMap
 {-# INLINE liftEdgeMap #-}
@@ -80,7 +80,7 @@
   edgeMap = liftEdgeMap
 
 instance Graph g => Graph (ReaderT m g) where
-  type Vertex (ReaderT m g) = Vertex g 
+  type Vertex (ReaderT m g) = Vertex g
   type Edge (ReaderT m g) = Edge g
   vertexMap = liftVertexMap
   edgeMap = liftEdgeMap
@@ -122,6 +122,6 @@
 instance Graph Identity where
   type Vertex Identity = Void
   type Edge Identity = Void
-  vertexMap _ = Identity voidMap 
+  vertexMap _ = Identity voidMap
   edgeMap   _ = Identity voidMap
 
diff --git a/src/Data/Graph/Class/Bidirectional.hs b/src/Data/Graph/Class/Bidirectional.hs
--- a/src/Data/Graph/Class/Bidirectional.hs
+++ b/src/Data/Graph/Class/Bidirectional.hs
@@ -11,7 +11,7 @@
 --
 ----------------------------------------------------------------------------
 
-module Data.Graph.Class.Bidirectional 
+module Data.Graph.Class.Bidirectional
   ( BidirectionalGraph(..)
   , module Data.Graph.Class.AdjacencyList
   ) where
@@ -38,7 +38,7 @@
   -- /O(e)/
   inDegree :: Vertex g -> g Int
   inDegree v = length `liftM` inEdges v
-  
+
   incidentEdges :: Vertex g -> g [Edge g]
   incidentEdges v = liftM2 (++) (inEdges v) (outEdges v)
 
diff --git a/src/Data/Graph/Class/VertexEnumerable.hs b/src/Data/Graph/Class/VertexEnumerable.hs
--- a/src/Data/Graph/Class/VertexEnumerable.hs
+++ b/src/Data/Graph/Class/VertexEnumerable.hs
@@ -49,7 +49,7 @@
 
 instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Strict.RWST r m s g) where
   vertices = lift vertices
-  
+
 instance (VertexEnumerableGraph g, Monoid m) => VertexEnumerableGraph (Lazy.RWST r m s g) where
   vertices = lift vertices
 
diff --git a/src/Data/Graph/Dual.hs b/src/Data/Graph/Dual.hs
--- a/src/Data/Graph/Dual.hs
+++ b/src/Data/Graph/Dual.hs
@@ -67,7 +67,7 @@
   degree = Dual . degree
 
 instance EdgeEnumerableGraph g => EdgeEnumerableGraph (Dual g) where
-  edges = Dual edges 
+  edges = Dual edges
 
 instance VertexEnumerableGraph g => VertexEnumerableGraph (Dual g) where
   vertices = Dual vertices
diff --git a/src/Data/Graph/PropertyMap.hs b/src/Data/Graph/PropertyMap.hs
--- a/src/Data/Graph/PropertyMap.hs
+++ b/src/Data/Graph/PropertyMap.hs
@@ -12,7 +12,7 @@
 -- and edges in a graph
 ----------------------------------------------------------------------------
 
-module Data.Graph.PropertyMap 
+module Data.Graph.PropertyMap
   ( PropertyMap(..)
   , modifyP
   , intPropertyMap
@@ -38,7 +38,7 @@
 -- A pure IntMap-backed vertex map
 intPropertyMap :: Monad m => v -> PropertyMap m Int v
 intPropertyMap v0 = go v0 IntMap.empty where
-  go v m = PropertyMap 
+  go v m = PropertyMap
     { getP = \k -> return $ maybe v id (IntMap.lookup k m)
     , putP = \k v' -> return $ go v (IntMap.insert k v' m)
     }
@@ -46,24 +46,10 @@
 -- A pure Map-backed vertex map
 propertyMap :: (Monad m, Ord k) => v -> PropertyMap m k v
 propertyMap v0 = go v0 Map.empty where
-  go v m = PropertyMap 
+  go v m = PropertyMap
     { getP = \k -> return $ maybe v id (Map.lookup k m)
     , putP = \k v' -> return $ go v (Map.insert k v' m)
     }
 
 liftPropertyMap :: (MonadTrans t, Monad m, Monad (t m)) => PropertyMap m k v -> PropertyMap (t m) k v
 liftPropertyMap (PropertyMap g p) = PropertyMap (lift . g) (\k v -> liftPropertyMap `liftM` lift (p k v))
-
-{-
--- An impure STArray-backed vertex map
-stAdjVertexMap :: (DenseAdjacencyMatrix g, MonadST s g) => a -> g (PropertyMap g (Vertex g) a)
-stAdjVertexMap v0 = do
-  range <- vertexRange 
-  arr <- newSTArray range v0
-  return $ go arr
-  where
-    go arr = r where r = VertexMap
-      { getP = readSTArray arr
-      , putP = \k v -> writeSTArray arr k v >> return r
-      } 
--}