diff --git a/ChangeLog b/ChangeLog
new file mode 100644
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,3 @@
+0.1.0.0
+-------
+- Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013, Tristan Ravitch
+
+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 Tristan Ravitch 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/haggle.cabal b/haggle.cabal
new file mode 100644
--- /dev/null
+++ b/haggle.cabal
@@ -0,0 +1,68 @@
+name: haggle
+version: 0.1.0.0
+synopsis: A graph library offering mutable, immutable, and inductive graphs
+description: This library provides mutable (in ST or IO), immutable, and inductive graphs.
+             There are multiple graphs implementations provided to support different use
+             cases and time/space tradeoffs.  It is a design goal of haggle to be flexible
+             and allow users to "pay as they go".  Node and edge labels are optional.  Haggle
+             also aims to be safer than fgl: there are no partial functions in the API.
+
+license: BSD3
+license-file: LICENSE
+author: Tristan Ravitch
+maintainer: tristan@ravit.ch
+category: Data Structures, Graphs
+build-type: Simple
+cabal-version: >=1.10
+tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1
+extra-source-files: ChangeLog
+
+library
+  default-language: Haskell2010
+  hs-source-dirs: src
+  ghc-options: -Wall
+  if impl(ghc > 8)
+     ghc-options: -Wno-compat
+  exposed-modules: Data.Graph.Haggle,
+                   Data.Graph.Haggle.BiDigraph,
+                   Data.Graph.Haggle.Classes,
+                   Data.Graph.Haggle.Digraph,
+                   Data.Graph.Haggle.SimpleBiDigraph,
+                   Data.Graph.Haggle.PatriciaTree,
+                   Data.Graph.Haggle.LabelAdapter,
+                   Data.Graph.Haggle.VertexLabelAdapter,
+                   Data.Graph.Haggle.EdgeLabelAdapter,
+                   Data.Graph.Haggle.VertexMap,
+                   Data.Graph.Haggle.Algorithms.DFS,
+                   Data.Graph.Haggle.Algorithms.Dominators
+  other-modules: Data.Graph.Haggle.Internal.Adapter,
+                 Data.Graph.Haggle.Internal.Basic,
+                 Data.Graph.Haggle.Internal.BitSet
+  build-depends: base >= 4.5 && < 5,
+                 ref-tf >= 0.4 && < 0.5,
+                 vector >= 0.9 && < 0.13,
+                 primitive >= 0.4 && < 0.9,
+                 containers >= 0.4,
+                 hashable < 1.4,
+                 deepseq >= 1 && < 2,
+                 monad-primitive
+
+test-suite GraphTests
+  type: exitcode-stdio-1.0
+  default-language: Haskell2010
+  main-is: GraphTests.hs
+  hs-source-dirs: tests
+  ghc-options: -Wall
+  build-depends: haggle,
+                 base >= 4.5,
+                 containers,
+                 fgl,
+                 HUnit,
+                 QuickCheck > 2.4,
+                 test-framework,
+                 test-framework-hunit,
+                 test-framework-quickcheck2
+
+source-repository head
+  type: git
+  location: https://github.com/travitch/haggle
diff --git a/src/Data/Graph/Haggle.hs b/src/Data/Graph/Haggle.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle.hs
@@ -0,0 +1,385 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+-- | Haggle is a Haskell graph library.
+--
+-- The main idea behind haggle is that graphs are constructed with mutation
+-- (either in 'IO' or 'ST').  After the graph is constructed, it is frozen
+-- into an immutable graph.  This split is a major difference between
+-- haggle and the other major Haskell graph library, fgl, which is
+-- formulated in terms of inductive graphs that can always be modified
+-- in a purely-functional way.  Supporting the inductive graph interface
+-- severely limits implementation choices and optimization opportunities, so
+-- haggle tries a different approach.
+--
+-- Furthermore, the types of vertices (nodes in FGL) and edges are held
+-- as abstract in haggle, allowing for changes later if necessary.  That said,
+-- changes are unlikely and the representations are exposed (with no
+-- guarantees) through an Internal module.
+--
+-- Enough talk, example time:
+--
+-- > import Control.Monad ( replicateM )
+-- > import Data.Graph.Haggle
+-- > import Data.Graph.Haggle.Digraph
+-- > import Data.Graph.Haggle.Algorithms.DFS
+-- >
+-- > main :: IO ()
+-- > main = do
+-- >   g <- newMDigraph
+-- >   [v0, v1, v2] <- replicateM 3 (addVertex g)
+-- >   e1 <- addEdge g v0 v1
+-- >   e2 <- addEdge g v1 v2
+-- >   gi <- freeze g
+-- >   print (dfs gi v1) -- [V 1, V 2] since the first vertex is 0
+--
+-- The example builds a graph with three vertices and performs a DFS
+-- from the middle vertex.  Note that the DFS algorithm is implemented on
+-- immutable graphs, so we freeze the mutable graph before traversing it.  The
+-- graph type in this example is a directed graph.
+--
+-- There are other graph variants that support efficient access to predecessor
+-- edges: bidirectional graphs.  There are also simple graph variants that
+-- prohibit parallel edges.
+--
+-- The core graph implementations support only vertices and edges.  /Adapters/
+-- add support for 'Vertex' and 'Edge' labels.  See 'EdgeLabelAdapter',
+-- 'VertexLabelAdapter', and 'LabelAdapter' (which supports both).  This
+-- split allows the core implementations of graphs and graph algorithms to
+-- be fast and compact (since they do not need to allocate storage for or
+-- manipulate labels).  The adapters store labels on the side, similarly
+-- to the property maps of Boost Graph Library.  Also note that the adapters
+-- are strongly typed.  To add edges to a graph with edge labels, you must call
+-- 'addLabeledEdge' instead of 'addEdge'.  Likewise for graphs with vertex
+-- labels and 'addLabeledVertex'/'addVertex'.  This requirement is enforced
+-- in the type system so that labels cannot become out-of-sync with the
+-- structure of the graph.  The adapters each work with any type of underlying
+-- graph.
+module Data.Graph.Haggle (
+  -- * Graph types
+  -- ** Mutable graphs
+  D.MDigraph,
+  D.newMDigraph,
+  D.newSizedMDigraph,
+  B.MBiDigraph,
+  B.newMBiDigraph,
+  B.newSizedMBiDigraph,
+  SBD.MSimpleBiDigraph,
+  SBD.newMSimpleBiDigraph,
+  SBD.newSizedMSimpleBiDigraph,
+  -- *** Adapters
+  EA.EdgeLabeledMGraph,
+  EA.newEdgeLabeledGraph,
+  EA.newSizedEdgeLabeledGraph,
+  VA.VertexLabeledMGraph,
+  VA.newVertexLabeledGraph,
+  VA.newSizedVertexLabeledGraph,
+  A.LabeledMGraph,
+  A.newLabeledGraph,
+  A.newSizedLabeledGraph,
+  -- ** Immutable graphs
+  D.Digraph,
+  B.BiDigraph,
+  SBD.SimpleBiDigraph,
+  -- *** Adapters
+  EA.EdgeLabeledGraph,
+  VA.VertexLabeledGraph,
+  VA.fromEdgeList,
+  A.LabeledGraph,
+  A.fromLabeledEdgeList,
+  -- ** Inductive graphs
+  PT.PatriciaTree,
+  -- * Basic types
+  I.Vertex,
+  I.Edge,
+  I.edgeSource,
+  I.edgeDest,
+
+  -- * Mutable graph operations
+  getVertices,
+  getSuccessors,
+  getOutEdges,
+  countVertices,
+  countEdges,
+  checkEdgeExists,
+  freeze,
+
+  addVertex,
+  addEdge,
+
+  getEdgeLabel,
+  unsafeGetEdgeLabel,
+  addLabeledEdge,
+
+  getVertexLabel,
+  addLabeledVertex,
+  getLabeledVertices,
+
+  removeVertex,
+  removeEdgesBetween,
+  removeEdge,
+
+
+  getPredecessors,
+  getInEdges,
+
+  -- ** Mutable labeled graph operations
+  A.mapEdgeLabel,
+  A.mapVertexLabel,
+
+  -- * Immutable graph operations
+  vertices,
+  edges,
+  successors,
+  outEdges,
+  edgesBetween,
+  edgeExists,
+  isEmpty,
+  thaw,
+
+  predecessors,
+  inEdges,
+
+  edgeLabel,
+  labeledEdges,
+  labeledOutEdges,
+
+  vertexLabel,
+  labeledVertices,
+
+  labeledInEdges,
+
+  -- * Inductive graph operations
+  emptyGraph,
+  match,
+  context,
+  insertLabeledVertex,
+  insertLabeledEdge,
+  deleteEdge,
+  deleteEdgesBetween,
+  replaceLabeledEdge,
+  deleteVertex,
+  I.Context(..),
+
+  -- * Classes
+
+  -- | These classes are a critical implementation detail, but are
+  -- re-exported to simplify writing type signatures for generic
+  -- functions.
+  I.MGraph,
+  I.ImmutableGraph,
+  I.MAddVertex,
+  I.MAddEdge,
+  I.MLabeledEdge,
+  I.MEdgeLabel,
+  I.MLabeledVertex,
+  I.MVertexLabel,
+  I.MRemovable,
+  I.MBidirectional,
+  I.Graph,
+  I.Thawable,
+  I.MutableGraph,
+  I.Bidirectional,
+  I.HasEdgeLabel,
+  I.EdgeLabel,
+  I.HasVertexLabel,
+  I.VertexLabel,
+  I.BidirectionalEdgeLabel,
+  I.InductiveGraph
+  ) where
+
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+
+import qualified Data.Graph.Haggle.Classes as I
+import qualified Data.Graph.Haggle.Digraph as D
+import qualified Data.Graph.Haggle.BiDigraph as B
+import qualified Data.Graph.Haggle.SimpleBiDigraph as SBD
+import qualified Data.Graph.Haggle.PatriciaTree as PT
+
+import qualified Data.Graph.Haggle.EdgeLabelAdapter as EA
+import qualified Data.Graph.Haggle.VertexLabelAdapter as VA
+import qualified Data.Graph.Haggle.LabelAdapter as A
+
+-- Mutable graphs
+
+getVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> m [I.Vertex]
+getVertices = I.getVertices
+{-# INLINABLE getVertices #-}
+
+getSuccessors :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> m [I.Vertex]
+getSuccessors = I.getSuccessors
+{-# INLINABLE getSuccessors #-}
+
+getOutEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> m [I.Edge]
+getOutEdges = I.getOutEdges
+{-# INLINABLE getOutEdges #-}
+
+countVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> m Int
+countVertices = I.countVertices
+{-# INLINABLE countVertices #-}
+
+countEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> m Int
+countEdges = I.countEdges
+{-# INLINABLE countEdges #-}
+
+checkEdgeExists :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> I.Vertex -> m Bool
+checkEdgeExists = I.checkEdgeExists
+{-# INLINABLE checkEdgeExists #-}
+
+freeze :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => g m -> m (I.ImmutableGraph g)
+freeze = I.freeze
+{-# INLINABLE freeze #-}
+
+addVertex :: (I.MAddVertex g, P.PrimMonad m, R.MonadRef m) => g m -> m I.Vertex
+addVertex = I.addVertex
+{-# INLINABLE addVertex #-}
+
+addEdge :: (I.MAddEdge g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> I.Vertex -> m (Maybe I.Edge)
+addEdge = I.addEdge
+{-# INLINABLE addEdge #-}
+
+getEdgeLabel :: (I.MLabeledEdge g, P.PrimMonad m, R.MonadRef m) => g m -> I.Edge -> m (Maybe (I.MEdgeLabel g))
+getEdgeLabel = I.getEdgeLabel
+{-# INLINABLE getEdgeLabel #-}
+
+unsafeGetEdgeLabel :: (I.MLabeledEdge g, P.PrimMonad m, R.MonadRef m) => g m -> I.Edge -> m (I.MEdgeLabel g)
+unsafeGetEdgeLabel = I.unsafeGetEdgeLabel
+{-# INLINABLE unsafeGetEdgeLabel #-}
+
+addLabeledEdge :: (I.MLabeledEdge g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> I.Vertex -> I.MEdgeLabel g -> m (Maybe I.Edge)
+addLabeledEdge = I.addLabeledEdge
+{-# INLINABLE addLabeledEdge #-}
+
+getVertexLabel :: (I.MLabeledVertex g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> m (Maybe (I.MVertexLabel g))
+getVertexLabel = I.getVertexLabel
+{-# INLINABLE getVertexLabel #-}
+
+addLabeledVertex :: (I.MLabeledVertex g, P.PrimMonad m, R.MonadRef m) => g m -> I.MVertexLabel g -> m I.Vertex
+addLabeledVertex = I.addLabeledVertex
+{-# INLINABLE addLabeledVertex #-}
+
+getLabeledVertices :: (I.MLabeledVertex g, P.PrimMonad m, R.MonadRef m) => g m -> m [(I.Vertex, I.MVertexLabel g)]
+getLabeledVertices = I.getLabeledVertices
+{-# INLINABLE getLabeledVertices #-}
+
+removeVertex :: (I.MRemovable g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> m ()
+removeVertex = I.removeVertex
+{-# INLINABLE removeVertex #-}
+
+removeEdgesBetween :: (I.MRemovable g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> I.Vertex -> m ()
+removeEdgesBetween = I.removeEdgesBetween
+{-# INLINABLE removeEdgesBetween #-}
+
+removeEdge :: (I.MRemovable g, P.PrimMonad m, R.MonadRef m) => g m -> I.Edge -> m ()
+removeEdge = I.removeEdge
+{-# INLINABLE removeEdge #-}
+
+getPredecessors :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> m [I.Vertex]
+getPredecessors = I.getPredecessors
+{-# INLINABLE getPredecessors #-}
+
+getInEdges :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m) => g m -> I.Vertex -> m [I.Edge]
+getInEdges = I.getInEdges
+{-# INLINABLE getInEdges #-}
+
+-- Immutable graphs
+
+vertices :: (I.Graph g) => g -> [I.Vertex]
+vertices = I.vertices
+{-# INLINABLE vertices #-}
+
+edges :: (I.Graph g) => g -> [I.Edge]
+edges = I.edges
+{-# INLINABLE edges #-}
+
+successors :: (I.Graph g) => g -> I.Vertex -> [I.Vertex]
+successors = I.successors
+{-# INLINABLE successors #-}
+
+outEdges :: (I.Graph g) => g -> I.Vertex -> [I.Edge]
+outEdges = I.outEdges
+{-# INLINABLE outEdges #-}
+
+edgesBetween :: (I.Graph g) => g -> I.Vertex -> I.Vertex -> [I.Edge]
+edgesBetween = I.edgesBetween
+{-# INLINABLE edgesBetween #-}
+
+edgeExists :: (I.Graph g) => g -> I.Vertex -> I.Vertex -> Bool
+edgeExists = I.edgeExists
+{-# INLINABLE edgeExists #-}
+
+isEmpty :: (I.Graph g) => g -> Bool
+isEmpty = I.isEmpty
+{-# INLINABLE isEmpty #-}
+
+thaw :: (I.Thawable g, P.PrimMonad m, R.MonadRef m) => g -> m (I.MutableGraph g m)
+thaw = I.thaw
+{-# INLINABLE thaw #-}
+
+predecessors :: (I.Bidirectional g) => g -> I.Vertex -> [I.Vertex]
+predecessors = I.predecessors
+{-# INLINABLE predecessors #-}
+
+inEdges :: (I.Bidirectional g) => g -> I.Vertex -> [I.Edge]
+inEdges = I.inEdges
+{-# INLINABLE inEdges #-}
+
+edgeLabel :: (I.HasEdgeLabel g) => g -> I.Edge -> Maybe (I.EdgeLabel g)
+edgeLabel = I.edgeLabel
+{-# INLINABLE edgeLabel #-}
+
+labeledEdges :: (I.HasEdgeLabel g) => g -> [(I.Edge, I.EdgeLabel g)]
+labeledEdges = I.labeledEdges
+{-# INLINABLE labeledEdges #-}
+
+labeledOutEdges :: (I.HasEdgeLabel g) => g -> I.Vertex -> [(I.Edge, I.EdgeLabel g)]
+labeledOutEdges = I.labeledOutEdges
+{-# INLINABLE labeledOutEdges #-}
+
+labeledInEdges :: (I.BidirectionalEdgeLabel g) => g -> I.Vertex -> [(I.Edge, I.EdgeLabel g)]
+labeledInEdges = I.labeledInEdges
+{-# INLINABLE labeledInEdges #-}
+
+vertexLabel :: (I.HasVertexLabel g) => g -> I.Vertex -> Maybe (I.VertexLabel g)
+vertexLabel = I.vertexLabel
+{-# INLINABLE vertexLabel #-}
+
+labeledVertices :: (I.HasVertexLabel g) => g -> [(I.Vertex, I.VertexLabel g)]
+labeledVertices = I.labeledVertices
+{-# INLINABLE labeledVertices #-}
+
+emptyGraph :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g
+emptyGraph = I.emptyGraph
+{-# INLINABLE emptyGraph #-}
+
+match :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Vertex -> Maybe (I.Context g, g)
+match = I.match
+{-# INLINABLE match #-}
+
+context :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Vertex -> Maybe (I.Context g)
+context = I.context
+{-# INLINABLE context #-}
+
+insertLabeledVertex :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.VertexLabel g -> (I.Vertex, g)
+insertLabeledVertex = I.insertLabeledVertex
+{-# INLINABLE insertLabeledVertex #-}
+
+insertLabeledEdge :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Vertex -> I.Vertex -> I.EdgeLabel g -> Maybe (I.Edge, g)
+insertLabeledEdge = I.insertLabeledEdge
+{-# INLINABLE insertLabeledEdge #-}
+
+deleteEdge :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Edge -> g
+deleteEdge = I.deleteEdge
+{-# INLINABLE deleteEdge #-}
+
+deleteEdgesBetween :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Vertex -> I.Vertex -> g
+deleteEdgesBetween = I.deleteEdgesBetween
+{-# INLINABLE deleteEdgesBetween #-}
+
+replaceLabeledEdge :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Vertex -> I.Vertex -> I.EdgeLabel g -> Maybe (I.Edge, g)
+replaceLabeledEdge = I.replaceLabeledEdge
+{-# INLINABLE replaceLabeledEdge #-}
+
+deleteVertex :: (I.InductiveGraph g, I.Graph g, I.HasEdgeLabel g, I.HasVertexLabel g) => g -> I.Vertex -> g
+deleteVertex = I.deleteVertex
+{-# INLINABLE deleteVertex #-}
diff --git a/src/Data/Graph/Haggle/Algorithms/DFS.hs b/src/Data/Graph/Haggle/Algorithms/DFS.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Algorithms/DFS.hs
@@ -0,0 +1,213 @@
+-- | Depth-first search and derived operations.
+--
+-- All of the search variants take a list of 'Vertex' that serves as
+-- roots for the search.
+--
+-- The [x] variants ('xdfsWith' and 'xdffWith') are the most general
+-- and are fully configurable in direction and action.  They take a
+-- \"direction\" function that tells the search what vertices are
+-- next from the current 'Vertex'.  They also take a summarization function
+-- to convert a 'Vertex' into some other value.  This could be 'id' or a
+-- function to extract a label, if supported by your graph type.
+--
+-- The [r] variants are reverse searches, while the [u] variants are
+-- undirected.
+--
+-- A depth-first forest is a collection (list) of depth-first trees.  A
+-- depth-first tree is an n-ary tree rooted at a vertex that contains
+-- the vertices reached in a depth-first search from that root.  The
+-- edges in the tree are a subset of the edges in the graph.
+module Data.Graph.Haggle.Algorithms.DFS (
+  -- * Depth-first Searches
+  xdfsWith,
+  dfsWith,
+  dfs,
+  rdfsWith,
+  rdfs,
+  udfsWith,
+  udfs,
+  -- * Depth-first Forests
+  xdffWith,
+  dffWith,
+  dff,
+  rdffWith,
+  rdff,
+  udffWith,
+  udff,
+  -- * Derived Queries
+  components,
+  noComponents,
+  isConnected,
+  topsort,
+  scc,
+  reachable
+  ) where
+
+import Control.Monad ( filterM, foldM, liftM )
+import Control.Monad.ST
+import qualified Data.Foldable as F
+import Data.Monoid
+import qualified Data.Sequence as Seq
+import Data.Tree ( Tree )
+import qualified Data.Tree as T
+
+import Prelude
+
+import Data.Graph.Haggle
+import Data.Graph.Haggle.Classes ( maxVertexId )
+import Data.Graph.Haggle.Internal.Basic
+import Data.Graph.Haggle.Internal.BitSet
+
+-- | The most general DFS
+xdfsWith :: (Graph g)
+         => g
+         -> (Vertex -> [Vertex])
+         -> (Vertex -> c)
+         -> [Vertex]
+         -> [c]
+xdfsWith g nextVerts f roots
+  | isEmpty g || null roots = []
+  | otherwise = runST $ do
+    bs <- newBitSet (maxVertexId g + 1)
+    res <- foldM (go bs) [] roots
+    return $ reverse res
+  where
+    go bs acc v = do
+      isMarked <- testBit bs (vertexId v)
+      case isMarked of
+        True -> return acc
+        False -> do
+          setBit bs (vertexId v)
+          nxt <- filterM (notVisited bs) (nextVerts v)
+          foldM (go bs) (f v : acc) nxt
+
+notVisited :: BitSet s -> Vertex -> ST s Bool
+notVisited bs v = liftM not (testBit bs (vertexId v))
+
+-- | Forward parameterized DFS
+dfsWith :: (Graph g)
+        => g
+        -> (Vertex -> c)
+        -> [Vertex]
+        -> [c]
+dfsWith g = xdfsWith g (successors g)
+
+-- | Forward DFS
+dfs :: (Graph g) => g -> [Vertex] -> [Vertex]
+dfs g = dfsWith g id
+
+-- | Reverse parameterized DFS
+rdfsWith :: (Bidirectional g)
+         => g
+         -> (Vertex -> c)
+         -> [Vertex]
+         -> [c]
+rdfsWith g = xdfsWith g (predecessors g)
+
+-- | Reverse DFS
+rdfs :: (Bidirectional g) => g -> [Vertex] -> [Vertex]
+rdfs g = rdfsWith g id
+
+-- | Undirected parameterized DFS.  This variant follows both
+-- incoming and outgoing edges from each 'Vertex'.
+udfsWith :: (Bidirectional g)
+         => g
+         -> (Vertex -> c)
+         -> [Vertex]
+         -> [c]
+udfsWith g = xdfsWith g (neighbors g)
+
+-- | Undirected DFS
+udfs :: (Bidirectional g) => g -> [Vertex] -> [Vertex]
+udfs g = udfsWith g id
+
+-- | The most general depth-first forest.
+xdffWith :: (Graph g)
+         => g
+         -> (Vertex -> [Vertex])
+         -> (Vertex -> c)
+         -> [Vertex]
+         -> [Tree c]
+xdffWith g nextVerts f roots
+  | isEmpty g || null roots = []
+  | otherwise = runST $ do
+    bs <- newBitSet (maxVertexId g + 1)
+    res <- foldM (go bs) [] roots
+    return $ reverse res
+  where
+    go bs acc v = do
+      isMarked <- testBit bs (vertexId v)
+      case isMarked of
+        True -> return acc
+        False -> do
+          setBit bs (vertexId v)
+          nxt <- filterM (notVisited bs) (nextVerts v)
+          ts <- foldM (go bs) [] nxt
+          return $ T.Node (f v) (reverse ts) : acc
+
+dffWith :: (Graph g)
+        => g
+        -> (Vertex -> c)
+        -> [Vertex]
+        -> [Tree c]
+dffWith g = xdffWith g (successors g)
+
+dff :: (Graph g) => g -> [Vertex] -> [Tree Vertex]
+dff g = dffWith g id
+
+rdffWith :: (Bidirectional g) => g -> (Vertex -> c) -> [Vertex] -> [Tree c]
+rdffWith g = xdffWith g (predecessors g)
+
+rdff :: (Bidirectional g) => g -> [Vertex] -> [Tree Vertex]
+rdff g = rdffWith g id
+
+udffWith :: (Bidirectional g) => g -> (Vertex -> c) -> [Vertex] -> [Tree c]
+udffWith g = xdffWith g (neighbors g)
+
+udff :: (Bidirectional g) => g -> [Vertex] -> [Tree Vertex]
+udff g = udffWith g id
+
+-- Derived
+
+-- | Return a list of each connected component in the graph
+components :: (Bidirectional g) => g -> [[Vertex]]
+components g = map preorder $ udff g (vertices g)
+
+-- | The number of components in the graph
+noComponents :: (Bidirectional g) => g -> Int
+noComponents = length . components
+
+-- | True if there is only a single component in the graph.
+isConnected :: (Bidirectional g) => g -> Bool
+isConnected = (==1) . noComponents
+
+-- | Topologically sort the graph; the input must be a DAG.
+topsort :: (Graph g) => g -> [Vertex]
+topsort g = reverse $ F.toList $ postflattenF $ dff g (vertices g)
+
+-- | Return a list of each /strongly-connected component/ in the graph.
+-- In a strongly-connected component, every vertex is reachable from every
+-- other vertex.
+scc :: (Bidirectional g) => g -> [[Vertex]]
+scc g = map preorder (rdff g (topsort g))
+
+-- | Compute the set of vertices reachable from a root 'Vertex'.
+reachable :: (Graph g) => Vertex -> g -> [Vertex]
+reachable v g = preorderF (dff g [v])
+
+-- Helpers
+
+neighbors :: (Bidirectional g) => g -> Vertex -> [Vertex]
+neighbors g v = successors g v ++ predecessors g v
+
+preorder :: Tree a -> [a]
+preorder = T.flatten
+
+preorderF :: [Tree a] -> [a]
+preorderF = concatMap preorder
+
+postflatten :: Tree a -> Seq.Seq a
+postflatten (T.Node v ts) = postflattenF ts <> Seq.singleton v
+
+postflattenF :: [Tree a] -> Seq.Seq a
+postflattenF = F.foldMap postflatten
diff --git a/src/Data/Graph/Haggle/Algorithms/Dominators.hs b/src/Data/Graph/Haggle/Algorithms/Dominators.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Algorithms/Dominators.hs
@@ -0,0 +1,149 @@
+-- | Compute the dominators in a graph from a root node.
+--
+-- The set of dominators for a 'Vertex' in a graph is always with regard
+-- to a @root@ 'Vertex', given as input to the algorithm.  'Vertex' @d@
+-- dominates 'Vertex' @v@ if every path from the @root@ to @v@ must go
+-- through @d@.  @d@ strictly dominates @v@ if @d@ dominates @v@ and is not
+-- @v@.  The immediate dominator of @v@ is the unique 'Vertex' that strictly
+-- dominates @v@ and does not strictly dominate any other 'Vertex' that
+-- dominates @v@.
+--
+-- This implementation is ported from FGL (<http://hackage.haskell.org/package/fgl>)
+-- and is substantially similar.  The major change is that it uses the vector
+-- library instead of array.
+--
+-- The algorithm is based on \"A Simple, Fast Dominance Algorithm\" by
+-- Cooper, Harvey, and Kennedy
+--
+-- <http://www.cs.rice.edu/~keith/EMBED/dom.pdf>
+--
+-- This is not Tarjan's algorithm; supposedly this is faster in practice
+-- for most graphs.
+module Data.Graph.Haggle.Algorithms.Dominators (
+  immediateDominators,
+  dominators
+  ) where
+
+import Data.Map ( Map )
+import qualified Data.Map as M
+import Data.Maybe ( fromMaybe )
+import Data.Set ( Set )
+import qualified Data.Set as S
+import Data.Tree ( Tree(..) )
+import qualified Data.Tree as T
+import Data.Vector ( Vector, (!) )
+import qualified Data.Vector as V
+
+import Data.Graph.Haggle
+import Data.Graph.Haggle.Algorithms.DFS
+
+type ToNode = Vector Vertex
+type FromNode = Map Vertex Int
+type IDom = Vector Int
+type Preds = Vector [Int]
+
+-- | Compute the immediate dominators in the graph from the @root@ 'Vertex'.
+-- Each 'Vertex' reachable from the @root@ will be paired with its immediate
+-- dominator.  Note that there is no entry in the result pairing for the
+-- root 'Vertex' because it has no immediate dominator.
+--
+-- If the root vertex is not in the graph, an empty list is returned.
+immediateDominators :: (Graph g) => g -> Vertex -> [(Vertex, Vertex)]
+immediateDominators g root = fromMaybe [] $ do
+  (res, toNode, _) <- domWork g root
+  return $ tail $ V.toList $ V.imap (\i n -> (toNode!i, toNode!n)) res
+
+-- | Compute all of the dominators for each 'Vertex' reachable from the @root@.
+-- Each reachable 'Vertex' is paired with the list of nodes that dominate it,
+-- including the 'Vertex' itself.  The @root@ is only dominated by itself.
+dominators :: (Graph g) => g -> Vertex -> [(Vertex, [Vertex])]
+dominators g root = fromMaybe [] $ do
+  (res, toNode, fromNode) <- domWork g root
+  let dom' = getDom toNode res
+      rest = M.keys (M.filter (-1 ==) fromNode)
+      verts = vertices g
+  return $ [(toNode ! i, dom' ! i) | i <- [0..V.length dom' - 1]] ++
+           [(n, verts) | n <- rest]
+
+domWork :: (Graph g) => g -> Vertex -> Maybe (IDom, ToNode, FromNode)
+domWork g root
+  | null trees = Nothing
+  | otherwise = return (idom, toNode, fromNode)
+  where
+    -- Build up a depth-first tree from the root as a first approximation
+    trees@(~[tree]) = dff g [root]
+    (s, ntree) = numberTree 0 tree
+    -- Start with an approximation (idom0) where the idom of each node is
+    -- its parent in the depth-first tree.  Note that index 0 is the root,
+    -- which we will basically be ignoring (since it has no dominator).
+    dom0Map = M.fromList (treeEdges (-1) ntree)
+    idom0 = V.generate (M.size dom0Map) (dom0Map M.!)
+    -- Build a mapping from graph vertices to internal indices.  @treeNodes@
+    -- are nodes that are in the depth-first tree from the root.  @otherNodes@
+    -- are the rest of the nodes in the graph, mapped to -1 (since they aren't
+    -- going to be in the result)
+    treeNodes = M.fromList $ zip (T.flatten tree) (T.flatten ntree)
+    otherNodes = M.fromList $ zip (vertices g) (repeat (-1))
+    fromNode = M.unionWith const treeNodes otherNodes
+    -- Translate from internal nodes back to graph nodes (only need the nodes
+    -- in the depth-first tree)
+    toNodeMap = M.fromList $ zip (T.flatten ntree) (T.flatten tree)
+    toNode = V.generate (M.size toNodeMap) (toNodeMap M.!)
+
+    -- Use a pre-pass over the graph to collect predecessors so that we don't
+    -- require a Bidirectional graph.  We need a linear pass over the graph
+    -- here anyway, so we don't lose anything.
+    predMap = fmap S.toList $ foldr (toPredecessor g) M.empty (vertices g)
+    preds = V.fromList $ [0] : [filter (/= -1) (map (fromNode M.!) (predMap M.! (toNode ! i)))
+                               | i <- [1..s-1]]
+    idom = fixEq (refineIDom preds) idom0
+
+toPredecessor :: (Graph g)
+              => g
+              -> Vertex
+              -> Map Vertex (Set Vertex)
+              -> Map Vertex (Set Vertex)
+toPredecessor g pre m = foldr addPred m (successors g pre)
+  where
+    addPred suc = M.insertWith S.union suc (S.singleton pre)
+
+refineIDom :: Preds -> IDom -> IDom
+refineIDom preds idom = fmap (foldl1 (intersect idom)) preds
+
+intersect :: IDom -> Int -> Int -> Int
+intersect idom a b =
+  case a `compare` b of
+    LT -> intersect idom a (idom ! b)
+    EQ -> a
+    GT -> intersect idom (idom ! a) b
+
+-- Helpers
+
+getDom :: ToNode -> IDom -> Vector [Vertex]
+getDom toNode idom = res
+  where
+    -- The root dominates itself (the only dominator for the root)
+    root = [toNode ! 0]
+    res = V.fromList $ root : [toNode ! i : res ! (idom ! i) | i <- [1..V.length idom - 1]]
+
+treeEdges :: a -> Tree a -> [(a,a)]
+treeEdges a (Node b ts) = (b,a) : concatMap (treeEdges b) ts
+
+-- relabel tree, labeling vertices with consecutive numbers in depth first order
+numberTree :: Int -> Tree a -> (Int, Tree Int)
+numberTree n (Node _ ts) = let (n', ts') = numberForest (n+1) ts
+                           in  (n', Node n ts')
+
+-- same as numberTree, for forests.
+numberForest :: Int -> [Tree a] -> (Int, [Tree Int])
+numberForest n []     = (n, [])
+numberForest n (t:ts) = let (n', t')   = numberTree n t
+                            (n'', ts') = numberForest n' ts
+                        in  (n'', t':ts')
+
+fixEq :: Eq a => (a -> a) -> a -> a
+fixEq f v
+  | v' == v   = v
+  | otherwise = fixEq f v'
+  where
+    v' = f v
diff --git a/src/Data/Graph/Haggle/BiDigraph.hs b/src/Data/Graph/Haggle/BiDigraph.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/BiDigraph.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE TypeFamilies #-}
+-- | This graph is an efficient representation of bidirectional graphs with
+-- parallel edges.
+--
+-- This is in contrast to 'Data.Graph.Haggle.SimpleBiDigraph', which
+-- can only handle simple graphs (i.e., without parallel edges).
+--
+-- The representation is slightly less efficient as a result.
+module Data.Graph.Haggle.BiDigraph (
+  MBiDigraph,
+  BiDigraph,
+  newMBiDigraph,
+  newSizedMBiDigraph
+  ) where
+
+import Control.Monad ( when )
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import Data.IntMap ( IntMap )
+import qualified Data.IntMap as IM
+import qualified Data.Vector.Mutable as MV
+import qualified Data.Vector as V
+
+import Data.Graph.Haggle.Classes
+import Data.Graph.Haggle.Internal.Basic
+
+-- | A mutable bidirectional graph
+data MBiDigraph m =
+  MBiDigraph { mgraphVertexCount :: R.Ref m Int
+             , mgraphEdgeCount :: R.Ref m Int
+             , mgraphEdgeIdSrc :: R.Ref m Int
+             , mgraphPreds :: R.Ref m (MV.MVector (P.PrimState m) (IntMap [Edge]))
+             , mgraphSuccs :: R.Ref m (MV.MVector (P.PrimState m) (IntMap [Edge]))
+             }
+
+-- | An immutable bidirectional graph
+data BiDigraph =
+  BiDigraph { vertexCount :: {-# UNPACK #-} !Int
+            , edgeCount :: {-# UNPACK #-} !Int
+            , edgeIdSrc :: {-# UNPACK #-} !Int
+            , graphPreds :: V.Vector (IntMap [Edge])
+            , graphSuccs :: V.Vector (IntMap [Edge])
+            }
+
+
+defaultSize :: Int
+defaultSize = 128
+
+-- | Allocate a new mutable bidirectional graph with a default size
+newMBiDigraph :: (P.PrimMonad m, R.MonadRef m) => m (MBiDigraph m)
+newMBiDigraph = newSizedMBiDigraph defaultSize 0
+
+-- | Allocate a new mutable bidirectional graph with space reserved
+-- for nodes and edges.  This can be more efficient and avoid resizing.
+newSizedMBiDigraph :: (P.PrimMonad m, R.MonadRef m)
+                   => Int -- ^ Reserved space for nodes
+                   -> Int -- ^ Reserved space for edges
+                   -> m (MBiDigraph m)
+newSizedMBiDigraph szNodes _ = do
+  when (szNodes < 0) $ error "newSizedMBiDigraph: Negative size"
+  nn <- R.newRef 0
+  en <- R.newRef 0
+  esrc <- R.newRef 0
+  pvec <- MV.new szNodes
+  svec <- MV.new szNodes
+  pref <- R.newRef pvec
+  sref <- R.newRef svec
+  return $! MBiDigraph { mgraphVertexCount = nn
+                       , mgraphEdgeCount = en
+                       , mgraphEdgeIdSrc = esrc
+                       , mgraphPreds = pref
+                       , mgraphSuccs = sref
+                       }
+
+instance MGraph MBiDigraph where
+  type ImmutableGraph MBiDigraph = BiDigraph
+  getVertices g = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    return [ V v | v <- [0.. nVerts - 1] ]
+
+  getOutEdges g (V src) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case src >= nVerts of
+      True -> return []
+      False -> do
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        return $ concat (IM.elems succs)
+  countVertices = R.readRef . mgraphVertexCount
+  countEdges = R.readRef . mgraphEdgeCount
+
+  getSuccessors g (V src) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case src >= nVerts of
+      True -> return []
+      False -> do
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        return $ map V $ IM.keys succs
+
+  checkEdgeExists g (V src) (V dst) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case src >= nVerts || dst >= nVerts of
+      True -> return False
+      False -> do
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        return $ IM.member dst succs
+
+  freeze g = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    nEdges <- R.readRef (mgraphEdgeCount g)
+    esrc <- R.readRef (mgraphEdgeIdSrc g)
+    pvec <- R.readRef (mgraphPreds g)
+    svec <- R.readRef (mgraphSuccs g)
+    pvec' <- V.freeze (MV.take nVerts pvec)
+    svec' <- V.freeze (MV.take nVerts svec)
+    return $! BiDigraph { vertexCount = nVerts
+                        , edgeCount = nEdges
+                        , edgeIdSrc = esrc
+                        , graphPreds = pvec'
+                        , graphSuccs = svec'
+                        }
+
+instance MAddVertex MBiDigraph where
+  addVertex g = do
+    ensureNodeSpace g
+    vid <- R.readRef r
+    R.modifyRef' r (+1)
+    pvec <- R.readRef (mgraphPreds g)
+    svec <- R.readRef (mgraphSuccs g)
+    MV.write pvec vid IM.empty
+    MV.write svec vid IM.empty
+    return (V vid)
+    where
+      r = mgraphVertexCount g
+
+
+instance MAddEdge MBiDigraph where
+  addEdge g v1@(V src) v2@(V dst) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    exists <- checkEdgeExists g v1 v2
+    case exists || src >= nVerts || dst >= nVerts of
+      True -> return Nothing
+      False -> do
+        eid <- R.readRef (mgraphEdgeIdSrc g)
+        R.modifyRef' (mgraphEdgeIdSrc g) (+1)
+        R.modifyRef' (mgraphEdgeCount g) (+1)
+        let e = E eid src dst
+        pvec <- R.readRef (mgraphPreds g)
+        preds <- MV.unsafeRead pvec dst
+        MV.unsafeWrite pvec dst (IM.insertWith (++) src [e] preds)
+
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        MV.unsafeWrite svec src (IM.insertWith (++) dst [e] succs)
+
+        return $ Just e
+
+instance MBidirectional MBiDigraph where
+  getPredecessors g (V vid) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case vid < nVerts of
+      False -> return []
+      True -> do
+        pvec <- R.readRef (mgraphPreds g)
+        preds <- MV.unsafeRead pvec vid
+        return $ map V $ IM.keys preds
+
+  getInEdges g (V vid) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case vid < nVerts of
+      False -> return []
+      True -> do
+        pvec <- R.readRef (mgraphPreds g)
+        preds <- MV.unsafeRead pvec vid
+        return $ concat (IM.elems preds)
+
+instance Thawable BiDigraph where
+  type MutableGraph BiDigraph = MBiDigraph
+  thaw g = do
+    vc <- R.newRef (vertexCount g)
+    ec <- R.newRef (edgeCount g)
+    eidsrc <- R.newRef (edgeIdSrc g)
+    pvec <- V.thaw (graphPreds g)
+    svec <- V.thaw (graphSuccs g)
+    pref <- R.newRef pvec
+    sref <- R.newRef svec
+    return MBiDigraph { mgraphVertexCount = vc
+                      , mgraphEdgeCount = ec
+                      , mgraphEdgeIdSrc = eidsrc
+                      , mgraphPreds = pref
+                      , mgraphSuccs = sref
+                      }
+
+instance Graph BiDigraph where
+  vertices g = map V [0 .. vertexCount g - 1]
+  edges g = concatMap (outEdges g) (vertices g)
+  successors g (V v)
+    | outOfRange g v = []
+    | otherwise = map V $ IM.keys $ V.unsafeIndex (graphSuccs g) v
+  outEdges g (V v)
+    | outOfRange g v = []
+    | otherwise =
+      let succs = V.unsafeIndex (graphSuccs g) v
+      in concat (IM.elems succs)
+  edgesBetween g (V src) (V dst)
+    | outOfRange g src || outOfRange g dst = []
+    | otherwise = IM.findWithDefault [] dst (V.unsafeIndex (graphSuccs g) src)
+  maxVertexId g = V.length (graphSuccs g) - 1
+  isEmpty = (==0) . vertexCount
+
+instance Bidirectional BiDigraph  where
+  predecessors g (V v)
+    | outOfRange g v = []
+    | otherwise = map V $ IM.keys $ V.unsafeIndex (graphPreds g) v
+  inEdges g (V v)
+    | outOfRange g v = []
+    | otherwise =
+      let preds = V.unsafeIndex (graphPreds g) v
+      in concat (IM.elems preds)
+
+-- Helpers
+
+outOfRange :: BiDigraph -> Int -> Bool
+outOfRange g = (>= vertexCount g)
+
+-- | Given a graph, ensure that there is space in the vertex vector
+-- for a new vertex.  If there is not, double the capacity.
+ensureNodeSpace :: (P.PrimMonad m, R.MonadRef m) => MBiDigraph m -> m ()
+ensureNodeSpace g = do
+  pvec <- R.readRef (mgraphPreds g)
+  svec <- R.readRef (mgraphSuccs g)
+  let cap = MV.length pvec
+  cnt <- R.readRef (mgraphVertexCount g)
+  case cnt < cap of
+    True -> return ()
+    False -> do
+      pvec' <- MV.grow pvec cap
+      svec' <- MV.grow svec cap
+      R.writeRef (mgraphPreds g) pvec'
+      R.writeRef (mgraphSuccs g) svec'
+
diff --git a/src/Data/Graph/Haggle/Classes.hs b/src/Data/Graph/Haggle/Classes.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Classes.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+module Data.Graph.Haggle.Classes (
+  -- * Basic Types
+  Vertex,
+  Edge,
+  edgeSource,
+  edgeDest,
+  -- * Mutable Graphs
+  MGraph(..),
+  MAddEdge(..),
+  MAddVertex(..),
+  MRemovable(..),
+  MBidirectional(..),
+  MLabeledEdge(..),
+  MLabeledVertex(..),
+  -- * Immutable Graphs
+  Graph(..),
+  edgeExists,
+  Thawable(..),
+  Bidirectional(..),
+  HasEdgeLabel(..),
+  HasVertexLabel(..),
+  BidirectionalEdgeLabel(..),
+  -- * Inductive Graphs
+  InductiveGraph(..),
+  Context(..)
+  ) where
+
+
+import Control.Monad ( forM, liftM )
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import Data.Maybe ( fromMaybe )
+import Data.Graph.Haggle.Internal.Basic
+
+-- | The interface supported by a mutable graph.
+class MGraph g where
+  -- | The type generated by 'freeze'ing a mutable graph
+  type ImmutableGraph g
+
+  -- | List all of the vertices in the graph.
+  getVertices :: (P.PrimMonad m, R.MonadRef m) => g m -> m [Vertex]
+
+  -- | List the successors for the given 'Vertex'.
+  getSuccessors :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> m [Vertex]
+
+  -- | Get all of the 'Edge's with the given 'Vertex' as their source.
+  getOutEdges :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> m [Edge]
+
+  -- | Return the number of vertices in the graph
+  countVertices :: (P.PrimMonad m, R.MonadRef m) => g m -> m Int
+
+  -- | Return the number of edges in the graph
+  countEdges :: (P.PrimMonad m, R.MonadRef m) => g m -> m Int
+
+  -- | Edge existence test; this has a default implementation,
+  -- but can be overridden if an implementation can support a
+  -- better-than-linear version.
+  checkEdgeExists :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> Vertex -> m Bool
+  checkEdgeExists g src dst = do
+    succs <- getSuccessors g src
+    return $ any (==dst) succs
+
+  -- | Freeze the mutable graph into an immutable graph.
+  freeze :: (P.PrimMonad m, R.MonadRef m) => g m -> m (ImmutableGraph g)
+
+class (MGraph g) => MAddVertex g where
+  -- | Add a new 'Vertex' to the graph, returning its handle.
+  addVertex :: (P.PrimMonad m, R.MonadRef m) => g m -> m Vertex
+
+class (MGraph g) => MAddEdge g where
+  -- | Add a new 'Edge' to the graph from @src@ to @dst@.  If either
+  -- the source or destination is not in the graph, returns Nothing.
+  -- Otherwise, the 'Edge' reference is returned.
+  addEdge :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> Vertex -> m (Maybe Edge)
+
+class (MGraph g) => MLabeledEdge g where
+  type MEdgeLabel g
+  getEdgeLabel :: (P.PrimMonad m, R.MonadRef m) => g m -> Edge -> m (Maybe (MEdgeLabel g))
+  getEdgeLabel g e = do
+    nEs <- countEdges g
+    case edgeId e >= nEs of
+      True -> return Nothing
+      False -> liftM Just (unsafeGetEdgeLabel g e)
+  unsafeGetEdgeLabel :: (P.PrimMonad m, R.MonadRef m) => g m -> Edge -> m (MEdgeLabel g)
+  addLabeledEdge :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> Vertex -> MEdgeLabel g -> m (Maybe Edge)
+
+class (MGraph g) => MLabeledVertex g where
+  type MVertexLabel g
+  getVertexLabel :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> m (Maybe (MVertexLabel g))
+  addLabeledVertex :: (P.PrimMonad m, R.MonadRef m) => g m -> MVertexLabel g -> m Vertex
+  getLabeledVertices :: (P.PrimMonad m, R.MonadRef m) => g m -> m [(Vertex, MVertexLabel g)]
+  getLabeledVertices g = do
+    vs <- getVertices g
+    forM vs $ \v -> do
+      ml <- getVertexLabel g v
+      case ml of
+        Just l -> return (v, l)
+        Nothing -> error ("impossible (missing label for vertex" ++ show v ++ ")")
+
+-- | An interface for graphs that allow vertex and edge removal.  Note that
+-- implementations are not required to reclaim storage from removed
+-- vertices (just make them inaccessible).
+class (MGraph g) => MRemovable g where
+  removeVertex :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> m ()
+  removeEdgesBetween :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> Vertex -> m ()
+  removeEdge :: (P.PrimMonad m, R.MonadRef m) => g m -> Edge -> m ()
+
+-- | An interface for graphs that support looking at predecessor (incoming
+-- edges) efficiently.
+class (MGraph g) => MBidirectional g where
+  getPredecessors :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> m [Vertex]
+  getInEdges :: (P.PrimMonad m, R.MonadRef m) => g m -> Vertex -> m [Edge]
+
+-- | The basic interface of immutable graphs.
+class Graph g where
+  vertices :: g -> [Vertex]
+  edges :: g -> [Edge]
+  successors :: g -> Vertex -> [Vertex]
+  outEdges :: g -> Vertex -> [Edge]
+  maxVertexId :: g -> Int
+  isEmpty :: g -> Bool
+  -- | This has a default implementation in terms of 'outEdges', but is part
+  -- of the class so that instances can offer a more efficient implementation
+  -- when possible.
+  edgesBetween :: g -> Vertex -> Vertex -> [Edge]
+  edgesBetween g src dst = filter ((dst ==) . edgeDest) (outEdges g src)
+
+edgeExists :: Graph g => g -> Vertex -> Vertex -> Bool
+edgeExists g v1 v2 = not . null $ edgesBetween g v1 v2
+
+class (Graph g) => Thawable g where
+  type MutableGraph g :: (* -> *) -> *
+  thaw :: (P.PrimMonad m, R.MonadRef m) => g -> m (MutableGraph g m)
+
+-- | The interface for immutable graphs with efficient access to
+-- incoming edges.
+class (Graph g) => Bidirectional g where
+  predecessors :: g -> Vertex -> [Vertex]
+  inEdges :: g -> Vertex -> [Edge]
+
+-- | The interface for immutable graphs with labeled edges.
+class (Graph g) => HasEdgeLabel g where
+  type EdgeLabel g
+  edgeLabel :: g -> Edge -> Maybe (EdgeLabel g)
+  labeledEdges :: g -> [(Edge, EdgeLabel g)]
+  labeledOutEdges :: g -> Vertex -> [(Edge, EdgeLabel g)]
+  labeledOutEdges g v = map (addEdgeLabel g) (outEdges g v)
+
+
+class (HasEdgeLabel g, Bidirectional g) => BidirectionalEdgeLabel g where
+  labeledInEdges :: g -> Vertex -> [(Edge, EdgeLabel g)]
+  labeledInEdges g v = map (addEdgeLabel g) (inEdges g v)
+
+-- | The interface for immutable graphs with labeled vertices.
+class (Graph g) => HasVertexLabel g where
+  type VertexLabel g
+  vertexLabel :: g -> Vertex -> Maybe (VertexLabel g)
+  labeledVertices :: g -> [(Vertex, VertexLabel g)]
+
+-- | Contexts represent the "context" of a 'Vertex', which includes the incoming edges of the 'Vertex',
+-- the label of the 'Vertex', and the outgoing edges of the 'Vertex'.
+data Context g = Context [(EdgeLabel g, Vertex)] (VertexLabel g) [(EdgeLabel g, Vertex)]
+
+class (Graph g, HasEdgeLabel g, HasVertexLabel g) => InductiveGraph g where
+  -- | The empty inductive graph
+  emptyGraph :: g
+  -- | The call
+  --
+  -- > let (c, g') = match g v
+  --
+  -- decomposes the graph into the 'Context' c of @v@ and the rest of
+  -- the graph @g'@.
+  match :: g -> Vertex -> Maybe (Context g, g)
+  -- | Return the context of a 'Vertex'
+  context :: g -> Vertex -> Maybe (Context g)
+  -- | Insert a new labeled 'Vertex' into the graph.
+  insertLabeledVertex :: g -> VertexLabel g -> (Vertex, g)
+  -- | Must return 'Nothing' if either the source or destination 'Vertex' is not
+  -- in the graph.  Also returns 'Nothing' if the edge already exists and the
+  -- underlying graph does not support parallel edges.
+  --
+  -- Otherwise return the inserted 'Edge' and updated graph.
+  insertLabeledEdge :: g -> Vertex -> Vertex -> EdgeLabel g -> Maybe (Edge, g)
+  -- | Delete the given 'Edge'.  In a multigraph, this lets you remove
+  -- a single parallel edge between two vertices.
+  deleteEdge :: g -> Edge -> g
+  -- | Delete all edges between a pair of vertices.
+  deleteEdgesBetween :: g -> Vertex -> Vertex -> g
+
+  -- | Like 'insertLabeledEdge', but overwrite any existing edges.  Equivalent
+  -- to:
+  --
+  -- > let g' = deleteEdgesBetween g v1 v2
+  -- > in insertLabeledEdge g v1 v2 lbl
+  replaceLabeledEdge :: g -> Vertex -> Vertex -> EdgeLabel g -> Maybe (Edge, g)
+  replaceLabeledEdge g src dst lbl =
+    let g' = deleteEdgesBetween g src dst
+    in insertLabeledEdge g' src dst lbl
+
+  -- | Remove a 'Vertex' from the graph
+  deleteVertex :: g -> Vertex -> g
+  deleteVertex g v = fromMaybe g $ do
+    (_, g') <- match g v
+    return g'
+
+addEdgeLabel :: (HasEdgeLabel g) => g -> Edge -> (Edge, EdgeLabel g)
+addEdgeLabel g e = (e, el)
+  where
+   Just el = edgeLabel g e
diff --git a/src/Data/Graph/Haggle/Digraph.hs b/src/Data/Graph/Haggle/Digraph.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Digraph.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+-- | This graph implementation is a directed (multi-)graph that only tracks
+-- successors.  This encoding is very compact.  It is a multi-graph because it
+-- allows parallel edges between vertices.  If you require only simple graphs,
+-- careful edge insertion is required (or another graph type might be more
+-- appropriate).
+--
+-- Limitations:
+--
+--  * Removing nodes and edges is not currently possible.
+--
+--  * Predecessors are not accessible
+--
+--  * Edge existence tests are /linear/ in the number of edges for
+--    the source node.
+module Data.Graph.Haggle.Digraph (
+  MDigraph,
+  Digraph,
+  newMDigraph,
+  newSizedMDigraph
+  ) where
+
+import qualified Control.DeepSeq as DS
+import Control.Monad ( when )
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import qualified Data.Vector.Unboxed.Mutable as MUV
+import qualified Data.Vector.Unboxed as UV
+
+import Data.Graph.Haggle.Classes
+import Data.Graph.Haggle.Internal.Basic
+
+-- | This is a compact (mutable) directed graph.
+data MDigraph m = -- See Note [Graph Representation]
+  MDigraph { graphVertexCount :: R.Ref m Int
+           , graphEdgeRoots :: R.Ref m (MUV.MVector (P.PrimState m) Int)
+           , graphEdgeCount :: R.Ref m Int
+           , graphEdgeTarget :: R.Ref m (MUV.MVector (P.PrimState m) Int)
+           , graphEdgeNext :: R.Ref m (MUV.MVector (P.PrimState m) Int)
+           }
+
+data Digraph =
+  Digraph { edgeRoots :: !(UV.Vector Int)
+          , edgeTargets :: !(UV.Vector Int)
+          , edgeNexts :: !(UV.Vector Int)
+          }
+
+-- | The 'Digraph' is always in normal form, as the vectors are all unboxed
+instance DS.NFData Digraph where
+  rnf !_g = ()
+
+defaultSize :: Int
+defaultSize = 128
+
+-- | Create a new empty mutable graph with a small amount of storage
+-- reserved for vertices and edges.
+newMDigraph :: (P.PrimMonad m, R.MonadRef m) => m (MDigraph m)
+newMDigraph = newSizedMDigraph defaultSize defaultSize
+
+-- | Create a new empty graph with storage reserved for @szVerts@ vertices
+-- and @szEdges@ edges.
+--
+-- > g <- newSizedMDigraph szVerts szEdges
+newSizedMDigraph :: (P.PrimMonad m, R.MonadRef m) => Int -> Int -> m (MDigraph m)
+newSizedMDigraph szNodes szEdges = do
+  when (szNodes < 0 || szEdges < 0) $ error "Negative size (newSized)"
+  nn <- R.newRef 0
+  en <- R.newRef 0
+  nVec <- MUV.new szNodes
+  nVecRef <- R.newRef nVec
+  eTarget <- MUV.new szEdges
+  eTargetRef <- R.newRef eTarget
+  eNext <- MUV.new szEdges
+  eNextRef <- R.newRef eNext
+  return $! MDigraph { graphVertexCount = nn
+                   , graphEdgeRoots = nVecRef
+                   , graphEdgeCount = en
+                   , graphEdgeTarget = eTargetRef
+                   , graphEdgeNext = eNextRef
+                   }
+
+
+
+instance MGraph MDigraph where
+  type ImmutableGraph MDigraph = Digraph
+  getVertices g = do
+    nVerts <- R.readRef (graphVertexCount g)
+    return [V v | v <- [0..nVerts-1]]
+
+  getOutEdges g (V src) = do
+    nVerts <- R.readRef (graphVertexCount g)
+    case src >= nVerts of
+      True -> return []
+      False -> do
+        roots <- R.readRef (graphEdgeRoots g)
+        lstRoot <- MUV.unsafeRead roots src
+        findEdges g src lstRoot
+
+  countVertices = R.readRef . graphVertexCount
+  countEdges = R.readRef . graphEdgeCount
+
+  getSuccessors g src = do
+    es <- getOutEdges g src
+    return $ map edgeDest es
+
+  freeze g = do
+    nVerts <- R.readRef (graphVertexCount g)
+    nEdges <- R.readRef (graphEdgeCount g)
+    roots <- R.readRef (graphEdgeRoots g)
+    targets <- R.readRef (graphEdgeTarget g)
+    nexts <- R.readRef (graphEdgeNext g)
+    roots' <- UV.freeze (MUV.take nVerts roots)
+    targets' <- UV.freeze (MUV.take nEdges targets)
+    nexts' <- UV.freeze (MUV.take nEdges nexts)
+    return $! Digraph { edgeRoots = roots'
+                    , edgeTargets = targets'
+                    , edgeNexts = nexts'
+                    }
+
+instance MAddVertex MDigraph where
+  addVertex g = do
+    ensureNodeSpace g
+    vid <- R.readRef r
+    R.modifyRef' r (+1)
+    vec <- R.readRef (graphEdgeRoots g)
+    MUV.unsafeWrite vec vid (-1)
+    return (V vid)
+    where
+      r = graphVertexCount g
+
+instance MAddEdge MDigraph where
+  addEdge g (V src) (V dst) = do
+    nVerts <- R.readRef (graphVertexCount g)
+    case src >= nVerts || dst >= nVerts of
+      True -> return Nothing
+      False -> do
+        ensureEdgeSpace g
+        eid <- R.readRef (graphEdgeCount g)
+        R.modifyRef' (graphEdgeCount g) (+1)
+        rootVec <- R.readRef (graphEdgeRoots g)
+        -- The current list of edges for src
+        curListHead <- MUV.unsafeRead rootVec src
+
+        -- Now create the new edge
+        nextVec <- R.readRef (graphEdgeNext g)
+        targetVec <- R.readRef (graphEdgeTarget g)
+        MUV.unsafeWrite nextVec eid curListHead
+        MUV.unsafeWrite targetVec eid dst
+
+        -- The list now starts at our new edge
+        MUV.unsafeWrite rootVec src eid
+        return $ Just (E eid src dst)
+
+instance Thawable Digraph where
+  type MutableGraph Digraph = MDigraph
+  thaw g = do
+    vc <- R.newRef (UV.length (edgeRoots g))
+    ec <- R.newRef (UV.length (edgeTargets g))
+    rvec <- UV.thaw (edgeRoots g)
+    tvec <- UV.thaw (edgeTargets g)
+    nvec <- UV.thaw (edgeNexts g)
+    rref <- R.newRef rvec
+    tref <- R.newRef tvec
+    nref <- R.newRef nvec
+    return MDigraph { graphVertexCount = vc
+                    , graphEdgeCount = ec
+                    , graphEdgeRoots = rref
+                    , graphEdgeTarget = tref
+                    , graphEdgeNext = nref
+                    }
+
+
+instance Graph Digraph where
+  vertices g = map V [0 .. UV.length (edgeRoots g) - 1]
+  edges g = concatMap (outEdges g) (vertices g)
+  successors g (V v)
+    | outOfRange g v = []
+    | otherwise =
+      let root = UV.unsafeIndex (edgeRoots g) v
+      in pureSuccessors g root
+  outEdges g (V v)
+    | outOfRange g v = []
+    | otherwise =
+      let root = UV.unsafeIndex (edgeRoots g) v
+      in pureEdges g v root
+  maxVertexId g = UV.length (edgeRoots g) - 1
+  isEmpty = (==0) . UV.length . edgeRoots
+
+-- Helpers
+
+outOfRange :: Digraph -> Int -> Bool
+outOfRange g = (>= UV.length (edgeRoots g))
+
+pureEdges :: Digraph -> Int -> Int -> [Edge]
+pureEdges _ _ (-1) = []
+pureEdges g src ix = E ix src dst : pureEdges g src nxt
+  where
+    dst = UV.unsafeIndex (edgeTargets g) ix
+    nxt = UV.unsafeIndex (edgeNexts g) ix
+
+pureSuccessors :: Digraph -> Int -> [Vertex]
+pureSuccessors _ (-1) = []
+pureSuccessors g ix = V s : pureSuccessors g nxt
+  where
+    s = UV.unsafeIndex (edgeTargets g) ix
+    nxt = UV.unsafeIndex (edgeNexts g) ix
+
+-- | Given the root of a successor list, traverse it and
+-- accumulate all edges, stopping at -1.
+findEdges :: (P.PrimMonad m, R.MonadRef m) => MDigraph m -> Int -> Int -> m [Edge]
+findEdges _ _ (-1) = return []
+findEdges g src root = do
+  targets <- R.readRef (graphEdgeTarget g)
+  nexts <- R.readRef (graphEdgeNext g)
+  let go acc (-1) = return acc
+      go acc ix = do
+        tgt <- MUV.unsafeRead targets ix
+        nxt <- MUV.unsafeRead nexts ix
+        go (E ix src tgt : acc) nxt
+  go [] root
+
+-- | Given a graph, ensure that there is space in the vertex vector
+-- for a new vertex.  If there is not, double the capacity.
+ensureNodeSpace :: (P.PrimMonad m, R.MonadRef m) => MDigraph m -> m ()
+ensureNodeSpace g = do
+  vec <- R.readRef (graphEdgeRoots g)
+  let cap = MUV.length vec
+  cnt <- R.readRef (graphVertexCount g)
+  case cnt < cap of
+    True -> return ()
+    False -> do
+      vec' <- MUV.grow vec cap
+      R.writeRef (graphEdgeRoots g) vec'
+
+-- | Ensure that the graph has space for another edge.  If there is not,
+-- double the edge capacity.
+ensureEdgeSpace :: (P.PrimMonad m, R.MonadRef m) => MDigraph m -> m ()
+ensureEdgeSpace g = do
+  v1 <- R.readRef (graphEdgeTarget g)
+  v2 <- R.readRef (graphEdgeNext g)
+  nEdges <- R.readRef (graphEdgeCount g)
+  let cap = MUV.length v1
+  case nEdges < cap of
+    True -> return ()
+    False -> do
+      v1' <- MUV.grow v1 cap
+      v2' <- MUV.grow v2 cap
+      R.writeRef (graphEdgeTarget g) v1'
+      R.writeRef (graphEdgeNext g) v2'
+
+{- Note [Graph Representation]
+
+The edge roots vector is indexed by vertex id.  A -1 in the
+vector indicates that there are no edges leaving the vertex.
+Any other value is an index into BOTH the graphEdgeTarget and
+graphEdgeNext vectors.
+
+The graphEdgeTarget vector contains the vertex id of an edge
+target.
+
+The graphEdgeNext vector contains, at the same index, the index
+of the next edge in the edge list (again into Target and Next).
+A -1 indicates no more edges.
+
+-}
diff --git a/src/Data/Graph/Haggle/EdgeLabelAdapter.hs b/src/Data/Graph/Haggle/EdgeLabelAdapter.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/EdgeLabelAdapter.hs
@@ -0,0 +1,215 @@
+{-# LANGUAGE TypeFamilies #-}
+-- | This adapter adds edge labels (but not vertex labels) to graphs.
+--
+-- It only supports 'addLabeledEdge', not 'addEdge'.  See 'LabeledGraph'
+-- for more details.
+module Data.Graph.Haggle.EdgeLabelAdapter (
+  EdgeLabeledMGraph,
+  EdgeLabeledGraph,
+  newEdgeLabeledGraph,
+  newSizedEdgeLabeledGraph,
+  mapEdgeLabel
+  ) where
+
+import qualified Control.DeepSeq as DS
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import qualified Data.Graph.Haggle.Classes as I
+import qualified Data.Graph.Haggle.Internal.Adapter as A
+
+newtype EdgeLabeledMGraph g el s = ELMG { unELMG :: A.LabeledMGraph g () el s }
+newtype EdgeLabeledGraph g el = ELG { unELG :: A.LabeledGraph g () el }
+
+instance (DS.NFData g, DS.NFData el) => DS.NFData (EdgeLabeledGraph g el) where
+  rnf (ELG g) = g `DS.deepseq` ()
+
+mapEdgeLabel :: EdgeLabeledGraph g el -> (el -> el') -> EdgeLabeledGraph g el'
+mapEdgeLabel g = ELG . A.mapEdgeLabel (unELG g)
+{-# INLINE mapEdgeLabel #-}
+
+vertices :: (I.Graph g) => EdgeLabeledGraph g el -> [I.Vertex]
+vertices = I.vertices . unELG
+{-# INLINE vertices #-}
+
+edges :: (I.Graph g) => EdgeLabeledGraph g el -> [I.Edge]
+edges = I.edges . unELG
+{-# INLINE edges #-}
+
+successors :: (I.Graph g) => EdgeLabeledGraph g el -> I.Vertex -> [I.Vertex]
+successors (ELG lg) = I.successors lg
+{-# INLINE successors #-}
+
+outEdges :: (I.Graph g) => EdgeLabeledGraph g el -> I.Vertex -> [I.Edge]
+outEdges (ELG lg) = I.outEdges lg
+{-# INLINE outEdges #-}
+
+edgesBetween :: (I.Graph g) => EdgeLabeledGraph g el -> I.Vertex -> I.Vertex -> [I.Edge]
+edgesBetween (ELG lg) = I.edgesBetween lg
+{-# INLINE edgesBetween #-}
+
+maxVertexId :: (I.Graph g) => EdgeLabeledGraph g el -> Int
+maxVertexId = I.maxVertexId . unELG
+{-# INLINE maxVertexId #-}
+
+isEmpty :: (I.Graph g) => EdgeLabeledGraph g el -> Bool
+isEmpty = I.isEmpty . unELG
+{-# INLINE isEmpty #-}
+
+instance (I.Graph g) => I.Graph (EdgeLabeledGraph g el) where
+  vertices = vertices
+  edges = edges
+  successors = successors
+  outEdges = outEdges
+  edgesBetween = edgesBetween
+  maxVertexId = maxVertexId
+  isEmpty = isEmpty
+
+instance (I.Thawable g) => I.Thawable (EdgeLabeledGraph g el) where
+  type MutableGraph (EdgeLabeledGraph g el) =
+    EdgeLabeledMGraph (I.MutableGraph g) el
+  thaw (ELG lg) = do
+    g' <- I.thaw lg
+    return $ ELMG g'
+
+
+predecessors :: (I.Bidirectional g) => EdgeLabeledGraph g el -> I.Vertex -> [I.Vertex]
+predecessors (ELG lg) = I.predecessors lg
+{-# INLINE predecessors #-}
+
+inEdges :: (I.Bidirectional g) => EdgeLabeledGraph g el -> I.Vertex -> [I.Edge]
+inEdges (ELG lg) = I.inEdges lg
+{-# INLINE inEdges #-}
+
+instance (I.Bidirectional g) => I.Bidirectional (EdgeLabeledGraph g el) where
+  predecessors = predecessors
+  inEdges = inEdges
+
+instance (I.Bidirectional g) => I.BidirectionalEdgeLabel (EdgeLabeledGraph g el)
+
+edgeLabel :: (I.Graph g) => EdgeLabeledGraph g el -> I.Edge -> Maybe el
+edgeLabel (ELG lg) = I.edgeLabel lg
+{-# INLINE edgeLabel #-}
+
+labeledEdges :: (I.Graph g) => EdgeLabeledGraph g el -> [(I.Edge, el)]
+labeledEdges = I.labeledEdges . unELG
+{-# INLINE labeledEdges #-}
+
+instance (I.Graph g) => I.HasEdgeLabel (EdgeLabeledGraph g el) where
+  type EdgeLabel (EdgeLabeledGraph g el) = el
+  edgeLabel = edgeLabel
+  labeledEdges = labeledEdges
+
+newEdgeLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                    => m (g m)
+                    -> m (EdgeLabeledMGraph g nl m)
+newEdgeLabeledGraph newG = do
+  g <- A.newLabeledGraph newG
+  return $ ELMG g
+{-# INLINE newEdgeLabeledGraph #-}
+
+newSizedEdgeLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                         => (Int -> Int -> m (g m))
+                         -> Int
+                         -> Int
+                         -> m (EdgeLabeledMGraph g el m)
+newSizedEdgeLabeledGraph newG szV szE = do
+  g <- A.newSizedLabeledGraph newG szV szE
+  return $ ELMG g
+{-# INLINE newSizedEdgeLabeledGraph #-}
+
+addLabeledEdge :: (I.MGraph g, I.MAddEdge g, P.PrimMonad m, R.MonadRef m)
+               => EdgeLabeledMGraph g el m
+               -> I.Vertex
+               -> I.Vertex
+               -> el
+               -> m (Maybe I.Edge)
+addLabeledEdge lg = I.addLabeledEdge (unELMG lg)
+{-# INLINE addLabeledEdge #-}
+
+addVertex :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
+          => EdgeLabeledMGraph g el m
+          -> m I.Vertex
+addVertex lg = I.addVertex (A.rawMGraph (unELMG lg))
+{-# INLINE addVertex #-}
+
+unsafeGetEdgeLabel :: (I.MGraph g, I.MAddEdge g, P.PrimMonad m, R.MonadRef m)
+                   => EdgeLabeledMGraph g el m
+                   -> I.Edge
+                   -> m el
+unsafeGetEdgeLabel (ELMG g) e =
+  I.unsafeGetEdgeLabel g e
+{-# INLINE unsafeGetEdgeLabel #-}
+
+getSuccessors :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+              => EdgeLabeledMGraph g el m
+              -> I.Vertex
+              -> m [I.Vertex]
+getSuccessors lg = I.getSuccessors (unELMG lg)
+{-# INLINE getSuccessors #-}
+
+getOutEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+            => EdgeLabeledMGraph g el m -> I.Vertex -> m [I.Edge]
+getOutEdges lg = I.getOutEdges (unELMG lg)
+{-# INLINE getOutEdges #-}
+
+countVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => EdgeLabeledMGraph g el m -> m Int
+countVertices = I.countVertices . unELMG
+{-# INLINE countVertices #-}
+
+getVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => EdgeLabeledMGraph g el m -> m [I.Vertex]
+getVertices = I.getVertices . unELMG
+{-# INLINE getVertices #-}
+
+countEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => EdgeLabeledMGraph g el m -> m Int
+countEdges = I.countEdges . unELMG
+{-# INLINE countEdges #-}
+
+getPredecessors :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
+                => EdgeLabeledMGraph g el m -> I.Vertex -> m [I.Vertex]
+getPredecessors lg = I.getPredecessors (unELMG lg)
+{-# INLINE getPredecessors #-}
+
+getInEdges :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
+           => EdgeLabeledMGraph g el m -> I.Vertex -> m [I.Edge]
+getInEdges lg = I.getInEdges (unELMG lg)
+{-# INLINE getInEdges #-}
+
+checkEdgeExists :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                => EdgeLabeledMGraph g el m
+                -> I.Vertex
+                -> I.Vertex
+                -> m Bool
+checkEdgeExists lg = I.checkEdgeExists (unELMG lg)
+{-# INLINE checkEdgeExists #-}
+
+freeze :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+       => EdgeLabeledMGraph g el m
+       -> m (EdgeLabeledGraph (I.ImmutableGraph g) el)
+freeze lg = do
+  g' <- I.freeze (unELMG lg)
+  return $ ELG g'
+{-# INLINE freeze #-}
+
+instance (I.MGraph g) => I.MGraph (EdgeLabeledMGraph g el) where
+  type ImmutableGraph (EdgeLabeledMGraph g el) =
+    EdgeLabeledGraph (I.ImmutableGraph g) el
+  getVertices = getVertices
+  getSuccessors = getSuccessors
+  getOutEdges = getOutEdges
+  countVertices = countVertices
+  countEdges = countEdges
+  checkEdgeExists = checkEdgeExists
+  freeze = freeze
+
+instance (I.MBidirectional g) => I.MBidirectional (EdgeLabeledMGraph g el) where
+  getPredecessors = getPredecessors
+  getInEdges = getInEdges
+
+instance (I.MAddVertex g) => I.MAddVertex (EdgeLabeledMGraph g el) where
+  addVertex = addVertex
+
+instance (I.MAddEdge g) => I.MLabeledEdge (EdgeLabeledMGraph g el) where
+  type MEdgeLabel (EdgeLabeledMGraph g el) = el
+  unsafeGetEdgeLabel = unsafeGetEdgeLabel
+  addLabeledEdge = addLabeledEdge
+
diff --git a/src/Data/Graph/Haggle/Internal/Adapter.hs b/src/Data/Graph/Haggle/Internal/Adapter.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Internal/Adapter.hs
@@ -0,0 +1,395 @@
+{-# LANGUAGE TypeFamilies, PatternGuards, RankNTypes #-}
+-- | This internal module implements code shared between all of the
+-- adapter interfaces.  The adapters add support for vertex and edge
+-- labels without modifications to the underlying graph.  Any graph
+-- implementing the 'MGraph' interface can have labels added with
+-- these adapters.
+--
+-- Analogous adapters will be added for the pure graph interface, too.
+module Data.Graph.Haggle.Internal.Adapter (
+  -- * Types
+  LabeledMGraph(..),
+  LabeledGraph(..),
+  -- * Mutable graph API
+  newLabeledGraph,
+  newSizedLabeledGraph,
+  -- * Immutable graph API
+  mapVertexLabel,
+  mapEdgeLabel,
+  fromLabeledEdgeList,
+  -- * Helpers
+  ensureEdgeLabelStorage,
+  ensureNodeLabelStorage,
+  unsafeGetEdgeLabel
+  ) where
+
+import qualified Control.DeepSeq as DS
+import Control.Monad ( liftM )
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import Control.Monad.ST ( ST, runST )
+import Data.Vector ( Vector )
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as MV
+import qualified Data.Graph.Haggle.Classes as I
+import qualified Data.Graph.Haggle.VertexMap as VM
+import qualified Data.Graph.Haggle.Internal.Basic as I
+
+-- | An adapter adding support for both vertex and edge labels for mutable
+-- graphs.
+data LabeledMGraph g nl el m =
+  LMG { rawMGraph :: g m
+      , nodeLabelStorage :: R.Ref m (MV.MVector (P.PrimState m) nl)
+      , edgeLabelStorage :: R.Ref m (MV.MVector (P.PrimState m) el)
+      }
+
+-- | An adapter adding support for both vertex and edge labels for immutable
+-- graphs.
+data LabeledGraph g nl el =
+  LG { rawGraph :: g
+     , nodeLabelStore :: Vector nl
+     , edgeLabelStore :: Vector el
+     }
+
+instance (DS.NFData g, DS.NFData nl, DS.NFData el) => DS.NFData (LabeledGraph g nl el) where
+  rnf gr = rawGraph gr `DS.deepseq` nodeLabelStore gr `DS.deepseq` edgeLabelStore gr `DS.deepseq` ()
+
+newLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                => m (g m)
+                -> m (LabeledMGraph g nl el m)
+newLabeledGraph newG = do
+  g <- newG
+  nstore <- MV.new 128
+  nref <- R.newRef nstore
+  estore <- MV.new 128
+  eref <- R.newRef estore
+  return LMG { rawMGraph = g
+             , nodeLabelStorage = nref
+             , edgeLabelStorage = eref
+             }
+
+newSizedLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                     => (Int -> Int -> m (g m))
+                     -> Int
+                     -> Int
+                     -> m (LabeledMGraph g nl el m)
+newSizedLabeledGraph newG szVertices szEdges = do
+  g <- newG szVertices szEdges
+  nstore <- MV.new szVertices
+  nref <- R.newRef nstore
+  estore <- MV.new szEdges
+  eref <- R.newRef estore
+  return LMG { rawMGraph = g
+             , nodeLabelStorage = nref
+             , edgeLabelStorage = eref
+             }
+
+addLabeledVertex :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
+                 => LabeledMGraph g nl el m
+                 -> nl
+                 -> m I.Vertex
+addLabeledVertex lg nl = do
+  v <- I.addVertex (rawMGraph lg)
+  ensureNodeLabelStorage lg
+  nlVec <- R.readRef (nodeLabelStorage lg)
+  MV.write nlVec (I.vertexId v) nl
+  return v
+--
+-- getEdgeLabel :: (PrimMonad m, I.MGraph g)
+--              => LabeledMGraph g nl el m
+--              -> I.Edge
+--              -> m (Maybe el)
+-- getEdgeLabel lg e = do
+--   nEs <- I.countEdges (rawMGraph lg)
+--   case I.edgeId e >= nEs of
+--     True -> return Nothing
+--     False -> do
+--       elVec <- readSTRef (edgeLabelStorage lg)
+--       Just `liftM` MV.read elVec (I.edgeId e)
+
+-- FIXME: Just implement this one and push the safe version to have the default
+-- impl
+unsafeGetEdgeLabel :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                   => LabeledMGraph g nl el m
+                   -> I.Edge
+                   -> m el
+unsafeGetEdgeLabel (LMG _ _ stor) (I.E eid _ _) = do
+  elVec <- R.readRef stor
+  MV.unsafeRead elVec eid
+{-# INLINE unsafeGetEdgeLabel #-}
+
+getVertexLabel :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+               => LabeledMGraph g nl el m
+               -> I.Vertex
+               -> m (Maybe nl)
+getVertexLabel lg v = do
+  nNs <- I.countVertices (rawMGraph lg)
+  case I.vertexId v >= nNs of
+    True -> return Nothing
+    False -> do
+      nlVec <- R.readRef (nodeLabelStorage lg)
+      Just `liftM` MV.read nlVec (I.vertexId v)
+
+addLabeledEdge :: (I.MGraph g, I.MAddEdge g, P.PrimMonad m, R.MonadRef m)
+               => LabeledMGraph g nl el m
+               -> I.Vertex
+               -> I.Vertex
+               -> el
+               -> m (Maybe I.Edge)
+addLabeledEdge lg src dst el = do
+  e <- I.addEdge (rawMGraph lg) src dst
+  case e of
+    Nothing -> return e
+    Just e' -> do
+      ensureEdgeLabelStorage lg
+      elVec <- R.readRef (edgeLabelStorage lg)
+      MV.write elVec (I.edgeId e') el
+      return e
+
+getSuccessors :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+              => LabeledMGraph g nl el m
+              -> I.Vertex
+              -> m [I.Vertex]
+getSuccessors lg = I.getSuccessors (rawMGraph lg)
+{-# INLINE getSuccessors #-}
+
+getOutEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+            => LabeledMGraph g nl el m -> I.Vertex -> m [I.Edge]
+getOutEdges lg = I.getOutEdges (rawMGraph lg)
+{-# INLINE getOutEdges #-}
+
+countVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => LabeledMGraph g nl el m -> m Int
+countVertices = I.countVertices . rawMGraph
+{-# INLINE countVertices #-}
+
+countEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => LabeledMGraph g nl el m -> m Int
+countEdges = I.countEdges . rawMGraph
+{-# INLINE countEdges #-}
+
+getVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => LabeledMGraph g nl el m -> m [I.Vertex]
+getVertices = I.getVertices . rawMGraph
+{-# INLINE getVertices #-}
+
+getPredecessors :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
+                => LabeledMGraph g nl el m -> I.Vertex -> m [I.Vertex]
+getPredecessors lg = I.getPredecessors (rawMGraph lg)
+{-# INLINE getPredecessors #-}
+
+getInEdges :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
+           => LabeledMGraph g nl el m -> I.Vertex -> m [I.Edge]
+getInEdges lg = I.getInEdges (rawMGraph lg)
+{-# INLINE getInEdges #-}
+
+checkEdgeExists :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                => LabeledMGraph g nl el m
+                -> I.Vertex
+                -> I.Vertex
+                -> m Bool
+checkEdgeExists lg = I.checkEdgeExists (rawMGraph lg)
+{-# INLINE checkEdgeExists #-}
+
+freeze :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+       => LabeledMGraph g nl el m
+       -> m (LabeledGraph (I.ImmutableGraph g) nl el)
+freeze lg = do
+  g' <- I.freeze (rawMGraph lg)
+  nc <- I.countVertices (rawMGraph lg)
+  ec <- I.countEdges (rawMGraph lg)
+  ns <- R.readRef (nodeLabelStorage lg)
+  es <- R.readRef (edgeLabelStorage lg)
+  ns' <- V.freeze (MV.take nc ns)
+  es' <- V.freeze (MV.take ec es)
+  return LG { rawGraph = g'
+            , nodeLabelStore = ns'
+            , edgeLabelStore = es'
+            }
+
+instance (I.MGraph g) => I.MGraph (LabeledMGraph g nl el) where
+  type ImmutableGraph (LabeledMGraph g nl el) = LabeledGraph (I.ImmutableGraph g) nl el
+  getVertices = getVertices
+  getSuccessors = getSuccessors
+  getOutEdges = getOutEdges
+  countEdges = countEdges
+  countVertices = countVertices
+  checkEdgeExists = checkEdgeExists
+  freeze = freeze
+
+instance (I.MBidirectional g) => I.MBidirectional (LabeledMGraph g nl el) where
+  getPredecessors = getPredecessors
+  getInEdges = getInEdges
+
+instance (I.MAddEdge g) => I.MLabeledEdge (LabeledMGraph g nl el) where
+  type MEdgeLabel (LabeledMGraph g nl el) = el
+  -- getEdgeLabel = getEdgeLabel
+  unsafeGetEdgeLabel = unsafeGetEdgeLabel
+  addLabeledEdge = addLabeledEdge
+
+instance (I.MAddVertex g) => I.MLabeledVertex (LabeledMGraph g nl el) where
+  type MVertexLabel (LabeledMGraph g nl el) = nl
+  getVertexLabel = getVertexLabel
+  addLabeledVertex = addLabeledVertex
+
+vertices :: (I.Graph g) => LabeledGraph g nl el -> [I.Vertex]
+vertices = I.vertices . rawGraph
+{-# INLINE vertices #-}
+
+edges :: (I.Graph g) => LabeledGraph g nl el -> [I.Edge]
+edges = I.edges . rawGraph
+{-# INLINE edges #-}
+
+successors :: (I.Graph g) => LabeledGraph g nl el -> I.Vertex -> [I.Vertex]
+successors lg = I.successors (rawGraph lg)
+{-# INLINE successors #-}
+
+outEdges :: (I.Graph g) => LabeledGraph g nl el -> I.Vertex -> [I.Edge]
+outEdges lg = I.outEdges (rawGraph lg)
+{-# INLINE outEdges #-}
+
+edgesBetween :: (I.Graph g) => LabeledGraph g nl el -> I.Vertex -> I.Vertex -> [I.Edge]
+edgesBetween lg = I.edgesBetween (rawGraph lg)
+{-# INLINE edgesBetween #-}
+
+maxVertexId :: (I.Graph g) => LabeledGraph g nl el -> Int
+maxVertexId = I.maxVertexId . rawGraph
+{-# INLINE maxVertexId #-}
+
+isEmpty :: (I.Graph g) => LabeledGraph g nl el -> Bool
+isEmpty = I.isEmpty . rawGraph
+{-# INLINE isEmpty #-}
+
+thaw :: (I.Thawable g, P.PrimMonad m, R.MonadRef m)
+     => LabeledGraph g nl el
+     -> m (LabeledMGraph (I.MutableGraph g) nl el m)
+thaw lg = do
+  g' <- I.thaw (rawGraph lg)
+  nlVec <- V.thaw (nodeLabelStore lg)
+  elVec <- V.thaw (edgeLabelStore lg)
+  nref <- R.newRef nlVec
+  eref <- R.newRef elVec
+  return LMG { rawMGraph = g'
+             , nodeLabelStorage = nref
+             , edgeLabelStorage = eref
+             }
+
+instance (I.Thawable g) => I.Thawable (LabeledGraph g nl el) where
+  type MutableGraph (LabeledGraph g nl el) = LabeledMGraph (I.MutableGraph g) nl el
+  thaw = thaw
+
+instance (I.Graph g) => I.Graph (LabeledGraph g nl el) where
+  vertices = vertices
+  edges = edges
+  successors = successors
+  outEdges = outEdges
+  edgesBetween = edgesBetween
+  maxVertexId = maxVertexId
+  isEmpty = isEmpty
+
+predecessors :: (I.Bidirectional g) => LabeledGraph g nl el -> I.Vertex -> [I.Vertex]
+predecessors lg = I.predecessors (rawGraph lg)
+{-# INLINE predecessors #-}
+
+inEdges :: (I.Bidirectional g) => LabeledGraph g nl el -> I.Vertex -> [I.Edge]
+inEdges lg = I.inEdges (rawGraph lg)
+{-# INLINE inEdges #-}
+
+instance (I.Bidirectional g) => I.Bidirectional (LabeledGraph g nl el) where
+  predecessors = predecessors
+  inEdges = inEdges
+
+instance (I.Bidirectional g) => I.BidirectionalEdgeLabel (LabeledGraph g nl el)
+
+edgeLabel :: LabeledGraph g nl el -> I.Edge -> Maybe el
+edgeLabel lg e = edgeLabelStore lg V.!? I.edgeId e
+{-# INLINE edgeLabel #-}
+
+instance (I.Graph g) => I.HasEdgeLabel (LabeledGraph g nl el) where
+  type EdgeLabel (LabeledGraph g nl el) = el
+  edgeLabel = edgeLabel
+  labeledEdges = labeledEdges
+
+vertexLabel :: LabeledGraph g nl el -> I.Vertex -> Maybe nl
+vertexLabel lg v = nodeLabelStore lg V.!? I.vertexId v
+{-# INLINE vertexLabel #-}
+
+instance (I.Graph g) => I.HasVertexLabel (LabeledGraph g nl el) where
+  type VertexLabel (LabeledGraph g nl el) = nl
+  vertexLabel = vertexLabel
+  labeledVertices = labeledVertices
+
+-- | Note that we are not just using the @nodeLabelStore@ directly.  In
+-- graphs that support vertex removal, we do not want to include removed
+-- vertices, so we go through the public accessor.  This is slower but easier
+-- to see as correct.
+labeledVertices :: (I.Graph g) => LabeledGraph g nl el -> [(I.Vertex, nl)]
+labeledVertices g = map toLabVert $ I.vertices (rawGraph g)
+  where
+    toLabVert v =
+      let Just lab = vertexLabel g v
+      in (v, lab)
+
+-- | Likewise, we use 'edges' here instead of directly reading from the edge
+-- label storage array.
+labeledEdges :: (I.Graph g) => LabeledGraph g nl el -> [(I.Edge, el)]
+labeledEdges g = map toLabEdge $ I.edges (rawGraph g)
+  where
+    toLabEdge e =
+      let Just lab = edgeLabel g e
+      in (e, lab)
+
+mapEdgeLabel :: LabeledGraph g nl el -> (el -> el') -> LabeledGraph g nl el'
+mapEdgeLabel g f = g { edgeLabelStore = V.map f (edgeLabelStore g) }
+
+mapVertexLabel :: LabeledGraph g nl el -> (nl -> nl') -> LabeledGraph g nl' el
+mapVertexLabel g f = g { nodeLabelStore = V.map f (nodeLabelStore g) }
+
+-- | Construct a graph from a labeled list of edges.  The node endpoint values
+-- are used as vertex labels, and the last element of the triple is used as an
+-- edge label.
+fromLabeledEdgeList :: (Ord nl, I.MGraph g, I.MAddVertex g, I.MAddEdge g)
+                    => (forall s . ST s (g (ST s)))
+                    -> [(nl, nl, el)]
+                    -> (LabeledGraph (I.ImmutableGraph g) nl el, VM.VertexMap nl)
+fromLabeledEdgeList con es = runST $ do
+  g <- newLabeledGraph con
+  vm <- VM.newVertexMapRef
+  mapM_ (fromListAddEdge g vm) es
+  g' <- I.freeze g
+  vm' <- VM.vertexMapFromRef vm
+  return (g', vm')
+
+fromListAddEdge :: (I.MAddVertex g, I.MAddEdge g, Ord nl, P.PrimMonad m, R.MonadRef m)
+                => LabeledMGraph g nl el m
+                -> VM.VertexMapRef nl m
+                -> (nl, nl, el)
+                -> m ()
+fromListAddEdge g vm (src, dst, lbl) = do
+  vsrc <- VM.vertexForLabelRef g vm src
+  vdst <- VM.vertexForLabelRef g vm dst
+  _ <- addLabeledEdge g vsrc vdst lbl
+  return ()
+
+-- Helpers
+
+ensureEdgeLabelStorage :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                       => LabeledMGraph g nl el m -> m ()
+ensureEdgeLabelStorage lg = do
+  elVec <- R.readRef (edgeLabelStorage lg)
+  edgeCount <- I.countEdges (rawMGraph lg)
+  let cap = MV.length elVec
+  case cap > edgeCount of
+    True -> return ()
+    False -> do
+      elVec' <- MV.grow elVec cap
+      R.writeRef (edgeLabelStorage lg) elVec'
+
+ensureNodeLabelStorage :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                       => LabeledMGraph g nl el m -> m ()
+ensureNodeLabelStorage lg = do
+  nlVec <- R.readRef (nodeLabelStorage lg)
+  vertCount <- I.countVertices (rawMGraph lg)
+  let cap = MV.length nlVec
+  case cap > vertCount of
+    True -> return ()
+    False -> do
+      nlVec' <- MV.grow nlVec cap
+      R.writeRef (nodeLabelStorage lg) nlVec'
diff --git a/src/Data/Graph/Haggle/Internal/Basic.hs b/src/Data/Graph/Haggle/Internal/Basic.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Internal/Basic.hs
@@ -0,0 +1,74 @@
+-- | This module defines the most basic types in the library.  Their
+-- representations are required in several modules, but external
+-- clients should probably not rely on them.
+--
+-- Stability not guaranteed.
+module Data.Graph.Haggle.Internal.Basic (
+  Vertex(..),
+  Edge(..),
+  vertexId,
+  edgeId,
+  edgeSource,
+  edgeDest
+  ) where
+
+import Control.DeepSeq
+import Data.Hashable
+
+-- | An abstract representation of a vertex.
+--
+-- Note that the representation is currently exposed.  Do not rely on
+-- this, as it is subject to change.
+newtype Vertex = V Int
+  deriving (Eq, Ord, Show)
+
+instance Hashable Vertex where
+  hashWithSalt = hashVertex
+
+instance NFData Vertex where
+  rnf (V i) = i `seq` ()
+
+hashVertex :: Int -> Vertex -> Int
+hashVertex s (V i) = hashWithSalt s i
+{-# INLINE hashVertex #-}
+
+-- | An edge between two vertices.
+data Edge = E {-# UNPACK #-}!Int {-# UNPACK #-}!Int {-# UNPACK #-}!Int
+  deriving (Eq, Ord, Show)
+
+instance Hashable Edge where
+  hashWithSalt = hashEdge
+
+instance NFData Edge where
+  rnf e = e `seq` ()
+
+hashEdge :: Int -> Edge -> Int
+hashEdge s (E eid src dst) = s `hashWithSalt` eid `hashWithSalt` src `hashWithSalt` dst
+{-# INLINE hashEdge #-}
+
+vertexId :: Vertex -> Int
+vertexId (V vid) = vid
+{-# INLINE vertexId #-}
+
+edgeId :: Edge -> Int
+edgeId (E eid _ _) = eid
+{-# INLINE edgeId #-}
+
+edgeSource :: Edge -> Vertex
+edgeSource (E _ s _) = V s
+{-# INLINE edgeSource #-}
+
+edgeDest :: Edge -> Vertex
+edgeDest (E _ _ d) = V d
+{-# INLINE edgeDest #-}
+
+
+{- Note [Edge Format]
+
+Edges track (in order)
+
+1) The edge unique identifier
+2) The edge source
+3) The edge destination
+
+-}
diff --git a/src/Data/Graph/Haggle/Internal/BitSet.hs b/src/Data/Graph/Haggle/Internal/BitSet.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/Internal/BitSet.hs
@@ -0,0 +1,49 @@
+module Data.Graph.Haggle.Internal.BitSet (
+  BitSet,
+  newBitSet,
+  setBit,
+  testBit
+  ) where
+
+import Control.Monad.ST
+import qualified Data.Bits as B
+import Data.Vector.Unboxed.Mutable ( STVector )
+import qualified Data.Vector.Unboxed.Mutable as V
+import Data.Word ( Word64 )
+
+data BitSet s = BS (STVector s Word64) {-# UNPACK #-} !Int
+
+bitsPerWord :: Int
+bitsPerWord = 64
+
+-- | Allocate a new 'BitSet' with @n@ bits.  Bits are all
+-- initialized to zero.
+--
+-- > bs <- newBitSet n
+newBitSet :: Int -> ST s (BitSet s)
+newBitSet n = do
+  let nWords = (n `div` bitsPerWord) + 1
+  v <- V.replicate nWords 0
+  return $ BS v n
+
+-- | Set a bit in the bitset.  Out of range has no effect.
+setBit :: BitSet s -> Int -> ST s ()
+setBit (BS v sz) bitIx
+  | bitIx >= sz = return ()
+  | otherwise = do
+    let wordIx = bitIx `div` bitsPerWord
+        bitPos = bitIx `mod` bitsPerWord
+    oldWord <- V.read v wordIx
+    let newWord = B.setBit oldWord bitPos
+    V.write v wordIx newWord
+
+-- | Return True if the bit is set.  Out of range will return False.
+testBit :: BitSet s -> Int -> ST s Bool
+testBit (BS v sz) bitIx
+  | bitIx >= sz = return False
+  | otherwise = do
+    let wordIx = bitIx `div` bitsPerWord
+        bitPos = bitIx `mod` bitsPerWord
+    w <- V.read v wordIx
+    return $ B.testBit w bitPos
+
diff --git a/src/Data/Graph/Haggle/LabelAdapter.hs b/src/Data/Graph/Haggle/LabelAdapter.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/LabelAdapter.hs
@@ -0,0 +1,14 @@
+module Data.Graph.Haggle.LabelAdapter (
+  -- * Types
+  LabeledMGraph,
+  LabeledGraph,
+  -- * Mutable Graph API
+  newLabeledGraph,
+  newSizedLabeledGraph,
+  -- * Immutable Graph API
+  mapEdgeLabel,
+  mapVertexLabel,
+  fromLabeledEdgeList,
+  ) where
+
+import Data.Graph.Haggle.Internal.Adapter
diff --git a/src/Data/Graph/Haggle/PatriciaTree.hs b/src/Data/Graph/Haggle/PatriciaTree.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/PatriciaTree.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE TypeFamilies, BangPatterns #-}
+-- | This graph is based on the implementation in fgl (using
+-- big-endian patricia-tries -- IntMap).
+--
+-- This formulation does not support parallel edges.
+module Data.Graph.Haggle.PatriciaTree ( PatriciaTree ) where
+
+import Control.DeepSeq
+import Control.Monad ( guard )
+import Data.Foldable ( toList )
+import Data.IntMap ( IntMap )
+import qualified Data.IntMap as IM
+import Data.Maybe ( fromMaybe )
+import Data.Monoid
+
+import           Prelude
+
+import qualified Data.Graph.Haggle.Classes as I
+import qualified Data.Graph.Haggle.Internal.Basic as I
+
+data Ctx nl el = Ctx !(IntMap el) I.Vertex nl !(IntMap el)
+
+instance (NFData nl, NFData el) => NFData (Ctx nl el) where
+  rnf (Ctx p v nl s) =
+    p `deepseq` s `deepseq` nl `deepseq` v `seq` ()
+
+-- | The 'PatriciaTree' is a graph implementing the 'I.InductiveGraph'
+-- interface (as well as the other immutable graph interfaces).  It is
+-- based on the graph type provided by fgl.
+--
+-- Inductive graphs support more interesting decompositions than the
+-- other graph interfaces in this library, at the cost of less compact
+-- representations and some additional overhead on some operations, as
+-- most must go through the 'I.match' operator.
+--
+-- This graph type is most useful for incremental construction in pure
+-- code.  It also supports node removal from pure code.
+data PatriciaTree nl el = Gr { graphRepr :: IntMap (Ctx nl el) }
+
+instance (NFData nl, NFData el) => NFData (PatriciaTree nl el) where
+  rnf (Gr im) = im `deepseq` ()
+
+instance I.Graph (PatriciaTree nl el) where
+  vertices = map I.V . IM.keys . graphRepr
+  isEmpty = IM.null . graphRepr
+  maxVertexId (Gr g)
+    | IM.null g = 0
+    | otherwise = fst $ IM.findMax g
+  edgesBetween (Gr g) (I.V src) (I.V dst) = toList $ do
+    Ctx _ _ _ ss <- IM.lookup src g
+    guard (IM.member dst ss)
+    return (I.E (-1) src dst)
+  edges g = concatMap (I.outEdges g) (I.vertices g)
+  successors (Gr g) (I.V v) = fromMaybe [] $ do
+    Ctx _ _ _ ss <- IM.lookup v g
+    return $ map I.V $ IM.keys ss
+  outEdges (Gr g) (I.V v) = fromMaybe [] $ do
+    Ctx _ _ _ ss <- IM.lookup v g
+    return $ map toEdge (IM.keys ss)
+    where
+      toEdge d = I.E (-1) v d
+
+instance I.HasEdgeLabel (PatriciaTree nl el) where
+  type EdgeLabel (PatriciaTree nl el) = el
+  edgeLabel (Gr g) (I.E _ src dst) = do
+    Ctx _ _ _ ss <- IM.lookup src g
+    IM.lookup dst ss
+  labeledEdges gr = map toLabEdge (I.edges gr)
+    where
+      toLabEdge e =
+        let Just lab = I.edgeLabel gr e
+        in (e, lab)
+  labeledOutEdges (Gr g) (I.V s) = fromMaybe [] $ do
+    Ctx _ _ _ ss <- IM.lookup s g
+    return $ IM.foldrWithKey toOut [] ss
+    where
+      toOut d lbl acc = (I.E (-1) s d, lbl) : acc
+
+instance I.HasVertexLabel (PatriciaTree nl el) where
+  type VertexLabel (PatriciaTree nl el) = nl
+  vertexLabel (Gr g) (I.V v) = do
+    Ctx _ _ lbl _ <- IM.lookup v g
+    return lbl
+  labeledVertices gr = map toLabVert (I.vertices gr)
+    where
+      toLabVert v =
+        let Just l = I.vertexLabel gr v
+        in (v, l)
+
+instance I.Bidirectional (PatriciaTree nl el) where
+  predecessors (Gr g) (I.V v) = fromMaybe [] $ do
+    Ctx pp _ _ _ <- IM.lookup v g
+    return $ map I.V (IM.keys pp)
+  inEdges (Gr g) (I.V v) = fromMaybe [] $ do
+    Ctx pp _ _ _ <- IM.lookup v g
+    return $ map toEdge (IM.keys pp)
+    where
+      toEdge s = I.E (-1) s v
+
+instance I.BidirectionalEdgeLabel (PatriciaTree nl el) where
+  labeledInEdges (Gr g) (I.V d) = fromMaybe [] $ do
+    Ctx pp _ _ _ <- IM.lookup d g
+    return $ IM.foldrWithKey toIn [] pp
+    where
+      toIn s lbl acc = (I.E (-1) s d, lbl) : acc
+
+instance I.InductiveGraph (PatriciaTree nl el) where
+  emptyGraph = Gr IM.empty
+  insertLabeledVertex gr@(Gr g) lab =
+    let vid = I.maxVertexId gr + 1
+        v = I.V vid
+        g' = IM.insert vid (Ctx mempty v lab mempty) g
+    in (v, Gr g')
+  insertLabeledEdge gr@(Gr g) v1@(I.V src) v2@(I.V dst) lab = do
+    guard (IM.member src g && IM.member dst g)
+    guard (not (I.edgeExists gr v1 v2))
+    let e = I.E (-1) src dst
+    Ctx spp sv sl sss <- IM.lookup src g
+    Ctx dpp dv dl dss <- IM.lookup dst g
+    let sctx' = Ctx spp sv sl (IM.insert dst lab sss)
+        dctx' = Ctx (IM.insert src lab dpp) dv dl dss
+        !g' = IM.insert src sctx' g
+        !g'' = IM.insert dst dctx' g'
+    return (e, Gr g'')
+  deleteEdge g (I.E _ s d) = I.deleteEdgesBetween g (I.V s) (I.V d)
+  deleteEdgesBetween gr@(Gr g) (I.V src) (I.V dst) = fromMaybe gr $ do
+    Ctx spp sv sl sss <- IM.lookup src g
+    Ctx dpp dv dl dss <- IM.lookup dst g
+    let sctx' = Ctx spp sv sl (IM.delete dst sss)
+        dctx' = Ctx (IM.delete src dpp) dv dl dss
+        !g' = IM.insert src sctx' g
+        !g'' = IM.insert dst dctx' g'
+    return (Gr g'')
+  context (Gr g) (I.V v) = do
+    Ctx pp _ l ss <- IM.lookup v g
+    return $ I.Context (toAdj pp) l (toAdj ss)
+  match (Gr g) (I.V v) = do
+    Ctx pp _ l ss <- IM.lookup v g
+    let g' = foldr (IM.adjust (removeSucc v)) g (IM.keys pp)
+        g'' = foldr (IM.adjust (removePred v)) g' (IM.keys ss)
+        g''' = IM.delete v g''
+    return $ (I.Context (toAdj pp) l (toAdj ss), Gr g''')
+
+toAdj :: IntMap a -> [(a, I.Vertex)]
+toAdj = IM.foldrWithKey f []
+  where
+    f dst lbl acc = (lbl, I.V dst) : acc
+
+removeSucc :: Int -> Ctx nl el -> Ctx nl el
+removeSucc v (Ctx pp vert lbl ss) =
+  Ctx pp vert lbl (IM.delete v ss)
+
+removePred :: Int -> Ctx nl el -> Ctx nl el
+removePred v (Ctx pp vert lbl ss) =
+  Ctx (IM.delete v pp) vert lbl ss
+
+{- Note [Representation]
+
+Since this graph does not support parallel edges, the edge ID does not
+actually matter.  This implementation will let it always be zero.  Edge
+identity can be recovered with just (src, dst).
+
+-}
+
+
diff --git a/src/Data/Graph/Haggle/SimpleBiDigraph.hs b/src/Data/Graph/Haggle/SimpleBiDigraph.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/SimpleBiDigraph.hs
@@ -0,0 +1,239 @@
+{-# LANGUAGE TypeFamilies #-}
+-- | This is a simple graph (it does not allow parallel edges).  To support
+-- this efficiently, it is less compact than 'Digraph' or 'BiDigraph'.  As
+-- a consequence, edge existence tests are efficient (logarithmic in the
+-- number of edges leaving the source vertex).
+module Data.Graph.Haggle.SimpleBiDigraph (
+  MSimpleBiDigraph,
+  SimpleBiDigraph,
+  newMSimpleBiDigraph,
+  newSizedMSimpleBiDigraph
+  ) where
+
+import qualified Control.DeepSeq as DS
+import Control.Monad ( when )
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import Data.Foldable ( toList )
+import Data.IntMap ( IntMap )
+import qualified Data.IntMap as IM
+import qualified Data.Vector.Mutable as MV
+import qualified Data.Vector as V
+
+import Data.Graph.Haggle.Classes
+import Data.Graph.Haggle.Internal.Basic
+
+data MSimpleBiDigraph m = -- See Note [Graph Representation]
+  MBiDigraph { mgraphVertexCount :: R.Ref m Int
+             , mgraphEdgeCount :: R.Ref m Int
+             , mgraphPreds :: R.Ref m (MV.MVector (P.PrimState m) (IntMap Edge))
+             , mgraphSuccs :: R.Ref m (MV.MVector (P.PrimState m) (IntMap Edge))
+             }
+
+data SimpleBiDigraph =
+  BiDigraph { vertexCount :: {-# UNPACK #-} !Int
+            , edgeCount :: {-# UNPACK #-} !Int
+            , graphPreds :: V.Vector (IntMap Edge)
+            , graphSuccs :: V.Vector (IntMap Edge)
+            }
+
+instance DS.NFData SimpleBiDigraph where
+  rnf bdg = graphPreds bdg `DS.deepseq` graphSuccs bdg `DS.deepseq` ()
+
+defaultSize :: Int
+defaultSize = 128
+
+newMSimpleBiDigraph :: (P.PrimMonad m, R.MonadRef m) => m (MSimpleBiDigraph m)
+newMSimpleBiDigraph = newSizedMSimpleBiDigraph defaultSize 0
+
+newSizedMSimpleBiDigraph :: (P.PrimMonad m, R.MonadRef m) => Int -> Int -> m (MSimpleBiDigraph m)
+newSizedMSimpleBiDigraph szNodes _ = do
+  when (szNodes < 0) $ error "Negative size (newSized)"
+  nn <- R.newRef 0
+  en <- R.newRef 0
+  pvec <- MV.new szNodes
+  svec <- MV.new szNodes
+  pref <- R.newRef pvec
+  sref <- R.newRef svec
+  return $! MBiDigraph { mgraphVertexCount = nn
+                       , mgraphEdgeCount = en
+                       , mgraphPreds = pref
+                       , mgraphSuccs = sref
+                       }
+
+instance MGraph MSimpleBiDigraph where
+  type ImmutableGraph MSimpleBiDigraph = SimpleBiDigraph
+  getVertices g = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    return [V v | v <- [0..nVerts - 1]]
+
+  getOutEdges g (V src) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case src >= nVerts of
+      True -> return []
+      False -> do
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        return $ IM.elems succs
+
+  countVertices = R.readRef . mgraphVertexCount
+  countEdges = R.readRef . mgraphEdgeCount
+
+  getSuccessors g (V src) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case src >= nVerts of
+      True -> return []
+      False -> do
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        return $ map V $ IM.keys succs
+
+  checkEdgeExists g (V src) (V dst) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case src >= nVerts || dst >= nVerts of
+      True -> return False
+      False -> do
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        return $ IM.member dst succs
+
+  freeze g = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    nEdges <- R.readRef (mgraphEdgeCount g)
+    pvec <- R.readRef (mgraphPreds g)
+    svec <- R.readRef (mgraphSuccs g)
+    pvec' <- V.freeze (MV.take nVerts pvec)
+    svec' <- V.freeze (MV.take nVerts svec)
+    return $! BiDigraph { vertexCount = nVerts
+                        , edgeCount = nEdges
+                        , graphPreds = pvec'
+                        , graphSuccs = svec'
+                        }
+
+instance MAddVertex MSimpleBiDigraph where
+  addVertex g = do
+    ensureNodeSpace g
+    vid <- R.readRef r
+    R.modifyRef' r (+1)
+    pvec <- R.readRef (mgraphPreds g)
+    svec <- R.readRef (mgraphSuccs g)
+    MV.write pvec vid IM.empty
+    MV.write svec vid IM.empty
+    return (V vid)
+    where
+      r = mgraphVertexCount g
+
+instance MAddEdge MSimpleBiDigraph where
+  addEdge g v1@(V src) v2@(V dst) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    exists <- checkEdgeExists g v1 v2
+    case exists || src >= nVerts || dst >= nVerts of
+      True -> return Nothing
+      False -> do
+        eid <- R.readRef (mgraphEdgeCount g)
+        let e = E eid src dst
+        R.modifyRef' (mgraphEdgeCount g) (+1)
+
+        pvec <- R.readRef (mgraphPreds g)
+        preds <- MV.unsafeRead pvec dst
+        MV.unsafeWrite pvec dst (IM.insert src e preds)
+
+        svec <- R.readRef (mgraphSuccs g)
+        succs <- MV.unsafeRead svec src
+        MV.unsafeWrite svec src (IM.insert dst e succs)
+
+        return $ Just e
+
+instance MBidirectional MSimpleBiDigraph where
+  getPredecessors g (V vid) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case vid < nVerts of
+      False -> return []
+      True -> do
+        pvec <- R.readRef (mgraphPreds g)
+        preds <- MV.unsafeRead pvec vid
+        return $ map V $ IM.keys preds
+
+  getInEdges g (V vid) = do
+    nVerts <- R.readRef (mgraphVertexCount g)
+    case vid < nVerts of
+      False -> return []
+      True -> do
+        pvec <- R.readRef (mgraphPreds g)
+        preds <- MV.unsafeRead pvec vid
+        return $ IM.elems preds
+
+instance Thawable SimpleBiDigraph where
+  type MutableGraph SimpleBiDigraph = MSimpleBiDigraph
+  thaw g = do
+    vc <- R.newRef (vertexCount g)
+    ec <- R.newRef (edgeCount g)
+    pvec <- V.thaw (graphPreds g)
+    svec <- V.thaw (graphSuccs g)
+    pref <- R.newRef pvec
+    sref <- R.newRef svec
+    return MBiDigraph { mgraphVertexCount = vc
+                      , mgraphEdgeCount = ec
+                      , mgraphPreds = pref
+                      , mgraphSuccs = sref
+                      }
+
+instance Graph SimpleBiDigraph where
+  -- FIXME: This will be more complicated if we support removing vertices
+  vertices g = map V [0 .. vertexCount g - 1]
+  edges g = concatMap (outEdges g) (vertices g)
+  successors g (V v)
+    | outOfRange g v = []
+    | otherwise = map V $ IM.keys $ V.unsafeIndex (graphSuccs g) v
+  outEdges g (V v)
+    | outOfRange g v = []
+    | otherwise =
+      let succs = V.unsafeIndex (graphSuccs g) v
+      in IM.elems succs
+  edgesBetween g (V src) (V dst)
+    | outOfRange g src || outOfRange g dst = []
+    | otherwise = toList $ IM.lookup dst (V.unsafeIndex (graphSuccs g) src)
+  maxVertexId g = V.length (graphSuccs g) - 1
+  isEmpty = (==0) . vertexCount
+
+
+instance Bidirectional SimpleBiDigraph  where
+  predecessors g (V v)
+    | outOfRange g v = []
+    | otherwise = map V $ IM.keys $ V.unsafeIndex (graphPreds g) v
+  inEdges g (V v)
+    | outOfRange g v = []
+    | otherwise =
+      let preds = V.unsafeIndex (graphPreds g) v
+      in IM.elems preds
+
+-- Helpers
+
+outOfRange :: SimpleBiDigraph -> Int -> Bool
+outOfRange g = (>= vertexCount g)
+
+-- | Given a graph, ensure that there is space in the vertex vector
+-- for a new vertex.  If there is not, double the capacity.
+ensureNodeSpace :: (P.PrimMonad m, R.MonadRef m) => MSimpleBiDigraph m -> m ()
+ensureNodeSpace g = do
+  pvec <- R.readRef (mgraphPreds g)
+  svec <- R.readRef (mgraphSuccs g)
+  let cap = MV.length pvec
+  cnt <- R.readRef (mgraphVertexCount g)
+  case cnt < cap of
+    True -> return ()
+    False -> do
+      pvec' <- MV.grow pvec cap
+      svec' <- MV.grow svec cap
+      R.writeRef (mgraphPreds g) pvec'
+      R.writeRef (mgraphSuccs g) svec'
+
+
+{- Note [Graph Representation]
+
+Each of the IntMaps in the vectors maps the edge *destination* node id to the
+*edge id*.  We need to store the edge IDs to reconstruct an Edge.  Other graph
+representations use the edge IDs to maintain lists, but here we don't have
+that.  The destination is the key of the map for fast edgeExists tests.
+
+-}
diff --git a/src/Data/Graph/Haggle/VertexLabelAdapter.hs b/src/Data/Graph/Haggle/VertexLabelAdapter.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/VertexLabelAdapter.hs
@@ -0,0 +1,262 @@
+{-# LANGUAGE TypeFamilies, PatternGuards, RankNTypes #-}
+-- | An adapter to create graphs with labeled vertices and unlabeled edges.
+--
+-- See 'LabeledGraph' for an overview.  The only significant difference
+-- is that this graph only supports adding unlabeled edges, and thus you
+-- must use 'addEdge' instead of 'addLabeledEdge'.
+module Data.Graph.Haggle.VertexLabelAdapter (
+  VertexLabeledMGraph,
+  VertexLabeledGraph,
+  -- * Mutable Graph API
+  newVertexLabeledGraph,
+  newSizedVertexLabeledGraph,
+  -- * Immutable Graph API
+  mapVertexLabel,
+  fromEdgeList
+  ) where
+
+import qualified Control.DeepSeq as DS
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import Control.Monad.ST ( ST, runST )
+
+import qualified Data.Graph.Haggle.Classes as I
+import qualified Data.Graph.Haggle.VertexMap as VM
+import qualified Data.Graph.Haggle.Internal.Adapter as A
+
+newtype VertexLabeledMGraph g nl m = VLMG { unVLMG :: A.LabeledMGraph g nl () m }
+newtype VertexLabeledGraph g nl = VLG { unVLG :: A.LabeledGraph g nl () }
+
+instance (DS.NFData g, DS.NFData nl) => DS.NFData (VertexLabeledGraph g nl) where
+  rnf (VLG g) = g `DS.deepseq` ()
+
+mapVertexLabel :: VertexLabeledGraph g nl -> (nl -> nl') -> VertexLabeledGraph g nl'
+mapVertexLabel g = VLG . A.mapVertexLabel (unVLG g)
+{-# INLINE mapVertexLabel #-}
+
+vertices :: (I.Graph g) => VertexLabeledGraph g nl -> [I.Vertex]
+vertices = I.vertices . unVLG
+{-# INLINE vertices #-}
+
+edges :: (I.Graph g) => VertexLabeledGraph g nl -> [I.Edge]
+edges = I.edges . unVLG
+{-# INLINE edges #-}
+
+successors :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Vertex]
+successors (VLG lg) = I.successors lg
+{-# INLINE successors #-}
+
+outEdges :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Edge]
+outEdges (VLG lg) = I.outEdges lg
+{-# INLINE outEdges #-}
+
+edgesBetween :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> I.Vertex -> [I.Edge]
+edgesBetween (VLG lg) = I.edgesBetween lg
+{-# INLINE edgesBetween #-}
+
+maxVertexId :: (I.Graph g) => VertexLabeledGraph g nl -> Int
+maxVertexId = I.maxVertexId . unVLG
+{-# INLINE maxVertexId #-}
+
+isEmpty :: (I.Graph g) => VertexLabeledGraph g nl -> Bool
+isEmpty = I.isEmpty . unVLG
+{-# INLINE isEmpty #-}
+
+instance (I.Graph g) => I.Graph (VertexLabeledGraph g nl) where
+  vertices = vertices
+  edges = edges
+  successors = successors
+  outEdges = outEdges
+  edgesBetween = edgesBetween
+  maxVertexId = maxVertexId
+  isEmpty = isEmpty
+
+instance (I.Thawable g) => I.Thawable (VertexLabeledGraph g nl) where
+  type MutableGraph (VertexLabeledGraph g nl) =
+    VertexLabeledMGraph (I.MutableGraph g) nl
+  thaw (VLG lg) = do
+    g' <- I.thaw lg
+    return $ VLMG g'
+
+
+predecessors :: (I.Bidirectional g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Vertex]
+predecessors (VLG lg) = I.predecessors lg
+{-# INLINE predecessors #-}
+
+inEdges :: (I.Bidirectional g) => VertexLabeledGraph g nl -> I.Vertex -> [I.Edge]
+inEdges (VLG lg) = I.inEdges lg
+{-# INLINE inEdges #-}
+
+instance (I.Bidirectional g) => I.Bidirectional (VertexLabeledGraph g nl) where
+  predecessors = predecessors
+  inEdges = inEdges
+
+vertexLabel :: (I.Graph g) => VertexLabeledGraph g nl -> I.Vertex -> Maybe nl
+vertexLabel (VLG g) = I.vertexLabel g
+{-# INLINE vertexLabel #-}
+
+instance (I.Graph g) => I.HasVertexLabel (VertexLabeledGraph g nl) where
+  type VertexLabel (VertexLabeledGraph g nl) = nl
+  vertexLabel = vertexLabel
+  labeledVertices = labeledVertices
+
+labeledVertices :: (I.Graph g) => VertexLabeledGraph g nl -> [(I.Vertex, nl)]
+labeledVertices = I.labeledVertices . unVLG
+{-# INLINE labeledVertices #-}
+
+newVertexLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                      => m (g m)
+                      -> m (VertexLabeledMGraph g nl m)
+newVertexLabeledGraph newG = do
+  g <- A.newLabeledGraph newG
+  return $ VLMG g
+{-# INLINE newVertexLabeledGraph #-}
+
+newSizedVertexLabeledGraph :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                           => (Int -> Int -> m (g m))
+                           -> Int
+                           -> Int
+                           -> m (VertexLabeledMGraph g nl m)
+newSizedVertexLabeledGraph newG szV szE = do
+  g <- A.newSizedLabeledGraph newG szV szE
+  return $ VLMG g
+{-# INLINE newSizedVertexLabeledGraph #-}
+
+addEdge :: (I.MGraph g, I.MAddEdge g, P.PrimMonad m, R.MonadRef m)
+        => VertexLabeledMGraph g nl m
+        -> I.Vertex
+        -> I.Vertex
+        -> m (Maybe I.Edge)
+addEdge lg = I.addEdge (A.rawMGraph (unVLMG lg))
+{-# INLINE addEdge #-}
+
+addLabeledVertex :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
+                 => VertexLabeledMGraph g nl m
+                 -> nl
+                 -> m I.Vertex
+addLabeledVertex lg = I.addLabeledVertex (unVLMG lg)
+{-# INLINE addLabeledVertex #-}
+
+getVertexLabel :: (I.MGraph g, I.MAddVertex g, P.PrimMonad m, R.MonadRef m)
+               => VertexLabeledMGraph g nl m
+               -> I.Vertex
+               -> m (Maybe nl)
+getVertexLabel lg = I.getVertexLabel (unVLMG lg)
+{-# INLINE getVertexLabel #-}
+
+getSuccessors :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+              => VertexLabeledMGraph g nl m
+              -> I.Vertex
+              -> m [I.Vertex]
+getSuccessors lg = I.getSuccessors (unVLMG lg)
+{-# INLINE getSuccessors #-}
+
+getOutEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+            => VertexLabeledMGraph g nl m -> I.Vertex -> m [I.Edge]
+getOutEdges lg = I.getOutEdges (unVLMG lg)
+{-# INLINE getOutEdges #-}
+
+countVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => VertexLabeledMGraph g nl m -> m Int
+countVertices = I.countVertices . unVLMG
+{-# INLINE countVertices #-}
+
+getVertices :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => VertexLabeledMGraph g nl m -> m [I.Vertex]
+getVertices = I.getVertices . unVLMG
+{-# INLINE getVertices #-}
+
+countEdges :: (I.MGraph g, P.PrimMonad m, R.MonadRef m) => VertexLabeledMGraph g nl m -> m Int
+countEdges = I.countEdges . unVLMG
+{-# INLINE countEdges #-}
+
+getPredecessors :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
+                => VertexLabeledMGraph g nl m -> I.Vertex -> m [I.Vertex]
+getPredecessors lg = I.getPredecessors (unVLMG lg)
+{-# INLINE getPredecessors #-}
+
+getInEdges :: (I.MBidirectional g, P.PrimMonad m, R.MonadRef m)
+           => VertexLabeledMGraph g nl m -> I.Vertex -> m [I.Edge]
+getInEdges lg = I.getInEdges (unVLMG lg)
+{-# INLINE getInEdges #-}
+
+checkEdgeExists :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+                => VertexLabeledMGraph g nl m
+                -> I.Vertex
+                -> I.Vertex
+                -> m Bool
+checkEdgeExists lg = I.checkEdgeExists (unVLMG lg)
+{-# INLINE checkEdgeExists #-}
+
+freeze :: (I.MGraph g, P.PrimMonad m, R.MonadRef m)
+       => VertexLabeledMGraph g nl m
+       -> m (VertexLabeledGraph (I.ImmutableGraph g) nl)
+freeze lg = do
+  g' <- I.freeze (unVLMG lg)
+  return $ VLG g'
+{-# INLINE freeze #-}
+
+instance (I.MGraph g) => I.MGraph (VertexLabeledMGraph g nl) where
+  type ImmutableGraph (VertexLabeledMGraph g nl) =
+    VertexLabeledGraph (I.ImmutableGraph g) nl
+  getVertices = getVertices
+  getSuccessors = getSuccessors
+  getOutEdges = getOutEdges
+  countVertices = countVertices
+  countEdges = countEdges
+  checkEdgeExists = checkEdgeExists
+  freeze = freeze
+
+instance (I.MAddVertex g) => I.MLabeledVertex (VertexLabeledMGraph g nl) where
+  type MVertexLabel (VertexLabeledMGraph g nl) = nl
+  getVertexLabel = getVertexLabel
+  addLabeledVertex = addLabeledVertex
+
+instance (I.MBidirectional g) => I.MBidirectional (VertexLabeledMGraph g nl) where
+  getPredecessors = getPredecessors
+  getInEdges = getInEdges
+
+instance (I.MAddEdge g) => I.MAddEdge (VertexLabeledMGraph g nl) where
+  addEdge = addEdge
+
+-- | Build a new (immutable) graph from a list of edges.  Edges are defined
+-- by pairs of /node labels/.  A new 'Vertex' will be allocated for each
+-- node label.
+--
+-- The type of the constructed graph is controlled by the first argument,
+-- which is a constructor for a mutable graph.
+--
+-- Example:
+--
+-- > import Data.Graph.Haggle.VertexLabelAdapter
+-- > import Data.Graph.Haggle.SimpleBiDigraph
+-- >
+-- > let g = fromEdgeList newMSimpleBiDigraph [(0,1), (1,2), (2,3), (3,0)]
+--
+-- @g@ has type SimpleBiDigraph.
+--
+-- An alternative that is fully polymorphic in the return type would be
+-- possible, but it would require type annotations on the result of
+-- 'fromEdgeList', which could be very annoying.
+fromEdgeList :: (I.MGraph g, I.MAddEdge g, I.MAddVertex g, Ord nl)
+             => (forall s . ST s (g (ST s)))
+             -> [(nl, nl)]
+             -> (VertexLabeledGraph (I.ImmutableGraph g) nl, VM.VertexMap nl)
+fromEdgeList con es = runST $ do
+  g <- newVertexLabeledGraph con
+  vm <- VM.newVertexMapRef
+  mapM_ (fromListAddEdge g vm) es
+  g' <- I.freeze g
+  vm' <- VM.vertexMapFromRef vm
+  return (g', vm')
+
+fromListAddEdge :: (I.MAddVertex g, I.MAddEdge g, Ord nl, P.PrimMonad m, R.MonadRef m)
+                => VertexLabeledMGraph g nl m
+                -> VM.VertexMapRef nl m
+                -> (nl, nl)
+                -> m ()
+fromListAddEdge g vm (src, dst) = do
+  vsrc <- VM.vertexForLabelRef g vm src
+  vdst <- VM.vertexForLabelRef g vm dst
+  _ <- addEdge g vsrc vdst
+  return ()
+
+
diff --git a/src/Data/Graph/Haggle/VertexMap.hs b/src/Data/Graph/Haggle/VertexMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Haggle/VertexMap.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE PatternGuards, FlexibleContexts #-}
+-- | This is a simple module to handle a common pattern: constructing graphs
+-- where vertex labels map uniquely to vertices.
+--
+-- The primary functions in this module are 'vertexForLabel' and
+-- 'vertexForLabelRef', which take a vertex label and return the 'Vertex' for
+-- that label (allocating a new 'Vertex') if necessary.  The first of those
+-- functions explicitly threads the mapping as inputs and outputs.  The second
+-- manages a mutable ref side-by-side with the underlying graph.
+--
+-- After the graph is fully constructed, this mapping is often still useful.
+module Data.Graph.Haggle.VertexMap (
+  -- * Pure interface
+  VertexMap,
+  emptyVertexMap,
+  vertexForLabel,
+  lookupVertexForLabel,
+  vertexMapFromGraph,
+  -- * Ref interface
+  VertexMapRef,
+  newVertexMapRef,
+  vertexForLabelRef,
+  vertexMapFromRef ) where
+
+import qualified Control.DeepSeq as DS
+import Control.Monad ( liftM )
+import qualified Control.Monad.Primitive as P
+import qualified Control.Monad.Ref as R
+import Data.Map ( Map )
+import qualified Data.Map as M
+import Data.Tuple ( swap )
+
+import Data.Graph.Haggle.Classes
+
+-- | A simple mapping from labels to their 'Vertex'
+newtype VertexMap nl = VM (Map nl Vertex)
+
+instance (DS.NFData nl) => DS.NFData (VertexMap nl) where
+  rnf (VM m) = m `DS.deepseq` ()
+
+emptyVertexMap :: VertexMap nl
+emptyVertexMap = VM M.empty
+
+-- | > (v, m') <- vertexForLabel g m lbl
+--
+-- Looks up the 'Vertex' for @lbl@ in @g@.  If no 'Vertex' in @g@ has that
+-- label, a new 'Vertex' is allocated and returned.  The updated vertex
+-- mapping @m'@ is returned, too.
+vertexForLabel :: (MLabeledVertex g, Ord (MVertexLabel g), P.PrimMonad m, R.MonadRef m)
+               => g m
+               -> VertexMap (MVertexLabel g)
+               -> MVertexLabel g
+               -> m (Vertex, VertexMap (MVertexLabel g))
+vertexForLabel g vm@(VM m) lbl
+  | Just v <- M.lookup lbl m = return (v, vm)
+  | otherwise = do
+    v <- addLabeledVertex g lbl
+    let m' = M.insert lbl v m
+    return (v, VM m')
+
+-- | A pure lookup to convert a 'Vertex' label into a 'Vertex'.  If the
+-- label is not in the graph, returns 'Nothing'.
+lookupVertexForLabel :: (Ord nl) => nl -> VertexMap nl -> Maybe Vertex
+lookupVertexForLabel lbl (VM m) = M.lookup lbl m
+
+-- | Build a 'VertexMap' from a 'Graph' with 'Vertex' labels.
+vertexMapFromGraph :: (HasVertexLabel g, Ord (VertexLabel g))
+                   => g -> VertexMap (VertexLabel g)
+vertexMapFromGraph = VM . M.fromList . map swap . labeledVertices
+
+-- | A 'VertexMap' wrapped up in a mutable ref for possibly
+-- easier access in 'vertexMapFromRef'.
+newtype VertexMapRef nl m = VMR (R.Ref m (VertexMap nl))
+
+-- | Extract the pure 'VertexMap' from the mutable ref.  This is useful
+-- to retain the mapping after the graph is fully constructed.
+vertexMapFromRef :: (P.PrimMonad m, R.MonadRef m) => VertexMapRef nl m -> m (VertexMap nl)
+vertexMapFromRef (VMR ref) = R.readRef ref
+
+-- | Allocate a new 'VertexMap' buried in a mutable ref.
+newVertexMapRef :: (P.PrimMonad m, R.MonadRef m) => m (VertexMapRef nl m)
+newVertexMapRef = liftM VMR $ R.newRef emptyVertexMap
+
+-- | Just like 'vertexForLabel', but holding the mapping in a ref instead
+-- of threading it.  Usage is simpler:
+--
+-- > v <- vertexForLabelRef g m lbl
+vertexForLabelRef :: (MLabeledVertex g, Ord (MVertexLabel g), P.PrimMonad m, R.MonadRef m)
+                  => g m
+                  -> VertexMapRef (MVertexLabel g) m
+                  -> MVertexLabel g
+                  -> m Vertex
+vertexForLabelRef g (VMR ref) lbl = do
+  vm <- R.readRef ref
+  (v, vm') <- vertexForLabel g vm lbl
+  R.writeRef ref vm'
+  return v
+
+
diff --git a/tests/GraphTests.hs b/tests/GraphTests.hs
new file mode 100644
--- /dev/null
+++ b/tests/GraphTests.hs
@@ -0,0 +1,155 @@
+-- | This module tests Haggle by comparing its results to those of FGL.
+-- This assumes that FGL is reasonably correct.
+--
+-- The arbitrary instance for GraphPair generates a list of edges and
+-- then constructs equivalent FGL and Haggle graphs.  The quickcheck
+-- properties for each operation try to ensure that the two implementations
+-- return the same results.
+module Main ( main ) where
+
+import Test.Framework ( defaultMain, testGroup, Test )
+import Test.Framework.Providers.QuickCheck2 ( testProperty )
+import Test.QuickCheck
+
+import Control.Arrow ( first, second )
+import Control.Monad ( replicateM )
+import qualified Data.Foldable as F
+import Data.Maybe ( isNothing )
+import qualified Data.Set as S
+
+import qualified Data.Graph.Inductive as FGL
+import qualified Data.Graph.Haggle as HGL
+import qualified Data.Graph.Haggle.VertexLabelAdapter as HGL
+import qualified Data.Graph.Haggle.SimpleBiDigraph as HGL
+import qualified Data.Graph.Haggle.Algorithms.DFS as HGL
+import qualified Data.Graph.Haggle.Algorithms.Dominators as HGL
+
+-- import Debug.Trace
+-- debug = flip trace
+
+type BaseGraph = FGL.Gr Int ()
+type TestGraph = HGL.VertexLabeledGraph HGL.SimpleBiDigraph Int
+
+data GraphPair = GP [(Int, Int)] BaseGraph TestGraph
+
+instance Arbitrary GraphPair where
+  arbitrary = sized mkGraphPair
+
+instance Show GraphPair where
+  show (GP es _ _) = show es
+
+newtype NodeId = NID Int
+  deriving (Show)
+instance Arbitrary NodeId where
+  arbitrary = sized mkNodeId
+    where
+      mkNodeId n = do
+        i <- choose (0, n)
+        return (NID i)
+
+mkGraphPair :: Int -> Gen GraphPair
+mkGraphPair sz = do
+  nEdges <- choose (2, 2 * sz)
+  srcs <- replicateM nEdges (choose (0, sz))
+  dsts <- replicateM nEdges (choose (0, sz))
+  let edges = unique $ zip srcs dsts
+      nids = unique (srcs ++ dsts)
+      ns = zip nids nids
+      bg = FGL.mkGraph ns (map (\(s, d) -> (s, d, ())) edges)
+      (tg, _) = HGL.fromEdgeList HGL.newMSimpleBiDigraph edges
+  return $! GP edges bg tg
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: [Test]
+tests = [ testProperty "prop_sameVertexCount" prop_sameVertexCount
+        , testProperty "prop_sameEdgeCount" prop_sameEdgeCount
+        , testProperty "prop_sameSuccessorsAtLabel" prop_sameSuccessorsAtLabel
+        , testProperty "prop_samePredecessorsAtLabel" prop_samePredecessorsAtLabel
+        , testProperty "prop_dfsSame" prop_dfsSame
+        , testProperty "prop_sameComponents" prop_sameComponents
+        , testProperty "prop_sameNoComponents" prop_sameNoComponents
+        , testProperty "prop_immDominatorsSame" prop_immDominatorsSame
+        , testProperty "prop_dominatorsSame" prop_dominatorsSame
+        ]
+
+prop_sameVertexCount :: GraphPair -> Bool
+prop_sameVertexCount (GP _ bg tg) =
+  length (FGL.nodes bg) == length (HGL.vertices tg)
+
+prop_sameEdgeCount :: GraphPair -> Bool
+prop_sameEdgeCount (GP _ bg tg) =
+  length (FGL.edges bg) == length (HGL.edges tg)
+
+prop_sameSuccessorsAtLabel :: (NodeId, GraphPair) -> Bool
+prop_sameSuccessorsAtLabel (NID nid, GP _ bg tg)
+  | not (FGL.gelem nid bg) && isNothing (vertexFromLabel tg nid) = True
+  | otherwise = bss == tss
+  where
+    bss = S.fromList $ fmap Just $ FGL.suc bg nid
+    ts = maybe [] (map (HGL.vertexLabel tg) . HGL.successors tg) (vertexFromLabel tg nid)
+    tss = S.fromList ts
+
+prop_samePredecessorsAtLabel :: (NodeId, GraphPair) -> Bool
+prop_samePredecessorsAtLabel (NID nid, GP _ bg tg)
+  | not (FGL.gelem nid bg) && isNothing (vertexFromLabel tg nid) = True
+  | otherwise = bss == tss
+  where
+    bss = S.fromList $ fmap Just $ FGL.pre bg nid
+    ts = maybe [] (map (HGL.vertexLabel tg) . HGL.predecessors tg) (vertexFromLabel tg nid)
+    tss = S.fromList ts
+
+-- Note that this is only checking the *set* of vertices reached.  Unfortunately,
+-- verifying the *order* is difficult because there are many valid DFS orders
+-- (depending on the order edges are stored).  A test using the DFS number
+-- (derived from the depth in the depth-first tree) would be a good complement
+-- to this.
+prop_dfsSame :: (NodeId, GraphPair) -> Bool
+prop_dfsSame (NID root, GP _ bg tg) =
+  S.fromList bres == S.fromList tres
+  where
+    bres = map Just $ FGL.dfs [root] bg
+    v = vertexFromLabel tg root
+    tres = maybe [] (map (HGL.vertexLabel tg) . HGL.dfs tg . (:[])) v
+
+prop_immDominatorsSame :: (NodeId, GraphPair) -> Bool
+prop_immDominatorsSame (NID root, GP _ bg tg)
+  | not (FGL.gelem root bg) && isNothing (vertexFromLabel tg root) = True
+  | otherwise = S.fromList bdoms == S.fromList tdoms
+  where
+    bdoms = FGL.iDom bg root
+    toLabs (v1, v2) =
+      let Just v1l = HGL.vertexLabel tg v1
+          Just v2l = HGL.vertexLabel tg v2
+      in (v1l, v2l)
+    tdoms = maybe [] (map toLabs . HGL.immediateDominators tg) (vertexFromLabel tg root)
+
+prop_dominatorsSame :: (NodeId, GraphPair) -> Bool
+prop_dominatorsSame (NID root, GP _ bg tg)
+  | not (FGL.gelem root bg) && isNothing (vertexFromLabel tg root) = True
+  | otherwise = S.fromList (map (first Just) bdoms) == S.fromList (map (first (HGL.vertexLabel tg)) tdoms)
+  where
+    bdoms = map (second (S.fromList . map Just)) $ FGL.dom bg root
+    Just rv = vertexFromLabel tg root
+    tdoms = map (second (S.fromList . map (HGL.vertexLabel tg))) $ HGL.dominators tg rv
+
+prop_sameComponents :: GraphPair -> Bool
+prop_sameComponents (GP _ bg tg) = bcs == tcs
+  where
+    bcs = S.map (S.fromList . map Just) $ S.fromList $ FGL.components bg
+    tcs = S.map (S.fromList . map (HGL.vertexLabel tg)) $ S.fromList $ HGL.components tg
+
+prop_sameNoComponents :: GraphPair -> Bool
+prop_sameNoComponents (GP _ bg tg) =
+  FGL.noComponents bg == HGL.noComponents tg
+
+-- Helpers
+
+vertexFromLabel :: TestGraph -> Int -> Maybe HGL.Vertex
+vertexFromLabel g lbl = F.find labelMatch (HGL.vertices g)
+  where
+    labelMatch v = Just lbl == (HGL.vertexLabel g v)
+
+unique :: (Ord a) => [a] -> [a]
+unique = S.toList . S.fromList